Cocoa cleanup, AppleEvent handling, services

Factor.app/Contents/Info.plist

@@ -12,5 +12,22 @@
 	<string>Factor</string>
 	<key>CFBundlePackageType</key>
 	<string>APPL</string>
+	<key>CFBundleDocumentTypes</key>
+	<array>
+		<dict>
+			<key>CFBundleTypeExtensions</key>
+			<array>
+				<string>*</string>
+			</array>
+			<key>CFBundleTypeName</key>
+			<string>Any</string>
+			<key>CFBundleTypeRole</key>
+			<string>Viewer</string>
+			<key>CFBundleTypeOSTypes</key>
+			<array>
+				<string>****</string>
+			</array>
+		</dict>
+	</array>
 </dict>
 </plist>

TODO.FACTOR.txt

@@ -1,7 +1,24 @@
-- fix compiled gc check
++ refactor style stack code so that nested styles are handled at a lower-level
+  - in HTML, we can nest div tags, etc
+  - fix prettyprinter's highlighting of non-leaves looks bad
+  - maybe even go from markup to HTML?
+    - fix remaining HTML stream issues
+    - need to present $list in a useful way
+  - better line spacing in ui and html - related issue
+
++ tabular formatting in UI
+  - inspector
+    - how does this interact with outliner?
+  - $values
+  - other help aspects
+  - grid layout
+
++ fix compiled gc check
+  - there was a performance hit, investigate
+  - float boxing and overflow checks need a gc check too
+
 - code walker & exceptions -- test and debug problems
 - code walker and callbacks is broken?
-- prettyprinter's highlighting of non-leaves looks bad
 - look at xref issue
 
 + io:
@@ -19,18 +36,20 @@
 - method ordering and interpreter algorithm sections need updates
 - document that can <void*> only be called with an alien
 - help search
-- fix remaining HTML stream issues
 - automatically update help graph when adding/removing articles/words
 - document conventions
 - new turtle graphics tutorial
-- better line spacing in ui and html
-- tabular formatting - for inspector, changes and $values in help
-- grid layout
-- make the help look better, something like this:
-  http://twb.ath.cx/~twb/darcs/OBSOLETE/factor/final.html
 
 + ui/help:
 
+- new leaner help viewer
+- new inspector style:
+  - clicking objects sends them to the listener
+  - right click sends to listener & pushes on the stack
+- debugger:
+  - continuation viewer tool, reuse old inspector code
+  - show a clickable menu of restarts...
+- reuse windows where possible
 - new browser:
   - browse generic words and classes
   - need actions for reloading the source file and opening word in jEdit

library/cocoa/application-utils.factor

@@ -6,6 +6,10 @@ objc-NSApplication objc-NSAutoreleasePool objc-NSException
 objc-NSNotificationCenter objc-NSObject objc-NSView sequences
 threads ;
 
+: NSApplicationDelegateReplySuccess 0 ;
+: NSApplicationDelegateReplyCancel  1 ;
+: NSApplicationDelegateReplyFailure 2 ;
+
 : with-autorelease-pool ( quot -- )
     NSAutoreleasePool [new] slip [release] ; inline
 
@@ -14,7 +18,9 @@ threads ;
 : with-cocoa ( quot -- )
     [ NSApp drop call ] with-autorelease-pool ;
 
-: <NSString> <CFString> [autorelease] ;
+: <NSString> ( str -- alien ) <CFString> [autorelease] ;
+
+: <NSArray> ( seq -- alien ) <CFArray> [autorelease] ;
 
 : CFRunLoopDefaultMode "kCFRunLoopDefaultMode" <NSString> ;
 

library/cocoa/core-foundation.factor

@@ -6,14 +6,14 @@ namespaces sequences ;
 
 TYPEDEF: int CFIndex
 
+FUNCTION void* CFArrayCreateMutable ( void* allocator, CFIndex capacity, void* callbacks ) ;
+
 FUNCTION: void* CFArrayGetValueAtIndex ( void* array, CFIndex idx ) ;
 
+FUNCTION: void* CFArraySetValueAtIndex ( void* array, CFIndex index, void* value ) ;
+
 FUNCTION: CFIndex CFArrayGetCount ( void* array ) ;
 
-: CF>array ( alien -- array )
-    dup CFArrayGetCount [ CFArrayGetValueAtIndex ] map-with ;
-
-! Core Foundation utilities -- will be moved elsewhere
 : kCFURLPOSIXPathStyle 0 ;
 
 FUNCTION: void* CFURLCreateWithFileSystemPath ( void* allocator, void* filePath, int pathStyle, bool isDirectory ) ;
@@ -36,6 +36,14 @@ FUNCTION: bool CFBundleLoadExecutable ( void* bundle ) ;
 
 FUNCTION: void CFRelease ( void* cf ) ;
 
+: CF>array ( alien -- array )
+    dup CFArrayGetCount [ CFArrayGetValueAtIndex ] map-with ;
+
+: <CFArray> ( seq -- array )
+    [ f swap length f CFArrayCreateMutable ] keep
+    [ length ] keep
+    [ >r dupd r> CFArraySetValueAtIndex ] 2each ;
+
 : <CFString> ( string -- cf )
     f swap dup length CFStringCreateWithCharacters ;
 
@@ -44,6 +52,9 @@ FUNCTION: void CFRelease ( void* cf ) ;
         >r 0 over CFStringGetLength r> CFStringGetCharacters
     ] keep alien>u16-string ;
 
+: CF>string-array ( alien -- seq )
+    CF>array [ CF>string ] map ;
+
 : <CFFileSystemURL> ( string dir? -- cf )
     >r <CFString> f over kCFURLPOSIXPathStyle
     r> CFURLCreateWithFileSystemPath swap CFRelease ;

library/cocoa/dialogs.factor

@@ -16,4 +16,4 @@ sequences ;
 
 : open-panel ( -- paths )
     <NSOpenPanel> dup f [runModalForTypes:] NSOKButton =
-    [ [filenames] CF>array [ CF>string ] map ] [ drop f ] if ;
+    [ [filenames] CF>string-array ] [ drop f ] if ;

library/cocoa/init-cocoa.factor

@@ -20,6 +20,7 @@ USING: cocoa compiler io kernel objc sequences words ;
     "NSOpenGLContext"
     "NSOpenGLView"
     "NSOpenPanel"
+    "NSPasteboard"
     "NSSavePanel"
     "NSView"
     "NSWindow"

library/cocoa/load.factor

@@ -9,10 +9,12 @@ USING: compiler io parser sequences words ;
     "/library/cocoa/init-cocoa.factor"
     "/library/cocoa/callback.factor"
     "/library/cocoa/application-utils.factor"
-    "/library/cocoa/window-utils.factor"
     "/library/cocoa/view-utils.factor"
+    "/library/cocoa/window-utils.factor"
     "/library/cocoa/dialogs.factor"
     "/library/cocoa/menu-bar.factor"
+    "/library/cocoa/pasteboard-utils.factor"
+    "/library/cocoa/services.factor"
     "/library/cocoa/ui.factor"
 } [
     run-resource

library/cocoa/menu-bar.factor

@@ -33,18 +33,22 @@ M: quotation to-target-and-action
     [initWithTitle:action:keyEquivalent:] [autorelease] ;
 
 : make-menu-item ( title spec -- item )
-    to-target-and-action >r swap <NSMenuItem> dup r> [setTarget:] ;
+    to-target-and-action >r swap <NSMenuItem> dup
+    r> [setTarget:] ;
 
 : submenu-to-item ( menu -- item )
-    dup [title] CF>string f "" <NSMenuItem> dup rot [setSubmenu:] ;
+    dup [title] CF>string f "" <NSMenuItem> dup
+    rot [setSubmenu:] ;
 
 : add-submenu ( menu submenu -- )
     submenu-to-item [addItem:] ;
 
 : and-modifiers ( item key-equivalent-modifier-mask -- item )
     dupd [setKeyEquivalentModifierMask:] ;
+
 : and-alternate ( item -- item )
     dup 1 [setAlternate:] ;
+
 : and-option-equivalent-modifier 1572864 and-modifiers ;
 
 ! -------------------------------------------------------------------------
@@ -130,7 +134,6 @@ DEFER: described-menu
             { "Paste and Match Style" "pasteAsPlainText:" "V" [ and-option-equivalent-modifier ] }
             { "Delete" "delete:" "" }
             { "Select All" "selectAll:" "a" }
-            ! { }
             ! Find, Spelling, and Speech submenus go here
         } }
         { {

library/cocoa/pasteboard-utils.factor

@@ -0,0 +1,16 @@
+IN: cocoa
+USING: kernel sequences objc-NSPasteboard ;
+
+: NSStringPboardType "NSStringPboardType" <NSString> ;
+
+: pasteboard-type? ( type id -- seq )
+    NSStringPboardType swap [types] CF>array member? ;
+
+: pasteboard-string ( id -- str )
+    NSStringPboardType [stringForType:] dup [ CF>string ] when ;
+
+: set-pasteboard-types ( seq id -- )
+    swap <NSArray> f [declareTypes:owner:] ;
+
+: set-pasteboard-string ( str id -- )
+    swap <NSString> NSStringPboardType [setString:forType:] ;

library/cocoa/services.factor

@@ -0,0 +1,36 @@
+IN: objc-FactorServiceProvider
+DEFER: FactorServiceProvider
+
+IN: cocoa
+USING: alien gadgets-presentations kernel objc
+objc-NSApplication objc-NSObject parser styles ;
+
+: pasteboard-error ( error str -- f )
+    "Pasteboard does not hold a string" <NSString>
+    0 rot set-void*-nth f ;
+
+: ?pasteboard-string ( pboard error -- str/f )
+    NSStringPboardType pick pasteboard-type? [
+        swap pasteboard-string [ ] [ pasteboard-error ] ?if
+    ] [
+        nip pasteboard-error
+    ] if ;
+
+: do-service ( pboard error quot -- | quot: str -- str/f )
+    [
+        >r ?pasteboard-string dup [ r> call ] [ r> 2drop ] if
+    ] keep over [ set-pasteboard-string ] [ 2drop ] if ;
+
+"NSObject" "FactorServiceProvider" {
+    { "evalInListener:" "void" { "id" "SEL" "id" "id" "void*" }
+        [ nip [ <input> f show-object f ] do-service ]
+    }
+    { "evalToString:" "void" { "id" "SEL" "id" "id" "void*" }
+        [ nip [ eval>string ] do-service ]
+    }
+} { } define-objc-class
+
+: register-services ( -- )
+    NSApp
+    FactorServiceProvider [alloc] [init]
+    [setServicesProvider:] ;

library/cocoa/ui.factor

@@ -1,216 +1,32 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: objc-FactorView
+IN: objc-FactorApplicationDelegate
-DEFER: FactorView
-IN: objc-FactorUIWindowDelegate
-DEFER: FactorUIWindowDelegate
 
-USING: alien arrays cocoa errors freetype gadgets
+DEFER: FactorApplicationDelegate
-gadgets-launchpad gadgets-layouts gadgets-listener gadgets-panes
-hashtables kernel math namespaces objc objc-NSApplication
-objc-NSEvent objc-NSObject objc-NSOpenGLContext
-objc-NSOpenGLView objc-NSView objc-NSWindow sequences threads ;
 
-! Cocoa backend for Factor UI
+IN: cocoa
+USING: gadgets-listener kernel objc objc-NSApplication
+objc-NSObject ;
 
-IN: gadgets-cocoa
+: finder-run-files ( alien -- )
+    CF>string-array listener-run-files
+    NSApp NSApplicationDelegateReplySuccess
+    [replyToOpenOrPrint:] ;
 
-! Hash mapping aliens to gadgets
+! Handle Open events from the Finder
-SYMBOL: views
+"NSObject" "FactorApplicationDelegate" {
-
+    { "application:openFiles:" "void" { "id" "SEL" "id" "id" }
-: reset-views ( hash -- hash ) H{ } clone views set-global ;
+        [ >r 3drop r> finder-run-files ]
-
-reset-views
-
-: view ( handle -- world ) views get hash ;
-
-: mouse-location ( view event -- loc )
-    over >r
-    [locationInWindow] f [convertPoint:fromView:]
-    dup NSPoint-x swap NSPoint-y
-    r> [frame] NSRect-h swap - 0 3array ;
-
-: send-mouse-moved ( view event -- )
-    over >r mouse-location r> view move-hand ;
-
-: button ( event -- n )
-    #! Cocoa -> Factor UI button mapping
-    [buttonNumber] H{ { 0 1 } { 2 2 } { 1 3 } } hash ;
-
-: button&loc ( view event -- button# loc )
-    dup button -rot mouse-location ;
-
-: modifiers
-    {
-        { S+ HEX: 10000 }
-        { C+ HEX: 40000 }
-        { A+ HEX: 80000 }
-        { M+ HEX: 100000 }
-    } ;
-
-: key-codes
-    H{
-        { 36 "RETURN" }
-        { 48 "TAB" }
-        { 51 "BACKSPACE" }
-        { 115 "HOME" }
-        { 117 "DELETE" }
-        { 119 "END" }
-        { 123 "LEFT" }
-        { 124 "RIGHT" }
-        { 125 "DOWN" }
-        { 126 "UP" }
-    } ;
-
-: key-code ( event -- string )
-    dup [keyCode] key-codes hash
-    [ ] [ [charactersIgnoringModifiers] CF>string ] ?if ;
-
-: event>gesture ( event -- modifiers keycode )
-    dup [modifierFlags] modifiers modifier swap key-code ;
-
-: send-key-event ( view event quot -- )
-    >r event>gesture r> call swap view world-focus
-    handle-gesture ; inline
-
-: send-user-input ( view event -- )
-    [characters] CF>string swap view world-focus user-input ;
-
-: send-key-down-event ( view event -- )
-    2dup [ <key-down> ] send-key-event
-    [ send-user-input ] [ 2drop ] if ;
-
-: send-key-up-event ( view event -- )
-    [ <key-up> ] send-key-event ;
-
-: send-button-down$ ( view event -- )
-    over >r button&loc r> view send-button-down ;
-
-: send-button-up$ ( view event -- )
-    over >r button&loc r> view send-button-up ;
-
-: send-wheel$ ( view event -- )
-    [ [deltaY] 0 > ] 2keep mouse-location rot view send-wheel ;
-
-"NSOpenGLView" "FactorView" {
-    { "drawRect:" "void" { "id" "SEL" "NSRect" }
-        [ 2drop view draw-world ]
-    }
-    
-    { "mouseMoved:" "void" { "id" "SEL" "id" }
-        [ nip send-mouse-moved ]
-    }
-    
-    { "mouseDragged:" "void" { "id" "SEL" "id" }
-        [ nip send-mouse-moved ]
-    }
-    
-    { "rightMouseDragged:" "void" { "id" "SEL" "id" }
-        [ nip send-mouse-moved ]
-    }
-    
-    { "otherMouseDragged:" "void" { "id" "SEL" "id" }
-        [ nip send-mouse-moved ]
-    }
-    
-    { "mouseDown:" "void" { "id" "SEL" "id" }
-        [ nip send-button-down$ ]
-    }
-    
-    { "mouseUp:" "void" { "id" "SEL" "id" }
-        [ nip send-button-up$ ]
-    }
-    
-    { "rightMouseDown:" "void" { "id" "SEL" "id" }
-        [ nip send-button-down$ ]
-    }
-    
-    { "rightMouseUp:" "void" { "id" "SEL" "id" }
-        [ nip send-button-up$ ]
-    }
-    
-    { "otherMouseDown:" "void" { "id" "SEL" "id" }
-        [ nip send-button-down$ ]
-    }
-    
-    { "otherMouseUp:" "void" { "id" "SEL" "id" }
-        [ nip send-button-up$ ]
-    }
-    
-    { "scrollWheel:" "void" { "id" "SEL" "id" }
-        [ nip send-wheel$ ]
-    }
-    
-    { "keyDown:" "void" { "id" "SEL" "id" }
-        [ nip send-key-down-event ]
-    }
-    
-    { "keyUp:" "void" { "id" "SEL" "id" }
-        [ nip send-key-up-event ]
-    }
-
-    { "updateFactorGadgetSize:" "void" { "id" "SEL" "id" }
-        [ 2drop dup view-dim swap view set-gadget-dim ]
-    }
-    
-    { "acceptsFirstResponder" "bool" { "id" "SEL" }
-        [ 2drop 1 ]
-    }
-    
-    { "initWithFrame:pixelFormat:" "id" { "id" "SEL" "NSRect" "id" }
-        [
-            rot drop
-            SUPER-> [initWithFrame:pixelFormat:]
-            dup "updateFactorGadgetSize:" add-resize-observer
-        ]
-    }
-    
-    { "dealloc" "void" { "id" "SEL" }
-        [
-            drop
-            dup view close-world
-            dup views get remove-hash
-            dup remove-observer
-            SUPER-> [dealloc]
-        ]
     }
 } { } define-objc-class
 
-: register-view ( world -- )
+: install-app-delegate ( -- )
-    dup world-handle views get set-hash ;
+    NSApp
-
+    FactorApplicationDelegate [alloc] [init] [setDelegate:] ;
-: <FactorView> ( gadget -- view )
-    FactorView over rect-dim <GLView>
-    [ over set-world-handle dup add-notify register-view ] keep ;
-
-
-: window-root-gadget-pref-dim  [contentView] view pref-dim ;
-
-: frame-rect-for-window-content-rect ( window rect -- rect )
-    swap [styleMask] NSWindow -rot [frameRectForContentRect:styleMask:] ;
-
-: content-rect-for-window-frame-rect ( window rect -- rect )
-    swap [styleMask] NSWindow -rot [contentRectForFrameRect:styleMask:] ;
-
-: window-content-rect ( window -- rect )
-    dup [frame] content-rect-for-window-frame-rect ;
-
-"NSObject" "FactorUIWindowDelegate" {
-    { "windowWillUseStandardFrame:defaultFrame:" "NSRect" { "id" "SEL" "id" "NSRect" }
-        [
-            drop 2nip
-            dup window-content-rect NSRect-x-far-y
-            pick window-root-gadget-pref-dim first2
-            <far-y-NSRect>
-            frame-rect-for-window-content-rect
-        ]
-    }
-} { } define-objc-class
-
-: install-window-delegate ( window -- )
-    FactorUIWindowDelegate [alloc] [init] [setDelegate:] ;
 
 IN: gadgets
+USING: errors freetype gadgets-cocoa objc-NSOpenGLContext
+objc-NSOpenGLView objc-NSView objc-NSWindow ;
 
 : redraw-world ( handle -- )
     world-handle 1 [setNeedsDisplay:] ;
@@ -234,6 +50,7 @@ IN: shells
     ] unless
     [
         [
+            install-app-delegate
             reset-views
             reset-callbacks
             init-ui

library/cocoa/view-utils.factor

@@ -1,8 +1,13 @@
 ! Copyright (C) 2006 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
+IN: objc-FactorView
+DEFER: FactorView
+
 IN: cocoa
-USING: arrays kernel objc-NSObject objc-NSOpenGLContext
+USING: arrays gadgets gadgets-layouts hashtables kernel math
-objc-NSOpenGLView objc-NSView opengl sequences ;
+namespaces objc objc-NSEvent objc-NSObject
+objc-NSOpenGLContext objc-NSOpenGLView objc-NSView opengl
+sequences ;
 
 : <GLView> ( class dim -- view )
     >r [alloc] 0 0 r> first2 <NSRect>
@@ -18,3 +23,172 @@ objc-NSOpenGLView objc-NSView opengl sequences ;
 
 : add-resize-observer ( view selector -- )
     NSViewFrameDidChangeNotification pick add-observer ;
+
+! Hash mapping aliens to gadgets
+SYMBOL: views
+
+: reset-views ( hash -- hash ) H{ } clone views set-global ;
+
+reset-views
+
+: view ( handle -- world ) views get hash ;
+
+: mouse-location ( view event -- loc )
+    over >r
+    [locationInWindow] f [convertPoint:fromView:]
+    dup NSPoint-x swap NSPoint-y
+    r> [frame] NSRect-h swap - 0 3array ;
+
+: send-mouse-moved ( view event -- )
+    over >r mouse-location r> view move-hand ;
+
+: button ( event -- n )
+    #! Cocoa -> Factor UI button mapping
+    [buttonNumber] H{ { 0 1 } { 2 2 } { 1 3 } } hash ;
+
+: button&loc ( view event -- button# loc )
+    dup button -rot mouse-location ;
+
+: modifiers
+    {
+        { S+ HEX: 10000 }
+        { C+ HEX: 40000 }
+        { A+ HEX: 80000 }
+        { M+ HEX: 100000 }
+    } ;
+
+: key-codes
+    H{
+        { 36 "RETURN" }
+        { 48 "TAB" }
+        { 51 "BACKSPACE" }
+        { 115 "HOME" }
+        { 117 "DELETE" }
+        { 119 "END" }
+        { 123 "LEFT" }
+        { 124 "RIGHT" }
+        { 125 "DOWN" }
+        { 126 "UP" }
+    } ;
+
+: key-code ( event -- string )
+    dup [keyCode] key-codes hash
+    [ ] [ [charactersIgnoringModifiers] CF>string ] ?if ;
+
+: event>gesture ( event -- modifiers keycode )
+    dup [modifierFlags] modifiers modifier swap key-code ;
+
+: send-key-event ( view event quot -- )
+    >r event>gesture r> call swap view world-focus
+    handle-gesture ; inline
+
+: send-user-input ( view event -- )
+    [characters] CF>string swap view world-focus user-input ;
+
+: send-key-down-event ( view event -- )
+    2dup [ <key-down> ] send-key-event
+    [ send-user-input ] [ 2drop ] if ;
+
+: send-key-up-event ( view event -- )
+    [ <key-up> ] send-key-event ;
+
+: send-button-down$ ( view event -- )
+    over >r button&loc r> view send-button-down ;
+
+: send-button-up$ ( view event -- )
+    over >r button&loc r> view send-button-up ;
+
+: send-wheel$ ( view event -- )
+    [ [deltaY] 0 > ] 2keep mouse-location rot view send-wheel ;
+
+"NSOpenGLView" "FactorView" {
+    { "drawRect:" "void" { "id" "SEL" "NSRect" }
+        [ 2drop view draw-world ]
+    }
+    
+    { "mouseMoved:" "void" { "id" "SEL" "id" }
+        [ nip send-mouse-moved ]
+    }
+    
+    { "mouseDragged:" "void" { "id" "SEL" "id" }
+        [ nip send-mouse-moved ]
+    }
+    
+    { "rightMouseDragged:" "void" { "id" "SEL" "id" }
+        [ nip send-mouse-moved ]
+    }
+    
+    { "otherMouseDragged:" "void" { "id" "SEL" "id" }
+        [ nip send-mouse-moved ]
+    }
+    
+    { "mouseDown:" "void" { "id" "SEL" "id" }
+        [ nip send-button-down$ ]
+    }
+    
+    { "mouseUp:" "void" { "id" "SEL" "id" }
+        [ nip send-button-up$ ]
+    }
+    
+    { "rightMouseDown:" "void" { "id" "SEL" "id" }
+        [ nip send-button-down$ ]
+    }
+    
+    { "rightMouseUp:" "void" { "id" "SEL" "id" }
+        [ nip send-button-up$ ]
+    }
+    
+    { "otherMouseDown:" "void" { "id" "SEL" "id" }
+        [ nip send-button-down$ ]
+    }
+    
+    { "otherMouseUp:" "void" { "id" "SEL" "id" }
+        [ nip send-button-up$ ]
+    }
+    
+    { "scrollWheel:" "void" { "id" "SEL" "id" }
+        [ nip send-wheel$ ]
+    }
+    
+    { "keyDown:" "void" { "id" "SEL" "id" }
+        [ nip send-key-down-event ]
+    }
+    
+    { "keyUp:" "void" { "id" "SEL" "id" }
+        [ nip send-key-up-event ]
+    }
+
+    { "updateFactorGadgetSize:" "void" { "id" "SEL" "id" }
+        [ 2drop dup view-dim swap view set-gadget-dim ]
+    }
+    
+    { "acceptsFirstResponder" "bool" { "id" "SEL" }
+        [ 2drop 1 ]
+    }
+    
+    { "initWithFrame:pixelFormat:" "id" { "id" "SEL" "NSRect" "id" }
+        [
+            rot drop
+            SUPER-> [initWithFrame:pixelFormat:]
+            dup "updateFactorGadgetSize:" add-resize-observer
+        ]
+    }
+    
+    { "dealloc" "void" { "id" "SEL" }
+        [
+            drop
+            dup view close-world
+            dup views get remove-hash
+            dup remove-observer
+            SUPER-> [dealloc]
+        ]
+    }
+} { } define-objc-class
+
+: register-view ( world -- )
+    dup world-handle views get set-hash ;
+
+: <FactorView> ( gadget -- view )
+    FactorView over rect-dim <GLView> [
+        over set-world-handle dup add-notify register-view
+    ] keep ;

library/cocoa/window-utils.factor

@@ -1,7 +1,11 @@
 ! Copyright (C) 2006 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
+IN: objc-FactorWindowDelegate
+DEFER: FactorWindowDelegate
+
 IN: cocoa
-USING: kernel math objc-NSObject objc-NSView objc-NSWindow ;
+USING: gadgets-layouts kernel math objc objc-NSObject
+objc-NSView objc-NSWindow sequences ;
 
 : NSBorderlessWindowMask     0 ; inline
 : NSTitledWindowMask         1 ; inline
@@ -31,3 +35,33 @@ USING: kernel math objc-NSObject objc-NSView objc-NSWindow ;
     dup dup [contentView] [setInitialFirstResponder:]
     dup 1 [setAcceptsMouseMovedEvents:]
     dup f [makeKeyAndOrderFront:] ;
+
+: window-root-gadget-pref-dim  [contentView] view pref-dim ;
+
+: frame-rect-for-window-content-rect ( window rect -- rect )
+    swap [styleMask] NSWindow -rot
+    [frameRectForContentRect:styleMask:] ;
+
+: content-rect-for-window-frame-rect ( window rect -- rect )
+    swap [styleMask] NSWindow -rot
+    [contentRectForFrameRect:styleMask:] ;
+
+: window-content-rect ( window -- rect )
+    dup [frame] content-rect-for-window-frame-rect ;
+
+"NSObject" "FactorWindowDelegate" {
+    {
+        "windowWillUseStandardFrame:defaultFrame:" "NSRect"
+        { "id" "SEL" "id" "NSRect" }
+        [
+            drop 2nip
+            dup window-content-rect NSRect-x-far-y
+            pick window-root-gadget-pref-dim first2
+            <far-y-NSRect>
+            frame-rect-for-window-content-rect
+        ]
+    }
+} { } define-objc-class
+
+: install-window-delegate ( window -- )
+    FactorWindowDelegate [alloc] [init] [setDelegate:] ;

library/syntax/parse-stream.factor

@@ -32,6 +32,9 @@ words ;
 
 : try-run-file ( file -- ) [ [ run-file ] keep ] try drop ;
 
+: eval>string ( str -- str )
+    [ [ [ eval ] keep ] try drop ] string-out ;
+
 : parse-resource ( path -- quot )
     dup parsing-file
     [ <resource-stream> "resource:" ] keep append parse-stream ;

library/tools/jedit.factor

@@ -55,9 +55,6 @@ parser prettyprint sequences strings words ;
 
 : read-packet ( -- string ) 4 read be> read ;
 
-: eval>string ( str -- )
-    [ [ [ eval ] keep ] try drop ] string-out ;
-
 : wire-server ( -- )
     #! Repeatedly read jEdit requests and execute them. Return
     #! on EOF.