steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Use add-toolbar word in a few places

db4
Slava Pestov 2008-11-20 21:58:30 -06:00
parent 2eac58c271
commit f27ebdd1ef
8 changed files with 53 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/ui/gadgets/slots/slots.factor
View File

@ -71,7 +71,7 @@ M: value-ref finish-editing
: <slot-editor> ( ref -- gadget ) : <slot-editor> ( ref -- gadget )
{ 0 1 } slot-editor new-track { 0 1 } slot-editor new-track
swap >>ref swap >>ref
dup <toolbar> f track-add add-toolbar
<source-editor> >>text <source-editor> >>text
dup text>> <scroller> 1 track-add dup text>> <scroller> 1 track-add
dup revert ; dup revert ;

2
basis/ui/tools/debugger/debugger.factor
View File

@ -25,7 +25,7 @@ TUPLE: debugger < track restarts ;
: <debugger> ( error restarts restart-hook -- gadget ) : <debugger> ( error restarts restart-hook -- gadget )
{ 0 1 } debugger new-track { 0 1 } debugger new-track
dup <toolbar> f track-add add-toolbar
-rot <restart-list> >>restarts -rot <restart-list> >>restarts
dup restarts>> rot <debugger-display> <scroller> 1 track-add ; dup restarts>> rot <debugger-display> <scroller> 1 track-add ;

2
basis/ui/tools/inspector/inspector.factor
View File

@ -17,7 +17,7 @@ TUPLE: inspector-gadget < track object pane ;
: <inspector-gadget> ( -- gadget ) : <inspector-gadget> ( -- gadget )
{ 0 1 } inspector-gadget new-track { 0 1 } inspector-gadget new-track
dup <toolbar> f track-add add-toolbar
<pane> >>pane <pane> >>pane
dup pane>> <scroller> 1 track-add ; dup pane>> <scroller> 1 track-add ;

2
basis/ui/tools/profiler/profiler.factor
View File

@ -9,7 +9,7 @@ TUPLE: profiler-gadget < track pane ;
: <profiler-gadget> ( -- gadget ) : <profiler-gadget> ( -- gadget )
{ 0 1 } profiler-gadget new-track { 0 1 } profiler-gadget new-track
dup <toolbar> f track-add add-toolbar
<pane> >>pane <pane> >>pane
dup pane>> <scroller> 1 track-add ; dup pane>> <scroller> 1 track-add ;

68
basis/ui/tools/search/search.factor
View File

@ -1,14 +1,14 @@
! Copyright (C) 2006, 2008 Slava Pestov. ! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs ui.tools.interactor ui.tools.listener USING: accessors assocs help help.topics io.files io.styles
ui.tools.workspace help help.topics io.files io.styles kernel kernel models models.delay models.filter namespaces prettyprint
models models.delay models.filter namespaces prettyprint
quotations sequences sorting source-files definitions strings quotations sequences sorting source-files definitions strings
tools.completion tools.crossref classes.tuple ui.commands tools.completion tools.crossref classes.tuple vocabs words
ui.gadgets ui.gadgets.editors ui.gadgets.lists vocabs.loader tools.vocabs unicode.case calendar locals
ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.operations ui.tools.interactor ui.tools.listener ui.tools.workspace
vocabs words vocabs.loader tools.vocabs unicode.case calendar ui 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 IN: ui.tools.search
TUPLE: live-search < track field list ; TUPLE: live-search < track field list ;
@ -23,7 +23,7 @@ TUPLE: live-search < track field list ;
M: live-search handle-gesture ( gesture live-search -- ? ) M: live-search handle-gesture ( gesture live-search -- ? )
tuck search-gesture dup [ tuck search-gesture dup [
over find-workspace hide-popup over find-workspace hide-popup
>r search-value r> invoke-command f [ search-value ] dip invoke-command f
] [ ] [
2drop t 2drop t
] if ; ] if ;
@ -47,26 +47,28 @@ search-field H{
{ T{ key-down f f "RET" } [ find-search-list invoke-value-action ] } { T{ key-down f f "RET" } [ find-search-list invoke-value-action ] }
} set-gestures } set-gestures
: <search-model> ( live-search producer -- live-search filter ) : <search-model> ( live-search producer -- filter )
>r dup field>> model>> [
field>> model>>
ui-running? [ 1/5 seconds <delay> ] when ui-running? [ 1/5 seconds <delay> ] when
[ "\n" join ] r> append <filter> ; ] dip [ "\n" join ] prepend <filter> ;
: <search-list> ( live-search seq limited? presenter -- live-search list ) : init-search-model ( live-search seq limited? -- live-search )
>r [ 2drop ]
[ limited-completions ] [ completions ] ? curry [ [ limited-completions ] [ completions ] ? curry <search-model> ] 3bi
<search-model> >>model ; inline
>r [ find-workspace hide-popup ] r> r>
swap <list> ;
: <live-search> ( string seq limited? presenter -- gadget ) : <search-list> ( presenter live-search -- list )
[ [ find-workspace hide-popup ] ] [ ] [ model>> ] tri* <list> ;
:: <live-search> ( string seq limited? presenter -- gadget )
{ 0 1 } live-search new-track { 0 1 } live-search new-track
<search-field> >>field <search-field> >>field
dup field>> f track-add seq limited? init-search-model
-roll <search-list> >>list presenter over <search-list> >>list
dup field>> 1 <border> { 0 0 } >>align f track-add
dup list>> <scroller> 1 track-add dup list>> <scroller> 1 track-add
swap string over field>> set-editor-string
over field>> set-editor-string
dup field>> end-of-document ; dup field>> end-of-document ;
M: live-search focusable-child* field>> ; 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 ; [ dup synopsis >lower ] { } map>assoc sort-values ;
: <definition-search> ( string words limited? -- gadget ) : <definition-search> ( string words limited? -- gadget )
>r definition-candidates r> [ synopsis ] <live-search> ; [ definition-candidates ] dip [ synopsis ] <live-search> ;
: word-candidates ( words -- candidates ) : word-candidates ( words -- candidates )
[ dup name>> >lower ] { } map>assoc ; [ dup name>> >lower ] { } map>assoc ;
: <word-search> ( string words limited? -- gadget ) : <word-search> ( string words limited? -- gadget )
>r word-candidates r> [ synopsis ] <live-search> ; [ word-candidates ] dip [ synopsis ] <live-search> ;
: com-words ( workspace -- ) : com-words ( workspace -- )
dup current-word all-words t <word-search> dup current-word all-words t <word-search>
"Word search" show-titled-popup ; "Word search" show-titled-popup ;
: show-vocab-words ( workspace vocab -- ) : show-vocab-words ( workspace vocab -- )
"" over words natural-sort f <word-search> [ "" swap words natural-sort f <word-search> ]
"Words in " rot vocab-name append show-titled-popup ; [ "Words in " swap vocab-name append ]
bi show-titled-popup ;
: show-word-usage ( workspace word -- ) : show-word-usage ( workspace word -- )
"" over smart-usage f <definition-search> [ "" swap smart-usage f <definition-search> ]
"Words and methods using " rot name>> append [ "Words and methods using " swap name>> append ]
show-titled-popup ; bi show-titled-popup ;
: help-candidates ( seq -- candidates ) : help-candidates ( seq -- candidates )
[ dup >link swap article-title >lower ] { } map>assoc [ 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 ; "Source file search" show-titled-popup ;
: show-vocab-files ( workspace vocab -- ) : show-vocab-files ( workspace vocab -- )
"" over vocab-files <source-file-search> [ "" swap vocab-files <source-file-search> ]
"Source files in " rot vocab-name append show-titled-popup ; [ "Source files in " swap vocab-name append ]
bi show-titled-popup ;
: vocab-candidates ( -- candidates ) : vocab-candidates ( -- candidates )
all-vocabs-seq [ dup vocab-name >lower ] { } map>assoc ; all-vocabs-seq [ dup vocab-name >lower ] { } map>assoc ;

2
basis/ui/tools/traceback/traceback.factor
View File

@ -36,7 +36,7 @@ M: traceback-gadget pref-dim* drop { 550 600 } ;
dup model>> <callstack-display> 2/3 track-add dup model>> <callstack-display> 2/3 track-add
dup <toolbar> f track-add ; add-toolbar ;
: <namestack-display> ( model -- gadget ) : <namestack-display> ( model -- gadget )
[ [ name>> namestack. ] when* ] [ [ name>> namestack. ] when* ]

2
basis/ui/tools/walker/walker.factor
View File

@ -62,7 +62,7 @@ M: walker-gadget focusable-child*
swap >>status swap >>status
dup continuation>> <traceback-gadget> >>traceback dup continuation>> <traceback-gadget> >>traceback
dup <toolbar> f track-add add-toolbar
dup status>> self <thread-status> f track-add dup status>> self <thread-status> f track-add
dup traceback>> 1 track-add ; dup traceback>> 1 track-add ;

18
basis/ui/tools/workspace/workspace.factor
View File

@ -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. ! See http://factorcode.org/license.txt for BSD license.
USING: classes continuations help help.topics kernel models USING: classes continuations help help.topics kernel models
sequences ui ui.backend ui.tools.debugger ui.gadgets sequences assocs arrays namespaces accessors math.vectors ui
ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled ui.backend ui.tools.debugger ui.gadgets ui.gadgets.books
ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.buttons ui.gadgets.labelled ui.gadgets.panes
ui.gadgets.worlds ui.gadgets.presentations ui.gadgets.status-bar ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.worlds
ui.commands ui.gestures assocs arrays namespaces accessors ; ui.gadgets.presentations ui.gadgets.status-bar ui.commands
ui.gestures ;
IN: ui.tools.workspace IN: ui.tools.workspace
TUPLE: workspace < track book listener popup ; TUPLE: workspace < track book listener popup ;
@ -32,8 +32,6 @@ M: gadget tool-scroller drop f ;
[ find-tool swap ] keep book>> model>> [ find-tool swap ] keep book>> model>>
set-model ; set-model ;
: select-tool ( workspace class -- ) swap show-tool drop ;
: get-workspace* ( quot -- workspace ) : get-workspace* ( quot -- workspace )
[ >r dup workspace? r> [ drop f ] if ] curry find-window [ >r dup workspace? r> [ drop f ] if ] curry find-window
[ dup raise-window gadget-child ] [ dup raise-window gadget-child ]
@ -81,7 +79,7 @@ SYMBOL: workspace-dim
{ 600 700 } workspace-dim set-global { 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* M: workspace focusable-child*
dup popup>> [ ] [ listener>> ] ?if ; dup popup>> [ ] [ listener>> ] ?if ;