diff --git a/library/cocoa/callback.factor b/library/cocoa/callback.factor new file mode 100644 index 0000000000..0343f3e967 --- /dev/null +++ b/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 + +: ( quot -- id | quot: id -- ) + FactorCallback [alloc] [init] + [ callbacks get set-hash ] keep ; \ No newline at end of file diff --git a/library/cocoa/load.factor b/library/cocoa/load.factor index 5896c419a4..b97e0434c7 100644 --- a/library/cocoa/load.factor +++ b/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 diff --git a/library/cocoa/menu-bar.factor b/library/cocoa/menu-bar.factor new file mode 100644 index 0000000000..0f18221105 --- /dev/null +++ b/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 "perform:" sel_registerName ; + + +: NSMenu [alloc] swap [initWithTitle:] [autorelease] ; + +: set-main-menu NSApp swap [setMainMenu:] ; + +: ( title action equivalent -- item ) + >r >r >r + NSMenuItem [alloc] + r> + r> dup [ sel_registerName ] when + r> + [initWithTitle:action:keyEquivalent:] [autorelease] ; + +: make-menu-item-2 ( title selector-string-or-quotation equivalent -- item ) + swap to-target-and-action swap >r swap dup r> [setTarget:] ; + +: submenu-to-item ( menu -- item ) + dup [title] CF>string f "" 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 ] keep + 1 swap tail [ and-described-item ] each ; + +: and-described-submenu ( menu { title items* } -- menu ) + described-menu dupd add-submenu ; + +! ------------------------------------------------------------------------- + + +: default-main-menu + { + "" + { { + "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 ; diff --git a/library/cocoa/ui.factor b/library/cocoa/ui.factor index ac4d56245b..e098ed011e 100644 --- a/library/cocoa/ui.factor +++ b/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