Standard Mac OS X menu bar, and FactorCallback class for target-action callbacks.

library/cocoa/callback.factor

@@ -0,0 +1,27 @@
+IN: objc-FactorCallback
+DEFER: FactorCallback
+
+IN: cocoa
+USING: hashtables kernel namespaces objc objc-NSObject ;
+
+SYMBOL: callbacks
+
+H{ } clone callbacks set
+
+"NSObject" "FactorCallback" {
+    { "perform:" "void" { "id" "SEL" "id" }
+        [ nip swap callbacks get hash call ]
+    }
+    
+    { "dealloc" "void" { "id" "SEL" }
+        [
+            drop
+            dup callbacks get remove-hash
+            SUPER-> [dealloc]
+        ]
+    }
+} { } define-objc-class
+
+: <FactorCallback> ( quot -- id | quot: id -- )
+    FactorCallback [alloc] [init]
+    [ callbacks get set-hash ] keep ;

library/cocoa/load.factor

@@ -7,9 +7,11 @@ USING: compiler io parser sequences words ;
     "/library/cocoa/core-foundation.factor"
     "/library/cocoa/types.factor"
     "/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/menu-bar.factor"
     "/library/cocoa/ui.factor"
 } [
     run-resource

library/cocoa/menu-bar.factor

@@ -0,0 +1,142 @@
+USING: kernel sequences objc cocoa objc-NSObject objc-NSApplication objc-NSWindow objc-NSMenu objc-NSMenuItem objc-FactorCallback gadgets gadgets-layouts gadgets-listener words compiler strings lists ;
+
+! for words used by menu bar actions (copied from launchpad.factor)
+USING: gadgets gadgets-browser gadgets-listener help inspector io kernel memory namespaces sequences gadgets-launchpad ; 
+
+IN: cocoa
+
+: NSApp NSApplication [sharedApplication] ;
+
+! -------------------------------------------------------------------------
+
+GENERIC: to-target-and-action ( selector-string-or-quotation -- target action )
+
+M: string to-target-and-action sel_registerName f swap ;
+M: f to-target-and-action f ;
+M: list to-target-and-action \ drop swons <FactorCallback> "perform:" sel_registerName ;
+
+
+: <NSMenu> NSMenu [alloc] swap <NSString> [initWithTitle:] [autorelease] ;
+
+: set-main-menu NSApp swap [setMainMenu:] ;
+
+: <NSMenuItem> ( title action equivalent -- item )
+    >r >r >r
+    NSMenuItem [alloc]
+    r> <NSString>
+    r> dup [ sel_registerName ] when
+    r> <NSString>
+    [initWithTitle:action:keyEquivalent:] [autorelease] ;
+
+: make-menu-item-2 ( title selector-string-or-quotation equivalent -- item )
+    swap to-target-and-action swap >r swap <NSMenuItem> dup r> [setTarget:] ;
+
+: submenu-to-item ( menu -- item )
+    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 ;
+
+! -------------------------------------------------------------------------
+
+DEFER: described-menu
+
+! { } => separator
+
+! { { ... } } or
+! { { ... } modify-quotation } => submenu as described in inner sequence
+
+! { title action equivalent } or
+! { title action equivalent modify-quotation } => item
+
+! this is a mess
+: described-item ( desc -- menu-item )
+    dup length 0 = [
+        drop NSMenuItem [separatorItem]
+    ] [
+        dup first string? [
+            [ first3 make-menu-item-2 ] keep
+            dup length 4 = [ fourth call ] [ drop ] if
+        ] [
+            [ first described-menu ] keep
+            dup length 2 = [ second call ] [ drop ] if
+            submenu-to-item
+        ] if
+    ] if ;
+
+: and-described-item ( menu desc -- same-menu )
+    described-item dupd [addItem:] ;
+
+: described-menu ( { title items* } -- menu )
+    [ first <NSMenu> ] keep
+    1 swap tail [ and-described-item ] each ;
+
+: and-described-submenu ( menu { title items* } -- menu )
+    described-menu dupd add-submenu ;
+
+! -------------------------------------------------------------------------
+
+
+: default-main-menu 
+    {
+        "<top>"
+        { {
+            "Factor"
+            ! About goes here
+            ! Preferences goes here
+            { {
+                "Services"
+            } [ dup NSApp swap [setServicesMenu:] ] }
+            { }
+            { "Hide Factor" "hide:" "h" }
+            { "Hide Others" "hideOtherApplications:" "h" [ and-option-equivalent-modifier ] }
+            { "Show All" "unhideAllApplications:" "" }
+            { }
+            { "Save Image" [ save ] "s" }
+            { }
+            { "Quit" "terminate:" "q" }
+        } [ dup NSApp swap [setAppleMenu:] ] }
+        { {
+            ! Tools is standing in for the File menu
+            "Tools"
+            { "Listener" [ listener-window ] "n" }
+            { "Vocabulary List" [ [ vocabs. ] "Vocabularies" pane-window ] "y" }
+            { "Globals" [ global browser-window ] "u" }
+            { "Memory" [ [ heap-stats. terpri room. ] "Memory" pane-window ] "u" }
+        } }
+        { {
+            "Edit"
+            { "Undo" "undo:" "z" }
+            { "Redo" "redo:" "Z" }
+            { }
+            { "Cut" "cut:" "x" }
+            { "Copy" "copy:" "c" }
+            { "Paste" "paste:" "v" }
+            { "Paste and Match Style" "pasteAsPlainText:" "V" [ and-option-equivalent-modifier ] }
+            { "Delete" "delete:" "" }
+            { "Select All" "selectAll:" "a" }
+            ! { }
+            ! Find, Spelling, and Speech submenus go here
+        } }
+        { {
+            "Window"
+            { "Close" "performClose:" "w" }
+            { "Zoom" "performZoom:" "" }
+            { "Minimize" "performMiniaturize:" "m" }
+            { "Minimize All" "miniaturizeAll:" "m"  [ and-alternate and-option-equivalent-modifier ] }
+            { }
+            { "Bring All to Front" "arrangeInFront:" "" }
+        } [ dup NSApp swap [setWindowsMenu:] ] }
+        { {
+            "Help"
+            { "Factor Documentation" [ handbook-window ] "?" }
+            { "Help Index" [ [ articles. ] "Help index" pane-window ] "" }
+            { "Vocabularies" [ [ vocabs. ] "Vocabularies" pane-window ] "" }
+        } }
+    } described-menu set-main-menu ;

library/cocoa/ui.factor

@@ -226,7 +226,7 @@ IN: shells
         [
             init-ui
             purge-views
-            launchpad-window
+            default-main-menu
             listener-window
             finish-launching
             event-loop