diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 4995fde21b..3297465d15 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -4,12 +4,10 @@ space - workspace: - tool help - - maybe open-window should take a world - - book: request focus on selected gadget - - each workspace page has a toolbar - selecting walker when no quotation is being walked throws an error - replacement for call-tool functionality - status bar showing number of words needing a recompile + - default size is wrong - new browser: - show currently selected vocab & words - scroll to existing won't work diff --git a/library/ui/cocoa/menu-bar.factor b/library/ui/cocoa/menu-bar.factor index c48234bf82..43fc706969 100644 --- a/library/ui/cocoa/menu-bar.factor +++ b/library/ui/cocoa/menu-bar.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2005, 2006 Kevin Reid. ! See http://factorcode.org/license.txt for BSD license. -USING: cocoa compiler gadgets gadgets-browser gadgets-help -gadgets-listener gadgets-search kernel memory objc objc-classes -sequences strings words io ; +USING: cocoa compiler gadgets gadgets-workspace gadgets-help +gadgets-listener kernel memory objc objc-classes sequences +strings words io help ; IN: cocoa ! ------------------------------------------------------------------------- @@ -91,9 +91,6 @@ DEFER: described-menu : menu-run-file ( -- ) open-panel [ listener-run-files ] when* ; -: memory-window ( -- ) - [ heap-stats. terpri room. ] "Memory" pane-window ; - : default-main-menu { "" @@ -113,15 +110,9 @@ DEFER: described-menu } [ NSApp over -> setAppleMenu: ] } { { "File" - { "New Listener" listener-window "n" } - { "New Browser" browser-window "b" } - { "Apropos" apropos-window "r" } - { } + { "New Workspace" workspace-window "n" } { "Run..." menu-run-file "o" } { } - { "Globals" globals-window "" } - { "Memory" memory-window "" } - { } { "Save Image" save "s" } } } { { @@ -147,7 +138,6 @@ DEFER: described-menu } [ NSApp over -> setWindowsMenu: ] } { { "Help" - { "Factor Documentation" handbook-window "?" } - { "Search" search-help-window "" } + { "Factor Documentation" [ "handbook" help-tool call-tool ] "?" } } } } described-menu set-main-menu ; diff --git a/library/ui/cocoa/ui.factor b/library/ui/cocoa/ui.factor index 8fd5366fea..6796b152c2 100644 --- a/library/ui/cocoa/ui.factor +++ b/library/ui/cocoa/ui.factor @@ -4,8 +4,8 @@ IN: objc-classes DEFER: FactorApplicationDelegate IN: cocoa -USING: arrays gadgets gadgets-listener hashtables kernel memory -namespaces objc sequences errors freetype ; +USING: arrays gadgets gadgets-listener gadgets-workspace +hashtables kernel memory namespaces objc sequences errors freetype ; : finder-run-files ( alien -- ) #! We filter out the image name since that might be there on @@ -76,7 +76,7 @@ IN: shells restore-windows ] [ init-ui - listener-window + workspace-window ] if finish-launching event-loop diff --git a/library/ui/gadgets/books.factor b/library/ui/gadgets/books.factor index 65d299b31b..d08b6ab56d 100644 --- a/library/ui/gadgets/books.factor +++ b/library/ui/gadgets/books.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. IN: gadgets-books USING: gadgets gadgets-controls gadgets-panes gadgets-scrolling -kernel sequences ; +kernel sequences models ; TUPLE: book page pages ; @@ -10,21 +10,25 @@ TUPLE: book page pages ; #! page gadgets are instantiated lazily. book-pages [ dup quotation? [ call ] when dup ] change-nth ; -: show-page ( n book -- ) - dup book-page unparent +M: book model-changed ( book -- ) + [ control-model model-value ] keep + [ book-page unparent ] keep [ get-page ] keep [ set-book-page ] 2keep - add-gadget ; + [ add-gadget ] keep + dup request-focus ; C: book ( pages -- book ) - dup delegate>gadget + dup 0 delegate>control + dup dup set-control-self [ set-book-pages ] keep - 0 over show-page ; - -: ( model pages -- book ) - [ show-page ] ; + dup model-changed ; M: book pref-dim* book-page pref-dim ; M: book layout* dup rect-dim swap book-page set-layout-dim ; + +M: book gadget-title book-page gadget-title ; + +M: book focusable-child* gadget-child ; diff --git a/library/ui/gadgets/grids.factor b/library/ui/gadgets/grids.factor index 04d508d09f..5368c9f122 100644 --- a/library/ui/gadgets/grids.factor +++ b/library/ui/gadgets/grids.factor @@ -23,9 +23,11 @@ C: grid ( children -- grid ) : grid-remove ( grid i j -- ) >r >r >r f r> r> r> grid-add ; +: ?pref-dim ( gadget/f -- dim ) + [ pref-dim ] [ { 0 0 } ] if* ; + : pref-dim-grid ( -- dims ) - grid get grid-children - [ [ [ pref-dim ] [ { 0 0 } ] if* ] map ] map ; + grid get grid-children [ [ ?pref-dim ] map ] map ; : compute-grid ( -- horiz vert ) pref-dim-grid diff --git a/library/ui/gestures.factor b/library/ui/gestures.factor index b87cb13e3d..ac662a416b 100644 --- a/library/ui/gestures.factor +++ b/library/ui/gestures.factor @@ -128,7 +128,8 @@ V{ } clone hand-buttons set-global focus-receiver r> focus-gestures ; : request-focus ( gadget -- ) - dup focusable-child swap find-world request-focus* ; + dup focusable-child swap find-world + [ request-focus* ] [ drop ] if* ; : modifier ( mod modifiers -- seq ) [ second swap bitand 0 > ] subset-with diff --git a/library/ui/tools/browser.factor b/library/ui/tools/browser.factor index 8b5083c360..df5354077c 100644 --- a/library/ui/tools/browser.factor +++ b/library/ui/tools/browser.factor @@ -73,8 +73,6 @@ C: browser ( -- gadget ) M: browser gadget-title drop "Browser" ; -: browser-window ( -- ) open-window ; - : show-word ( word browser -- ) over word-vocabulary over show-vocab browser-definitions show-definition ; diff --git a/library/ui/tools/help.factor b/library/ui/tools/help.factor index d8dd33c5a7..b98d69bfe9 100644 --- a/library/ui/tools/help.factor +++ b/library/ui/tools/help.factor @@ -25,7 +25,6 @@ help-gadget { C: help-gadget ( -- gadget ) T{ link f "handbook" } over set-help-gadget-history { - { [ gadget get ] f f @top } { [ ] f f @center } } make-frame* ; @@ -33,11 +32,6 @@ M: help-gadget gadget-title help-gadget-history [ "Help - " swap article-title append ] ; -M: help-gadget pref-dim* drop { 500 600 } ; - : help-tool [ help-gadget? ] [ ] [ show-help ] ; -: handbook-window ( -- ) - T{ link f "handbook" } help-tool call-tool ; - link 1 "Browse" [ help-tool call-tool ] define-operation diff --git a/library/ui/tools/listener.factor b/library/ui/tools/listener.factor index ec871c20b5..b65bf4b13e 100644 --- a/library/ui/tools/listener.factor +++ b/library/ui/tools/listener.factor @@ -6,7 +6,7 @@ gadgets-panes gadgets-scrolling gadgets-text gadgets-theme gadgets-tiles gadgets-tracks generic hashtables inspector io kernel listener math models namespaces parser prettyprint sequences shells styles threads -words ; +words memory ; TUPLE: listener-gadget input output stack ; @@ -48,16 +48,11 @@ C: listener-gadget ( -- gadget ) { [ ] set-listener-gadget-input [ ] 1/6 } } { 0 1 } make-track* dup start-listener ; -M: listener-gadget pref-dim* - delegate pref-dim* { 500 600 } vmax ; - M: listener-gadget focusable-child* listener-gadget-input ; M: listener-gadget gadget-title drop "Listener" ; -: listener-window ( -- ) open-window ; - : call-listener ( quot/string listener -- ) listener-gadget-input over quotation? [ interactor-call ] [ set-editor-text ] if ; @@ -81,11 +76,10 @@ M: listener-gadget gadget-title drop "Listener" ; [ [ run-file ] each ] curry listener-tool call-tool ] if ; -: globals-window ( -- ) - [ global inspect ] listener-tool call-tool ; - listener-gadget { { f "Clear" T{ key-down f f "CLEAR" } [ dup [ listener-gadget-output pane-clear ] curry listener-tool call-tool ] } + { f "Globals" f [ [ global inspect ] listener-tool call-tool ] } + { f "Memory" f [ [ heap-stats. room. ] listener-tool call-tool ] } } define-commands object 1 "Inspect" [ [ inspect ] curry listener-tool call-tool ] define-operation diff --git a/library/ui/tools/walker.factor b/library/ui/tools/walker.factor index 65fd5b60d3..93b05d3fe8 100644 --- a/library/ui/tools/walker.factor +++ b/library/ui/tools/walker.factor @@ -33,16 +33,6 @@ namespaces sequences shells threads vectors ; : ( quot -- gadget ) [ [ first2 callframe. ] when* ] ; -: ( model quot -- gadget ) - { - { [ ] f f 1/6 } - { [ dup ] f f 1/6 } - { [ dup ] f f 1/6 } - { [ dup ] f f 1/6 } - { [ dup ] f f 1/6 } - { [ ] f f 1/6 } - } { 0 1 } make-track ; - TUPLE: walker-gadget model quot ns ; : update-stacks ( walker -- ) @@ -67,20 +57,13 @@ walker-gadget { { f "Continue" T{ key-down f f "c" } [ walker-step-all ] } } define-commands -: init-walker-models ( walker -- ) - f over set-walker-gadget-model - f swap set-walker-gadget-quot ; - -: walker-models ( -- model quot ) - gadget get walker-gadget-model - gadget get walker-gadget-quot ; +: init-walker-models ( walker -- model quot ) + f over set-walker-gadget-quot + f swap set-walker-gadget-model ; M: walker-gadget gadget-title drop "Single stepper" ; -M: walker-gadget pref-dim* - delegate pref-dim { 500 600 } vmax ; - : (walk) ( quot continuation walker -- ) H{ } clone over set-walker-gadget-ns [ V{ } clone meta-history set @@ -88,12 +71,19 @@ M: walker-gadget pref-dim* (meta-call) ] with-walker ; +: walker-gadget-quot$ gadget get walker-gadget-quot ; +: walker-gadget-model$ gadget get walker-gadget-model ; + C: walker-gadget ( -- gadget ) dup init-walker-models { - { [ gadget get ] f f @top } - { [ walker-models ] f f @center } - } make-frame* ; + { [ walker-gadget-quot$ ] f f 1/6 } + { [ walker-gadget-model$ ] f f 1/6 } + { [ walker-gadget-model$ ] f f 1/6 } + { [ walker-gadget-model$ ] f f 1/6 } + { [ walker-gadget-model$ ] f f 1/6 } + { [ walker-gadget-model$ ] f f 1/6 } + } { 0 1 } make-track* ; : walk ( quot -- ) continuation dup continuation-data pop* - [ (walk) ] keep open-window stop ; + [ (walk) ] keep open-window stop ; diff --git a/library/ui/tools/workspace.factor b/library/ui/tools/workspace.factor index 3cd1537b10..25c33f809a 100644 --- a/library/ui/tools/workspace.factor +++ b/library/ui/tools/workspace.factor @@ -3,8 +3,20 @@ IN: gadgets-workspace USING: arrays gadgets gadgets-listener gadgets-buttons gadgets-walker gadgets-help gadgets-walker sequences -gadgets-browser gadgets-books gadgets-frames kernel models -namespaces ; +gadgets-browser gadgets-books gadgets-frames gadgets-controls +gadgets-grids gadgets-presentations kernel models namespaces ; + +TUPLE: tool ; + +C: tool ( gadget -- tool ) + { + { [ dup ] f f @top } + { [ ] f f @center } + } make-frame* ; + +M: tool gadget-title gadget-child gadget-title ; + +M: tool focusable-child* gadget-child ; TUPLE: workspace model ; @@ -16,17 +28,22 @@ TUPLE: workspace model ; { "Documentation" help-gadget [ ] } } ; -: ( workspace -- book ) - workspace-model - workspace-tabs [ third ] map ; +: ( -- book ) + workspace-tabs [ third [ ] append ] map ; -: ( workspace -- tabs ) - workspace-model +: ( book -- tabs ) + control-model workspace-tabs dup length [ swap first 2array ] 2map ; -C: workspace - 0 over set-workspace-model { - { [ gadget get ] f f @top } - { [ gadget get ] f f @center } - } make-frame* ; +: init-status ( world -- ) + dup world-status swap @bottom grid-add ; + +: init-tabs ( workspace world -- ) + swap swap @top grid-add ; + +: workspace-window ( -- ) + dup + [ init-status ] keep + [ init-tabs ] keep + open-window ; diff --git a/library/ui/ui.factor b/library/ui/ui.factor index db9358f509..f9ac70cf69 100644 --- a/library/ui/ui.factor +++ b/library/ui/ui.factor @@ -69,24 +69,19 @@ C: titled-gadget ( gadget title -- ) [ set-titled-gadget-title ] keep { { f f f @center } } make-frame* ; -: init-status ( world -- ) - dup world-status swap @bottom grid-add ; - -: open-window ( gadget -- ) - dup init-status +: open-window ( world -- ) dup pref-dim over set-gadget-dim - dup open-window* - draw-world ; + dup open-window* draw-world ; : open-titled-window ( gadget title -- ) - open-window ; + open-window ; : find-window ( quot -- world ) windows get [ second ] map [ world-gadget swap call ] find-last-with nip ; inline : open-tool ( arg cons setter -- ) - >r call dup open-window r> call ; inline + >r call dup open-window r> call ; inline : call-tool ( arg pred cons setter -- ) rot find-window [ diff --git a/library/ui/windows/ui.factor b/library/ui/windows/ui.factor index 3f6836b867..8c29505566 100644 --- a/library/ui/windows/ui.factor +++ b/library/ui/windows/ui.factor @@ -328,7 +328,7 @@ IN: shells restore-windows ] [ init-ui - listener-window + workspace-window ] if event-loop ] with-freetype diff --git a/library/ui/x11/ui.factor b/library/ui/x11/ui.factor index 9268ac638b..d692ee8132 100644 --- a/library/ui/x11/ui.factor +++ b/library/ui/x11/ui.factor @@ -184,7 +184,7 @@ IN: shells restore-windows ] [ init-ui - listener-window + workspace-window ] if event-loop ] with-x