144 lines
4.2 KiB
Factor
144 lines
4.2 KiB
Factor
! Copyright (C) 2005, 2006 Kevin Reid.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: cocoa compiler gadgets gadgets-workspace gadgets-help
|
|
gadgets-listener kernel memory objc objc-classes sequences
|
|
strings words io help ;
|
|
IN: cocoa
|
|
|
|
! -------------------------------------------------------------------------
|
|
|
|
GENERIC: to-target-and-action ( spec -- target action )
|
|
|
|
M: f to-target-and-action f swap ;
|
|
M: string to-target-and-action f ;
|
|
M: word to-target-and-action unit to-target-and-action ;
|
|
M: quotation to-target-and-action
|
|
<FactorCallback> "perform:" swap ;
|
|
|
|
: <NSMenu> ( title -- menu )
|
|
NSMenu -> alloc
|
|
swap <NSString> -> initWithTitle:
|
|
-> autorelease ;
|
|
|
|
: set-main-menu ( 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 ( title spec -- item )
|
|
to-target-and-action >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 swap make-menu-item ] 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 tail [ and-described-item ] each ;
|
|
|
|
: and-described-submenu ( menu { title items* } -- menu )
|
|
described-menu dupd add-submenu ;
|
|
|
|
! -------------------------------------------------------------------------
|
|
|
|
: menu-run-file ( -- )
|
|
open-panel [ listener-run-files ] when* ;
|
|
|
|
: default-main-menu
|
|
{
|
|
"<top>"
|
|
{ {
|
|
"Factor"
|
|
! About goes here
|
|
! Preferences goes here
|
|
{ {
|
|
"Services"
|
|
} [ NSApp over -> setServicesMenu: ] }
|
|
{ }
|
|
{ "Hide Factor" "hide:" "h" }
|
|
{ "Hide Others" "hideOtherApplications:" "h" [ and-option-equivalent-modifier ] }
|
|
{ "Show All" "unhideAllApplications:" "" }
|
|
{ }
|
|
{ "Quit" "terminate:" "q" }
|
|
} [ NSApp over -> setAppleMenu: ] }
|
|
{ {
|
|
"File"
|
|
{ "New Workspace" [ workspace-window drop ] "n" }
|
|
{ "Run..." menu-run-file "o" }
|
|
{ }
|
|
{ "Save Image" save "s" }
|
|
} }
|
|
{ {
|
|
"Edit"
|
|
{ "Undo" "undo:" "z" }
|
|
{ "Redo" "redo:" "Z" }
|
|
{ }
|
|
{ "Cut" "cut:" "x" }
|
|
{ "Copy" "copy:" "c" }
|
|
{ "Paste" "paste:" "v" }
|
|
{ "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:" "" }
|
|
} [ NSApp over -> setWindowsMenu: ] }
|
|
{ {
|
|
"Help"
|
|
{ "Factor Documentation" [ "handbook" <link> help-gadget call-tool ] "?" }
|
|
} }
|
|
} described-menu set-main-menu ;
|