diff --git a/basis/ui/gadgets/slots/slots.factor b/basis/ui/gadgets/slots/slots.factor index 1cf23e2d06..ff2220b60e 100644 --- a/basis/ui/gadgets/slots/slots.factor +++ b/basis/ui/gadgets/slots/slots.factor @@ -71,7 +71,7 @@ M: value-ref finish-editing : ( ref -- gadget ) { 0 1 } slot-editor new-track swap >>ref - dup f track-add + add-toolbar >>text dup text>> 1 track-add dup revert ; diff --git a/basis/ui/tools/debugger/debugger.factor b/basis/ui/tools/debugger/debugger.factor index 1f019fca7c..641763c0b1 100644 --- a/basis/ui/tools/debugger/debugger.factor +++ b/basis/ui/tools/debugger/debugger.factor @@ -25,7 +25,7 @@ TUPLE: debugger < track restarts ; : ( error restarts restart-hook -- gadget ) { 0 1 } debugger new-track - dup f track-add + add-toolbar -rot >>restarts dup restarts>> rot 1 track-add ; diff --git a/basis/ui/tools/inspector/inspector.factor b/basis/ui/tools/inspector/inspector.factor index dcb3a3f8ad..579210325b 100644 --- a/basis/ui/tools/inspector/inspector.factor +++ b/basis/ui/tools/inspector/inspector.factor @@ -17,7 +17,7 @@ TUPLE: inspector-gadget < track object pane ; : ( -- gadget ) { 0 1 } inspector-gadget new-track - dup f track-add + add-toolbar >>pane dup pane>> 1 track-add ; diff --git a/basis/ui/tools/profiler/profiler.factor b/basis/ui/tools/profiler/profiler.factor index c60d0dac09..05d1ccdb82 100644 --- a/basis/ui/tools/profiler/profiler.factor +++ b/basis/ui/tools/profiler/profiler.factor @@ -9,7 +9,7 @@ TUPLE: profiler-gadget < track pane ; : ( -- gadget ) { 0 1 } profiler-gadget new-track - dup f track-add + add-toolbar >>pane dup pane>> 1 track-add ; diff --git a/basis/ui/tools/search/search.factor b/basis/ui/tools/search/search.factor index 3081eb1cdc..033aacc1b3 100644 --- a/basis/ui/tools/search/search.factor +++ b/basis/ui/tools/search/search.factor @@ -1,14 +1,14 @@ ! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs ui.tools.interactor ui.tools.listener -ui.tools.workspace help help.topics io.files io.styles kernel -models models.delay models.filter namespaces prettyprint +USING: accessors assocs help help.topics io.files io.styles +kernel models models.delay models.filter namespaces prettyprint quotations sequences sorting source-files definitions strings -tools.completion tools.crossref classes.tuple ui.commands -ui.gadgets ui.gadgets.editors ui.gadgets.lists -ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.operations -vocabs words vocabs.loader tools.vocabs unicode.case calendar ui -; +tools.completion tools.crossref classes.tuple vocabs words +vocabs.loader tools.vocabs unicode.case calendar locals +ui.tools.interactor ui.tools.listener ui.tools.workspace +ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.lists +ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.borders +ui.gestures ui.operations ui ; IN: ui.tools.search TUPLE: live-search < track field list ; @@ -23,7 +23,7 @@ TUPLE: live-search < track field list ; M: live-search handle-gesture ( gesture live-search -- ? ) tuck search-gesture dup [ over find-workspace hide-popup - >r search-value r> invoke-command f + [ search-value ] dip invoke-command f ] [ 2drop t ] if ; @@ -47,27 +47,29 @@ search-field H{ { T{ key-down f f "RET" } [ find-search-list invoke-value-action ] } } set-gestures -: ( live-search producer -- live-search filter ) - >r dup field>> model>> - ui-running? [ 1/5 seconds ] when - [ "\n" join ] r> append ; +: ( live-search producer -- filter ) + [ + field>> model>> + ui-running? [ 1/5 seconds ] when + ] dip [ "\n" join ] prepend ; -: ( live-search seq limited? presenter -- live-search list ) - >r - [ limited-completions ] [ completions ] ? curry - - >r [ find-workspace hide-popup ] r> r> - swap ; +: init-search-model ( live-search seq limited? -- live-search ) + [ 2drop ] + [ [ limited-completions ] [ completions ] ? curry ] 3bi + >>model ; inline -: ( string seq limited? presenter -- gadget ) +: ( presenter live-search -- list ) + [ [ find-workspace hide-popup ] ] [ ] [ model>> ] tri* ; + +:: ( string seq limited? presenter -- gadget ) { 0 1 } live-search new-track >>field - dup field>> f track-add - -roll >>list + seq limited? init-search-model + presenter over >>list + dup field>> 1 { 0 0 } >>align f track-add dup list>> 1 track-add - swap - over field>> set-editor-string - dup field>> end-of-document ; + string over field>> set-editor-string + dup field>> end-of-document ; M: live-search focusable-child* field>> ; @@ -80,26 +82,27 @@ M: live-search pref-dim* drop { 400 200 } ; [ dup synopsis >lower ] { } map>assoc sort-values ; : ( string words limited? -- gadget ) - >r definition-candidates r> [ synopsis ] ; + [ definition-candidates ] dip [ synopsis ] ; : word-candidates ( words -- candidates ) [ dup name>> >lower ] { } map>assoc ; : ( string words limited? -- gadget ) - >r word-candidates r> [ synopsis ] ; + [ word-candidates ] dip [ synopsis ] ; : com-words ( workspace -- ) dup current-word all-words t "Word search" show-titled-popup ; : show-vocab-words ( workspace vocab -- ) - "" over words natural-sort f - "Words in " rot vocab-name append show-titled-popup ; + [ "" swap words natural-sort f ] + [ "Words in " swap vocab-name append ] + bi show-titled-popup ; : show-word-usage ( workspace word -- ) - "" over smart-usage f - "Words and methods using " rot name>> append - show-titled-popup ; + [ "" swap smart-usage f ] + [ "Words and methods using " swap name>> append ] + bi show-titled-popup ; : help-candidates ( seq -- candidates ) [ dup >link swap article-title >lower ] { } map>assoc @@ -127,8 +130,9 @@ M: live-search pref-dim* drop { 400 200 } ; "Source file search" show-titled-popup ; : show-vocab-files ( workspace vocab -- ) - "" over vocab-files - "Source files in " rot vocab-name append show-titled-popup ; + [ "" swap vocab-files ] + [ "Source files in " swap vocab-name append ] + bi show-titled-popup ; : vocab-candidates ( -- candidates ) all-vocabs-seq [ dup vocab-name >lower ] { } map>assoc ; diff --git a/basis/ui/tools/traceback/traceback.factor b/basis/ui/tools/traceback/traceback.factor index 7e2158e0e9..45f15b1ffc 100644 --- a/basis/ui/tools/traceback/traceback.factor +++ b/basis/ui/tools/traceback/traceback.factor @@ -36,7 +36,7 @@ M: traceback-gadget pref-dim* drop { 550 600 } ; dup model>> 2/3 track-add - dup f track-add ; + add-toolbar ; : ( model -- gadget ) [ [ name>> namestack. ] when* ] diff --git a/basis/ui/tools/walker/walker.factor b/basis/ui/tools/walker/walker.factor index 7bc42ea676..9c825d4920 100644 --- a/basis/ui/tools/walker/walker.factor +++ b/basis/ui/tools/walker/walker.factor @@ -62,9 +62,9 @@ M: walker-gadget focusable-child* swap >>status dup continuation>> >>traceback - dup f track-add + add-toolbar dup status>> self f track-add - dup traceback>> 1 track-add ; + dup traceback>> 1 track-add ; : walker-help ( -- ) "ui-walker" help-window ; diff --git a/basis/ui/tools/workspace/workspace.factor b/basis/ui/tools/workspace/workspace.factor index f06e0aae26..6536cb8c7d 100644 --- a/basis/ui/tools/workspace/workspace.factor +++ b/basis/ui/tools/workspace/workspace.factor @@ -1,12 +1,12 @@ -! Copyright (C) 2006, 2007 Slava Pestov. +! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: classes continuations help help.topics kernel models - sequences ui ui.backend ui.tools.debugger ui.gadgets - ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled - ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.tracks - ui.gadgets.worlds ui.gadgets.presentations ui.gadgets.status-bar - ui.commands ui.gestures assocs arrays namespaces accessors ; - +sequences assocs arrays namespaces accessors math.vectors ui +ui.backend ui.tools.debugger ui.gadgets ui.gadgets.books +ui.gadgets.buttons ui.gadgets.labelled ui.gadgets.panes +ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.worlds +ui.gadgets.presentations ui.gadgets.status-bar ui.commands +ui.gestures ; IN: ui.tools.workspace TUPLE: workspace < track book listener popup ; @@ -32,8 +32,6 @@ M: gadget tool-scroller drop f ; [ find-tool swap ] keep book>> model>> set-model ; -: select-tool ( workspace class -- ) swap show-tool drop ; - : get-workspace* ( quot -- workspace ) [ >r dup workspace? r> [ drop f ] if ] curry find-window [ dup raise-window gadget-child ] @@ -81,7 +79,7 @@ SYMBOL: workspace-dim { 600 700 } workspace-dim set-global -M: workspace pref-dim* drop workspace-dim get ; +M: workspace pref-dim* call-next-method workspace-dim get vmax ; M: workspace focusable-child* dup popup>> [ ] [ listener>> ] ?if ;