Working on a Cocoa 'Run...' dialog

library/cocoa/core-foundation.factor

@@ -6,6 +6,13 @@ namespaces sequences ;
 
 TYPEDEF: int CFIndex
 
+FUNCTION: void* CFArrayGetValueAtIndex ( void* array, CFIndex idx ) ;
+
+FUNCTION: CFIndex CFArrayGetCount ( void* array ) ;
+
+: CF>array ( alien -- array )
+    dup CFArrayGetCount [ CFArrayGetValueAtIndex ] map-with ;
+
 ! Core Foundation utilities -- will be moved elsewhere
 : kCFURLPOSIXPathStyle 0 ;
 

library/cocoa/dialogs.factor

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

library/cocoa/init-cocoa.factor

@@ -19,6 +19,8 @@ USING: cocoa compiler io kernel objc sequences words ;
     "NSObject"
     "NSOpenGLContext"
     "NSOpenGLView"
+    "NSOpenPanel"
+    "NSSavePanel"
     "NSView"
     "NSWindow"
 } [

library/cocoa/load.factor

@@ -11,6 +11,7 @@ USING: compiler io parser sequences words ;
     "/library/cocoa/application-utils.factor"
     "/library/cocoa/window-utils.factor"
     "/library/cocoa/view-utils.factor"
+    "/library/cocoa/dialogs.factor"
     "/library/cocoa/menu-bar.factor"
     "/library/cocoa/ui.factor"
 } [

library/cocoa/menu-bar.factor

@@ -82,6 +82,8 @@ DEFER: described-menu
 
 ! -------------------------------------------------------------------------
 
+: menu-run-file ( -- )
+    open-panel [ listener-run-files ] when* ;
 
 : default-main-menu 
     {
@@ -98,18 +100,19 @@ DEFER: described-menu
             { "Hide Others" "hideOtherApplications:" "h" [ and-option-equivalent-modifier ] }
             { "Show All" "unhideAllApplications:" "" }
             { }
-            { "Save Image" save "s" }
-            { }
             { "Quit" "terminate:" "q" }
         } [ NSApp over [setAppleMenu:] ] }
         { {
-            ! Tools is standing in for the File menu
+            "File"
-            "Tools"
             { "Listener" listener-window "n" }
+            { "Run..." menu-run-file "o" }
+            { }
             { "Apropos" apropos-window "r" }
-            { "Vocabularies" vocabs-window "y" }
+            { "Vocabularies" vocabs-window "" }
-            { "Globals" global-window "u" }
+            { "Globals" global-window "" }
-            { "Memory" memory-window "m" }
+            { "Memory" memory-window "" }
+            { }
+            { "Save Image" save "s" }
         } }
         { {
             "Edit"

library/tools/describe.factor

@@ -120,7 +120,7 @@ DEFER: describe
     ] with-scope ;
 
 : callstack. ( seq -- seq )
-    3 swap group [ first2 callframe. ] each ;
+    3 swap group <reversed> [ first2 callframe. ] each ;
 
 : .c callstack callstack. ;
 

library/ui/listener.factor

@@ -47,7 +47,7 @@ TUPLE: listener-gadget pane stack ;
 : <stack-bar> ( -- gadget ) <shelf> dup highlight-theme ;
 
 : start-listener ( listener -- )
-    [ >r clear r> listener-thread ] in-thread ;
+    [ >r clear r> listener-thread ] in-thread drop ;
 
 C: listener-gadget ( -- gadget )
     dup delegate>frame
@@ -64,3 +64,10 @@ M: listener-gadget focusable-child* ( listener -- gadget )
 
 : listener-window ( -- )
     <listener-gadget> "Listener" open-window ;
+
+: listener-window* ( quot -- )
+    <listener-gadget> [ listener-gadget-pane pane-call ] keep
+    "Listener" open-window ;
+
+: listener-run-files ( seq -- )
+    [ [ run-file ] each ] curry listener-window* ;

library/ui/panes.factor

@@ -4,7 +4,7 @@ IN: gadgets-panes
 USING: arrays gadgets gadgets-buttons gadgets-editors
 gadgets-labels gadgets-layouts gadgets-scrolling gadgets-theme
 generic hashtables io kernel line-editor math namespaces
-sequences strings styles threads ;
+prettyprint sequences strings styles threads ;
 
 ! A pane is an area that can display text.
 
@@ -38,7 +38,7 @@ continuation scrolls? ;
 SYMBOL: structured-input
 
 : pane-call ( quot pane -- )
-    "<< command >>" over stream-print
+    dup [ "Command: " write over . ] with-stream*
     >r structured-input set-global
     "\"structured-input\" \"gadgets-panes\" lookup get-global call"
     r> pane-eval ;