New Objective C method invocation syntax

library/ui/cocoa/application-utils.factor

@@ -2,35 +2,33 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: cocoa
 USING: alien errors gadgets io kernel namespaces objc
-objc-NSApplication objc-NSAutoreleasePool objc-NSException
+objc-classes sequences threads ;
-objc-NSNotificationCenter objc-NSObject objc-NSView sequences
-threads ;
 
 : NSApplicationDelegateReplySuccess 0 ;
 : NSApplicationDelegateReplyCancel  1 ;
 : NSApplicationDelegateReplyFailure 2 ;
 
 : with-autorelease-pool ( quot -- )
-    NSAutoreleasePool [new] slip [release] ; inline
+    NSAutoreleasePool -> new slip -> release ; inline
 
-: NSApp NSApplication [sharedApplication] ;
+: NSApp NSApplication -> sharedApplication ;
 
 : with-cocoa ( quot -- )
     [ NSApp drop call ] with-autorelease-pool ;
 
-: <NSString> ( str -- alien ) <CFString> [autorelease] ;
+: <NSString> ( str -- alien ) <CFString> -> autorelease ;
 
-: <NSArray> ( seq -- alien ) <CFArray> [autorelease] ;
+: <NSArray> ( seq -- alien ) <CFArray> -> autorelease ;
 
 : CFRunLoopDefaultMode "kCFRunLoopDefaultMode" <NSString> ;
 
 : next-event ( app -- event )
     0 f CFRunLoopDefaultMode 1
-    [nextEventMatchingMask:untilDate:inMode:dequeue:] ;
+    -> nextEventMatchingMask:untilDate:inMode:dequeue: ;
 
 : do-event ( app -- ? )
     [
-        dup next-event [ [sendEvent:] t ] [ drop f ] if*
+        dup next-event [ -> sendEvent: t ] [ drop f ] if*
     ] with-autorelease-pool ;
 
 : do-events ( app -- )
@@ -41,20 +39,21 @@ threads ;
     event-loop ;
 
 : add-observer ( observer selector name object -- )
-    >r >r >r >r NSNotificationCenter [defaultCenter] r> r>
+    >r >r >r >r NSNotificationCenter -> defaultCenter
-    sel_registerName r> r> [addObserver:selector:name:object:] ;
+    r> r> sel_registerName
+    r> r> -> addObserver:selector:name:object: ;
 
 : remove-observer ( observer -- )
-    >r NSNotificationCenter [defaultCenter] r>
+    >r NSNotificationCenter -> defaultCenter r>
-    [removeObserver:] ;
+    -> removeObserver: ;
 
-: finish-launching ( -- ) NSApp [finishLaunching] ;
+: finish-launching ( -- ) NSApp -> finishLaunching ;
 
 : install-delegate ( receiver delegate -- )
-    [alloc] [init] [setDelegate:] ;
+    -> alloc -> init -> setDelegate: ;
 
 IN: errors
 
 : objc-error. ( error -- )
     "Objective C exception:" print
-    third [reason] CF>string print ;
+    third -> reason CF>string print ;

library/ui/cocoa/callback.factor

@@ -1,10 +1,10 @@
 ! Copyright (C) 2005, 2006 Kevin Reid.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: objc-FactorCallback
+IN: objc-classes
 DEFER: FactorCallback
 
 IN: cocoa
-USING: hashtables kernel namespaces objc objc-NSObject ;
+USING: hashtables kernel namespaces objc ;
 
 SYMBOL: callbacks
 
@@ -22,11 +22,11 @@ reset-callbacks
         [
             drop
             dup callbacks get remove-hash
-            SUPER-> [dealloc]
+            SUPER-> dealloc
         ]
     }
 } { } define-objc-class
 
 : <FactorCallback> ( quot -- id | quot: id -- )
-    FactorCallback [alloc] [init]
+    FactorCallback -> alloc -> init
     [ callbacks get set-hash ] keep ;

library/ui/cocoa/dialogs.factor

@@ -1,19 +1,18 @@
 ! Copyright (C) 2006 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 IN: cocoa
-USING: kernel objc-NSObject objc-NSOpenPanel objc-NSSavePanel
+USING: kernel objc-classes sequences ;
-sequences ;
 
 : <NSOpenPanel> ( -- panel )
-    NSOpenPanel [openPanel]
+    NSOpenPanel -> openPanel
-    dup 1 [setCanChooseFiles:]
+    dup 1 -> setCanChooseFiles:
-    dup 0 [setCanChooseDirectories:]
+    dup 0 -> setCanChooseDirectories:
-    dup 1 [setResolvesAliases:]
+    dup 1 -> setResolvesAliases:
-    dup 1 [setAllowsMultipleSelection:] ;
+    dup 1 -> setAllowsMultipleSelection: ;
 
 : NSOKButton 1 ;
 : NSCancelButton 0 ;
 
 : open-panel ( -- paths )
-    <NSOpenPanel> dup f [runModalForTypes:] NSOKButton =
+    <NSOpenPanel> dup f -> runModalForTypes: NSOKButton =
-    [ [filenames] CF>string-array ] [ drop f ] if ;
+    [ -> filenames CF>string-array ] [ drop f ] if ;

library/ui/cocoa/load.factor

@@ -21,4 +21,4 @@ USING: compiler io parser sequences words ;
 ] each
 
 "Compiling Cocoa bindings..." print
-vocabs [ "objc-" head? ] subset compile-vocabs
+{ "cocoa" "objc" "objc-classes" } compile-vocabs

library/ui/cocoa/menu-bar.factor

@@ -2,9 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: cocoa compiler gadgets gadgets-browser gadgets-launchpad
 gadgets-layouts gadgets-listener kernel memory objc
-objc-FactorCallback objc-NSApplication objc-NSMenu
+objc-classes sequences strings words ;
-objc-NSMenuItem objc-NSObject objc-NSWindow sequences strings
-words ;
 IN: cocoa
 
 ! -------------------------------------------------------------------------
@@ -18,36 +16,36 @@ M: quotation to-target-and-action
     <FactorCallback> "perform:" sel_registerName swap ;
 
 : <NSMenu> ( title -- )
-    NSMenu [alloc]
+    NSMenu -> alloc
-    swap <NSString> [initWithTitle:]
+    swap <NSString> -> initWithTitle:
-    [autorelease] ;
+    -> autorelease ;
 
-: set-main-menu ( menu -- ) NSApp swap [setMainMenu:] ;
+: set-main-menu ( menu -- ) NSApp swap -> setMainMenu: ;
 
 : <NSMenuItem> ( title action equivalent -- item )
     >r >r >r
-    NSMenuItem [alloc]
+    NSMenuItem -> alloc
     r> <NSString>
     r> dup [ sel_registerName ] when
     r> <NSString>
-    [initWithTitle:action:keyEquivalent:] [autorelease] ;
+    -> initWithTitle:action:keyEquivalent: -> autorelease ;
 
 : make-menu-item ( title spec -- item )
     to-target-and-action >r swap <NSMenuItem> dup
-    r> [setTarget:] ;
+    r> -> setTarget: ;
 
 : submenu-to-item ( menu -- item )
-    dup [title] CF>string f "" <NSMenuItem> dup
+    dup -> title CF>string f "" <NSMenuItem> dup
-    rot [setSubmenu:] ;
+    rot -> setSubmenu: ;
 
 : add-submenu ( menu submenu -- )
-    submenu-to-item [addItem:] ;
+    submenu-to-item -> addItem: ;
 
 : and-modifiers ( item key-equivalent-modifier-mask -- item )
-    dupd [setKeyEquivalentModifierMask:] ;
+    dupd -> setKeyEquivalentModifierMask: ;
 
 : and-alternate ( item -- item )
-    dup 1 [setAlternate:] ;
+    dup 1 -> setAlternate: ;
 
 : and-option-equivalent-modifier 1572864 and-modifiers ;
 
@@ -66,7 +64,7 @@ DEFER: described-menu
 ! this is a mess
 : described-item ( desc -- menu-item )
     dup length 0 = [
-        drop NSMenuItem [separatorItem]
+        drop NSMenuItem -> separatorItem
     ] [
         dup first string? [
             [ first3 swap make-menu-item ] keep
@@ -79,7 +77,7 @@ DEFER: described-menu
     ] if ;
 
 : and-described-item ( menu desc -- same-menu )
-    described-item dupd [addItem:] ;
+    described-item dupd -> addItem: ;
 
 : described-menu ( { title items* } -- menu )
     [ first <NSMenu> ] keep
@@ -102,14 +100,14 @@ DEFER: described-menu
             ! Preferences goes here
             { {
                 "Services"
-            } [ NSApp over [setServicesMenu:] ] }
+            } [ NSApp over -> setServicesMenu: ] }
             { }
             { "Hide Factor" "hide:" "h" }
             { "Hide Others" "hideOtherApplications:" "h" [ and-option-equivalent-modifier ] }
             { "Show All" "unhideAllApplications:" "" }
             { }
             { "Quit" "terminate:" "q" }
-        } [ NSApp over [setAppleMenu:] ] }
+        } [ NSApp over -> setAppleMenu: ] }
         { {
             "File"
             { "New Listener" listener-window "n" }
@@ -143,7 +141,7 @@ DEFER: described-menu
             { "Minimize All" "miniaturizeAll:" "m"  [ and-alternate and-option-equivalent-modifier ] }
             { }
             { "Bring All to Front" "arrangeInFront:" "" }
-        } [ NSApp over [setWindowsMenu:] ] }
+        } [ NSApp over -> setWindowsMenu: ] }
         { {
             "Help"
             { "Factor Documentation" handbook-window "?" }

library/ui/cocoa/pasteboard-utils.factor

@@ -1,21 +1,21 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: cocoa
-USING: arrays kernel objc-NSPasteboard sequences ;
+USING: arrays kernel objc-classes sequences ;
 
 : NSStringPboardType "NSStringPboardType" ;
 
 : pasteboard-string? ( type id -- seq )
-    NSStringPboardType swap [types] CF>string-array member? ;
+    NSStringPboardType swap -> types CF>string-array member? ;
 
 : pasteboard-string ( id -- str )
-    NSStringPboardType <NSString> [stringForType:]
+    NSStringPboardType <NSString> -> stringForType:
     dup [ CF>string ] when ;
 
 : set-pasteboard-types ( seq id -- )
-    swap <NSArray> f [declareTypes:owner:] drop ;
+    swap <NSArray> f -> declareTypes:owner: drop ;
 
 : set-pasteboard-string ( str id -- )
     NSStringPboardType <NSString>
     dup 1array pick set-pasteboard-types
-    >r swap <NSString> r> [setString:forType:] drop ;
+    >r swap <NSString> r> -> setString:forType: drop ;

library/ui/cocoa/services.factor

@@ -1,9 +1,11 @@
-IN: objc-FactorServiceProvider
+! Copyright (C) 2006 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+IN: objc-classes
 DEFER: FactorServiceProvider
 
 IN: cocoa
 USING: alien gadgets-presentations io kernel namespaces objc
-objc-NSApplication objc-NSObject parser prettyprint styles ;
+parser prettyprint styles ;
 
 : pasteboard-error ( error str -- f )
     "Pasteboard does not hold a string" <NSString>
@@ -36,5 +38,5 @@ objc-NSApplication objc-NSObject parser prettyprint styles ;
 
 : register-services ( -- )
     NSApp
-    FactorServiceProvider [alloc] [init]
+    FactorServiceProvider -> alloc -> init
-    [setServicesProvider:] ;
+    -> setServicesProvider: ;

library/ui/cocoa/ui.factor

@@ -1,18 +1,16 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: objc-FactorApplicationDelegate
+IN: objc-classes
-
 DEFER: FactorApplicationDelegate
 
 IN: cocoa
 USING: arrays gadgets gadgets-layouts gadgets-listener
-hashtables kernel namespaces objc objc-NSApplication
+hashtables kernel namespaces objc sequences errors freetype ;
-objc-NSObject objc-NSWindow sequences ;
 
 : finder-run-files ( alien -- )
     CF>string-array listener-run-files
     NSApp NSApplicationDelegateReplySuccess
-    [replyToOpenOrPrint:] ;
+    -> replyToOpenOrPrint: ;
 
 ! Handle Open events from the Finder
 "NSObject" "FactorApplicationDelegate" {
@@ -39,30 +37,28 @@ objc-NSObject objc-NSWindow sequences ;
         dup <FactorView>
         dup rot rect>NSRect <ViewWindow>
         dup install-window-delegate
-        over [release]
+        over -> release
         2array
     ] keep set-world-handle ;
 
 IN: gadgets
-USING: errors freetype objc-NSOpenGLContext
-objc-NSOpenGLView objc-NSView ;
 
 : redraw-world ( world -- )
-    world-handle first 1 [setNeedsDisplay:] ;
+    world-handle first 1 -> setNeedsDisplay: ;
 
 : set-title ( string world -- )
-    world-handle second swap <NSString> [setTitle:] ;
+    world-handle second swap <NSString> -> setTitle: ;
 
 : open-window* ( world -- )
     dup gadget-window
     dup start-world
-    world-handle second f [makeKeyAndOrderFront:] ;
+    world-handle second f -> makeKeyAndOrderFront: ;
 
 : select-gl-context ( handle -- )
-    first [openGLContext] [makeCurrentContext] ;
+    first -> openGLContext -> makeCurrentContext ;
 
 : flush-gl-context ( handle -- )
-    first [openGLContext] [flushBuffer] ;
+    first -> openGLContext -> flushBuffer ;
 
 IN: shells
 

library/ui/cocoa/utilities.factor

@@ -1,9 +1,54 @@
-! Copyright (C) 2006 Slava Pestov
-! See http://factorcode.org/license.txt for BSD license.
 IN: objc
-USING: alien arrays errors hashtables kernel math
+USING: alien arrays errors hashtables inference kernel math
 namespaces parser sequences strings words ;
 
+: make-alien-invoke [ ] make \ alien-invoke add ; inline
+
+: make-sender ( method function -- quot )
+    [ over first , f , , second , ] make-alien-invoke ;
+
+: make-sender-stret ( method function -- quot )
+    [
+        [ "void" f ] %
+        "_stret" append ,
+        { "void*" } swap second append ,
+    ] make-alien-invoke ;
+
+: sender-stub ( method function -- word )
+    over first c-struct?
+    [ make-sender-stret ] [ make-sender ] if
+    define-temp ;
+
+SYMBOL: msg-senders
+H{ } clone msg-senders set-global
+
+SYMBOL: super-msg-senders
+H{ } clone super-msg-senders set-global
+
+: (cache-stub) ( method function hash -- word )
+    [
+        over second get dup [
+            2nip
+        ] [
+            drop over >r sender-stub dup r> second set
+        ] if
+    ] bind ;
+
+: cache-stub ( method super? -- word )
+    [ "objc_msgSendSuper" "objc_msgSend" ? ] keep
+    super-msg-senders msg-senders ? get
+    (cache-stub) ;
+
+: <super> ( receiver -- super )
+    "objc-super" <c-object> [
+        >r dup objc-object-isa objc-class-super-class r>
+        set-objc-super-class
+    ] keep
+    [ set-objc-super-receiver ] keep ;
+
+: make-stret-quot ( returns -- quot )
+    [ <c-object> dup ] curry 1 make-dip ;
+
 TUPLE: selector name object ;
 
 C: selector ( name -- sel ) [ set-selector-name ] keep ;
@@ -16,10 +61,61 @@ C: selector ( name -- sel ) [ set-selector-name ] keep ;
         selector-object
     ] if ;
 
-: objc-classes ( -- seq )
+SYMBOL: selectors
-    f 0 objc_getClassList
+
-    [ "void*" <c-array> dup ] keep objc_getClassList
+H{ } clone selectors set-global
-    [ swap void*-nth objc-class-name ] map-with ;
+
+: cache-selector selectors get-global [ <selector> ] cache ;
+
+SYMBOL: objc-methods
+H{ } clone objc-methods set-global
+
+: lookup-method ( selector -- method )
+    dup objc-methods get hash
+    [ ] [ "No such method: " swap append throw ] ?if ;
+
+: (make-prepare-send) ( selector method -- quot )
+    [
+        [ \ <super> , ] when
+        dup first c-struct? [ make-stret-quot % ] [ drop ] if
+        cache-selector , \ selector ,
+    ] [ ] make ;
+
+: make-prepare-send ( selector method super? -- quot )
+    over second length 2 - >r (make-prepare-send) r> make-dip ;
+
+: make-objc-send ( selector super? -- quot )
+    >r dup lookup-method r> 2dup cache-stub >r
+    make-prepare-send r> add ;
+
+: infer-send ( super? -- )
+    pop-literal rot make-objc-send infer-quot-value ;
+
+: compile-send-error
+    "Objective C message sends must be compiled" throw ;
+
+: send ( ... selector -- ... ) compile-send-error ;
+
+\ send [ f infer-send ] "infer-quot" set-word-prop
+
+: -> scan parsed \ send parsed ; parsing
+
+: super-send ( ... selector -- ... ) compile-send-error ;
+
+\ super-send [ t infer-send ] "infer-quot" set-word-prop
+
+: SUPER-> scan parsed \ super-send parsed ; parsing
+
+! Runtime introspection
+: (objc-class) ( string word -- class )
+    dupd execute
+    [ ] [ "No such class: " swap append throw ] ?if ; inline
+
+: objc-class ( string -- class )
+    \ objc_getClass (objc-class) ;
+
+: objc-meta-class ( string -- class )
+    \ objc_getMetaClass (objc-class) ;
 
 : method-arg-type ( method i -- type )
     f <void*> 0 <int> over
@@ -49,6 +145,7 @@ H{
     { ":" "SEL" }
 } objc>alien-types set-global
 
+! The transpose of the above map
 SYMBOL: alien>objc-types
 
 objc>alien-types get hash>alist [ reverse ] map alist>hash
@@ -81,87 +178,27 @@ H{
     #! Undocumented hack! Apple does not support this feature!
     objc-method-types parse-objc-type ;
 
-: objc-method-info ( method -- { return name args } )
+: register-objc-method ( method -- )
-    [ method-return-type ] keep
+    dup method-return-type over method-arg-types 2array
-    [ objc-method-name sel_getName ] keep
+    swap objc-method-name sel_getName
-    method-arg-types 3array ;
+    objc-methods get set-hash ;
 
 : method-list@ ( ptr -- ptr )
     "objc-method-list" c-size swap <displaced-alien> ;
 
-: method-list>seq ( method-list -- seq )
+: (register-objc-methods) ( objc-class iterator -- )
-    dup method-list@ swap objc-method-list-count
+    2dup class_nextMethodList [
-    [ swap objc-method-nth objc-method-info ] map-with ;
+        dup method-list@ swap objc-method-list-count [
+            swap objc-method-nth register-objc-method
+        ] each-with (register-objc-methods)
+    ] [
+        2drop
+    ] if* ;
 
-: (objc-methods) ( objc-class iterator -- )
+: register-objc-methods ( class -- seq )
-    2dup class_nextMethodList
+    f <void*> (register-objc-methods) ;
-    [ method-list>seq % (objc-methods) ] [ 2drop ] if* ;
 
-: objc-methods ( class -- seq )
+: class-exists? ( string -- class ) objc_getClass >boolean ;
-    [ f <void*> (objc-methods) ] { } make ;
-
-: (objc-class) ( string word -- class )
-    dupd execute
-    [ ] [ "No such class: " swap append throw ] ?if ; inline
-
-: objc-class ( string -- class )
-    \ objc_getClass (objc-class) ;
-
-: objc-meta-class ( string -- class )
-    \ objc_getMetaClass (objc-class) ;
-
-: class-exists? ( string -- class )
-    objc_getClass >boolean ;
-
-: instance-methods ( classname -- seq )
-    objc-class objc-methods ;
-
-: class-methods ( classname -- seq )
-    objc-meta-class objc-methods ;
-
-: <super> ( receiver class -- super )
-    "objc-super" <c-object>
-    [ set-objc-super-class ] keep
-    [ set-objc-super-receiver ] keep ;
-
-: SUPER-> \ SUPER-> on ; inline
-
-: ?super ( obj -- class )
-    objc-object-isa \ SUPER-> [ f ] change
-    [ objc-class-super-class ] when ; inline
-
-: selector-quot ( string -- )
-    [
-        [ dup ?super <super> ] % <selector> , \ selector ,
-    ] [ ] make ;
-
-: make-objc-invoke
-    [
-        >r over length 2 - make-dip % r> call \ alien-invoke ,
-    ] [ ] make ;
-
-: make-objc-send ( returns args selector -- )
-    selector-quot
-    [ swap , [ f "objc_msgSendSuper" ] % , ] make-objc-invoke ;
-
-: make-objc-send-stret ( returns args selector -- )
-    >r swap [ <c-object> dup ] curry 1 make-dip r>
-    selector-quot append [
-        "void" ,
-        [ f "objc_msgSendSuper_stret" ] %
-        { "void*" } swap append ,
-    ] make-objc-invoke ;
-
-: make-objc-method ( returns args selector -- )
-    pick c-struct?
-    [ make-objc-send-stret ] [ make-objc-send ] if ;
-
-: import-objc-method ( returns types selector -- )
-    [ make-objc-method "[" ] keep "]" append3 create-in
-    swap define-compound ;
-
-: import-objc-methods ( seq -- )
-    [ first3 swap import-objc-method ] each ;
 
 : unless-defined ( class quot -- )
     >r class-exists? r> unless ; inline
@@ -169,18 +206,13 @@ H{
 : define-objc-class-word ( name quot -- )
     [
         over , , \ unless-defined , dup , \ objc-class ,
-    ] [ ] make >r create-in r> define-compound ;
+    ] [ ] make >r "objc-classes" create r> define-compound ;
 
 : import-objc-class ( name quot -- )
     #! The quotation is prepended to the class word. It should
     #! "regenerate" the class as appropriate (by loading a
     #! framework or defining the class in some manner).
-    2dup unless-defined [
+    2dup unless-defined
-        "objc-" pick append in set
+    dupd define-objc-class-word
-        dupd define-objc-class-word
+    dup objc-class register-objc-methods
-        dup instance-methods import-objc-methods
+    objc-meta-class register-objc-methods ;
-        class-methods import-objc-methods
-    ] with-scope ;
-
-: root-class ( class -- class )
-    dup objc-class-super-class [ root-class ] [ ] ?if ;

library/ui/cocoa/view-utils.factor

@@ -1,35 +1,33 @@
 ! Copyright (C) 2006 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-IN: objc-FactorView
+IN: objc-classes
 DEFER: FactorView
 
 IN: cocoa
 USING: arrays gadgets gadgets-layouts hashtables kernel math
-namespaces objc objc-NSEvent objc-NSObject
+namespaces objc opengl sequences ;
-objc-NSOpenGLContext objc-NSOpenGLView objc-NSView opengl
-sequences ;
 
 : <GLView> ( class dim -- view )
-    >r [alloc] 0 0 r> first2 <NSRect>
+    >r -> alloc 0 0 r> first2 <NSRect>
-    NSOpenGLView [defaultPixelFormat]
+    NSOpenGLView -> defaultPixelFormat
-    [initWithFrame:pixelFormat:]
+    -> initWithFrame:pixelFormat:
-    dup 1 [setPostsBoundsChangedNotifications:]
+    dup 1 -> setPostsBoundsChangedNotifications:
-    dup 1 [setPostsFrameChangedNotifications:] ;
+    dup 1 -> setPostsFrameChangedNotifications: ;
 
-: view-dim [bounds] dup NSRect-w swap NSRect-h 0 3array ;
+: view-dim -> bounds dup NSRect-w swap NSRect-h 0 3array ;
 
 : mouse-location ( view event -- loc )
     over >r
-    [locationInWindow] f [convertPoint:fromView:]
+    -> locationInWindow f -> convertPoint:fromView:
     dup NSPoint-x swap NSPoint-y
-    r> [frame] NSRect-h swap - 0 3array ;
+    r> -> frame NSRect-h swap - 0 3array ;
 
 : send-mouse-moved ( view event -- )
     over >r mouse-location r> window move-hand ;
 
 : button ( event -- n )
     #! Cocoa -> Factor UI button mapping
-    [buttonNumber] H{ { 0 1 } { 2 2 } { 1 3 } } hash ;
+    -> buttonNumber H{ { 0 1 } { 2 2 } { 1 3 } } hash ;
 
 : button&loc ( view event -- button# loc )
     dup button -rot mouse-location ;
@@ -57,18 +55,18 @@ sequences ;
     } ;
 
 : key-code ( event -- string )
-    dup [keyCode] key-codes hash
+    dup -> keyCode key-codes hash
-    [ ] [ [charactersIgnoringModifiers] CF>string ] ?if ;
+    [ ] [ -> charactersIgnoringModifiers CF>string ] ?if ;
 
 : event>gesture ( event -- modifiers keycode )
-    dup [modifierFlags] modifiers modifier swap key-code ;
+    dup -> modifierFlags modifiers modifier swap key-code ;
 
 : send-key-event ( view event quot -- )
     >r event>gesture r> call swap window world-focus
     handle-gesture ; inline
 
 : send-user-input ( view event -- )
-    [characters] CF>string swap window world-focus user-input ;
+    -> characters CF>string swap window world-focus user-input ;
 
 : send-key-down-event ( view event -- )
     2dup [ <key-down> ] send-key-event
@@ -84,7 +82,7 @@ sequences ;
     over >r button&loc r> window send-button-up ;
 
 : send-wheel$ ( view event -- )
-    [ [deltaY] 0 > ] 2keep mouse-location
+    [ -> deltaY 0 > ] 2keep mouse-location
     rot window send-wheel ;
 
 : add-resize-observer ( observer object -- )
@@ -160,7 +158,7 @@ sequences ;
     { "initWithFrame:pixelFormat:" "id" { "id" "SEL" "NSRect" "id" }
         [
             rot drop
-            SUPER-> [initWithFrame:pixelFormat:]
+            SUPER-> initWithFrame:pixelFormat:
             dup dup add-resize-observer
         ]
     }
@@ -171,7 +169,7 @@ sequences ;
             dup window close-world
             dup unregister-window
             dup remove-observer
-            SUPER-> [dealloc]
+            SUPER-> dealloc
         ]
     }
 } { } define-objc-class

library/ui/cocoa/window-utils.factor

@@ -1,11 +1,10 @@
 ! Copyright (C) 2006 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-IN: objc-FactorWindowDelegate
+IN: objc-classes
 DEFER: FactorWindowDelegate
 
 IN: cocoa
 USING: arrays gadgets gadgets-layouts kernel math objc
-objc-NSNotification objc-NSObject objc-NSView objc-NSWindow
 sequences ;
 
 : NSBorderlessWindowMask     0 ; inline
@@ -25,24 +24,24 @@ sequences ;
     NSResizableWindowMask bitor ; inline
 
 : <NSWindow> ( rect -- window )
-    NSWindow [alloc] swap
+    NSWindow -> alloc swap
     standard-window-type NSBackingStoreBuffered 1
-    [initWithContentRect:styleMask:backing:defer:] ;
+    -> initWithContentRect:styleMask:backing:defer: ;
 
 : <ViewWindow> ( view bounds -- window )
-    <NSWindow> [ swap [setContentView:] ] keep
+    <NSWindow> [ swap -> setContentView: ] keep
-    dup dup [contentView] [setInitialFirstResponder:]
+    dup dup -> contentView -> setInitialFirstResponder:
-    dup 1 [setAcceptsMouseMovedEvents:] ;
+    dup 1 -> setAcceptsMouseMovedEvents: ;
 
-: window-pref-dim [contentView] window pref-dim ;
+: window-pref-dim -> contentView window pref-dim ;
 
 : frame-content-rect ( window rect -- rect )
-    swap [styleMask] NSWindow -rot
+    swap -> styleMask NSWindow -rot
-    [frameRectForContentRect:styleMask:] ;
+    -> frameRectForContentRect:styleMask: ;
 
 : window-content-rect ( window -- rect )
-    NSWindow over [frame] rot [styleMask]
+    NSWindow over -> frame rot -> styleMask
-    [contentRectForFrameRect:styleMask:] ;
+    -> contentRectForFrameRect:styleMask: ;
 
 "NSObject" "FactorWindowDelegate" {
     {
@@ -58,21 +57,21 @@ sequences ;
 
     {
         "windowDidMove:" "void" { "id" "SEL" "id" } [
-            2nip [object]
+            2nip -> object
             dup window-content-rect NSRect-x-y 0 3array
-            swap [contentView] window set-world-loc
+            swap -> contentView window set-world-loc
         ]
     }
 
     {
         "windowDidBecomeKey:" "void" { "id" "SEL" "id" } [
-            2nip [object] [contentView] window focus-world
+            2nip -> object -> contentView window focus-world
         ]
     }
 
     {
         "windowDidResignKey:" "void" { "id" "SEL" "id" } [
-            2nip [object] [contentView] window unfocus-world
+            2nip -> object -> contentView window unfocus-world
         ]
     }
 } { } define-objc-class