Use add-toolbar word in a few places
Slava Pestov
parent
2eac58c271
commit
f27ebdd1ef
|
|
@ -71,7 +71,7 @@ M: value-ref finish-editing
|
|||
: <slot-editor> ( ref -- gadget )
|
||||
{ 0 1 } slot-editor new-track
|
||||
swap >>ref
|
||||
dup <toolbar> f track-add
|
||||
add-toolbar
|
||||
<source-editor> >>text
|
||||
dup text>> <scroller> 1 track-add
|
||||
dup revert ;
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ TUPLE: debugger < track restarts ;
|
|||
|
||||
: <debugger> ( error restarts restart-hook -- gadget )
|
||||
{ 0 1 } debugger new-track
|
||||
dup <toolbar> f track-add
|
||||
add-toolbar
|
||||
-rot <restart-list> >>restarts
|
||||
dup restarts>> rot <debugger-display> <scroller> 1 track-add ;
|
||||
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ TUPLE: inspector-gadget < track object pane ;
|
|||
|
||||
: <inspector-gadget> ( -- gadget )
|
||||
{ 0 1 } inspector-gadget new-track
|
||||
dup <toolbar> f track-add
|
||||
add-toolbar
|
||||
<pane> >>pane
|
||||
dup pane>> <scroller> 1 track-add ;
|
||||
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ TUPLE: profiler-gadget < track pane ;
|
|||
|
||||
: <profiler-gadget> ( -- gadget )
|
||||
{ 0 1 } profiler-gadget new-track
|
||||
dup <toolbar> f track-add
|
||||
add-toolbar
|
||||
<pane> >>pane
|
||||
dup pane>> <scroller> 1 track-add ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
: <search-model> ( live-search producer -- live-search filter )
|
||||
>r dup field>> model>>
|
||||
ui-running? [ 1/5 seconds <delay> ] when
|
||||
[ "\n" join ] r> append <filter> ;
|
||||
: <search-model> ( live-search producer -- filter )
|
||||
[
|
||||
field>> model>>
|
||||
ui-running? [ 1/5 seconds <delay> ] when
|
||||
] dip [ "\n" join ] prepend <filter> ;
|
||||
|
||||
: <search-list> ( live-search seq limited? presenter -- live-search list )
|
||||
>r
|
||||
[ limited-completions ] [ completions ] ? curry
|
||||
<search-model>
|
||||
>r [ find-workspace hide-popup ] r> r>
|
||||
swap <list> ;
|
||||
: init-search-model ( live-search seq limited? -- live-search )
|
||||
[ 2drop ]
|
||||
[ [ limited-completions ] [ completions ] ? curry <search-model> ] 3bi
|
||||
>>model ; inline
|
||||
|
||||
: <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
|
||||
<search-field> >>field
|
||||
dup field>> f track-add
|
||||
-roll <search-list> >>list
|
||||
seq limited? init-search-model
|
||||
presenter over <search-list> >>list
|
||||
dup field>> 1 <border> { 0 0 } >>align f track-add
|
||||
dup list>> <scroller> 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 ;
|
||||
|
||||
: <definition-search> ( string words limited? -- gadget )
|
||||
>r definition-candidates r> [ synopsis ] <live-search> ;
|
||||
[ definition-candidates ] dip [ synopsis ] <live-search> ;
|
||||
|
||||
: word-candidates ( words -- candidates )
|
||||
[ dup name>> >lower ] { } map>assoc ;
|
||||
|
||||
: <word-search> ( string words limited? -- gadget )
|
||||
>r word-candidates r> [ synopsis ] <live-search> ;
|
||||
[ word-candidates ] dip [ synopsis ] <live-search> ;
|
||||
|
||||
: com-words ( workspace -- )
|
||||
dup current-word all-words t <word-search>
|
||||
"Word search" show-titled-popup ;
|
||||
|
||||
: show-vocab-words ( workspace vocab -- )
|
||||
"" over words natural-sort f <word-search>
|
||||
"Words in " rot vocab-name append show-titled-popup ;
|
||||
[ "" swap words natural-sort f <word-search> ]
|
||||
[ "Words in " swap vocab-name append ]
|
||||
bi show-titled-popup ;
|
||||
|
||||
: show-word-usage ( workspace word -- )
|
||||
"" over smart-usage f <definition-search>
|
||||
"Words and methods using " rot name>> append
|
||||
show-titled-popup ;
|
||||
[ "" swap smart-usage f <definition-search> ]
|
||||
[ "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-file-search>
|
||||
"Source files in " rot vocab-name append show-titled-popup ;
|
||||
[ "" swap vocab-files <source-file-search> ]
|
||||
[ "Source files in " swap vocab-name append ]
|
||||
bi show-titled-popup ;
|
||||
|
||||
: vocab-candidates ( -- candidates )
|
||||
all-vocabs-seq [ dup vocab-name >lower ] { } map>assoc ;
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ M: traceback-gadget pref-dim* drop { 550 600 } ;
|
|||
|
||||
dup model>> <callstack-display> 2/3 track-add
|
||||
|
||||
dup <toolbar> f track-add ;
|
||||
add-toolbar ;
|
||||
|
||||
: <namestack-display> ( model -- gadget )
|
||||
[ [ name>> namestack. ] when* ]
|
||||
|
|
|
|||
|
|
@ -62,9 +62,9 @@ M: walker-gadget focusable-child*
|
|||
swap >>status
|
||||
dup continuation>> <traceback-gadget> >>traceback
|
||||
|
||||
dup <toolbar> f track-add
|
||||
add-toolbar
|
||||
dup status>> self <thread-status> f track-add
|
||||
dup traceback>> 1 track-add ;
|
||||
dup traceback>> 1 track-add ;
|
||||
|
||||
: walker-help ( -- ) "ui-walker" help-window ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue