new accessors

db4
Doug Coleman 2008-08-31 16:17:46 -05:00
parent 610a70c3d2
commit 31c5e57ab2
5 changed files with 12 additions and 12 deletions

View File

@ -39,17 +39,17 @@ M: browser-gadget ungraft*
: showing-definition? ( defspec assoc -- ? ) : showing-definition? ( defspec assoc -- ? )
[ key? ] 2keep [ key? ] 2keep
[ >r dup word-link? [ link-name ] when r> key? ] 2keep [ >r dup word-link? [ name>> ] when r> key? ] 2keep
>r dup vocab-link? [ vocab ] when r> key? >r dup vocab-link? [ vocab ] when r> key?
or or ; or or ;
M: browser-gadget definitions-changed ( assoc browser -- ) M: browser-gadget definitions-changed ( assoc browser -- )
history>> history>>
dup model-value rot showing-definition? dup value>> rot showing-definition?
[ notify-connections ] [ drop ] if ; [ notify-connections ] [ drop ] if ;
: help-action ( browser-gadget -- link ) : help-action ( browser-gadget -- link )
history>> model-value >link ; history>> value>> >link ;
: com-follow ( link -- ) browser-gadget call-tool ; : com-follow ( link -- ) browser-gadget call-tool ;

View File

@ -11,7 +11,7 @@ USING: accessors arrays ui ui.commands ui.gestures ui.gadgets
IN: ui.tools.debugger IN: ui.tools.debugger
: <restart-list> ( restarts restart-hook -- gadget ) : <restart-list> ( restarts restart-hook -- gadget )
[ restart-name ] rot <model> <list> ; [ name>> ] rot <model> <list> ;
TUPLE: debugger < track restarts ; TUPLE: debugger < track restarts ;

View File

@ -118,7 +118,7 @@ M: live-search pref-dim* drop { 400 200 } ;
: <source-file-search> ( string files -- gadget ) : <source-file-search> ( string files -- gadget )
source-file-candidates source-file-candidates
f [ pathname-string ] <live-search> ; f [ string>> ] <live-search> ;
: all-source-files ( -- seq ) : all-source-files ( -- seq )
source-files get keys natural-sort ; source-files get keys natural-sort ;
@ -146,7 +146,7 @@ M: live-search pref-dim* drop { 400 200 } ;
: <history-search> ( string seq -- gadget ) : <history-search> ( string seq -- gadget )
history-candidates history-candidates
f [ input-string ] <live-search> ; f [ string>> ] <live-search> ;
: listener-history ( listener -- seq ) : listener-history ( listener -- seq )
listener-gadget-input interactor-history <reversed> ; listener-gadget-input interactor-history <reversed> ;

View File

@ -9,15 +9,15 @@ USING: accessors continuations kernel models namespaces
IN: ui.tools.traceback IN: ui.tools.traceback
: <callstack-display> ( model -- gadget ) : <callstack-display> ( model -- gadget )
[ [ continuation-call callstack. ] when* ] [ [ call>> callstack. ] when* ]
t "Call stack" <labelled-pane> ; t "Call stack" <labelled-pane> ;
: <datastack-display> ( model -- gadget ) : <datastack-display> ( model -- gadget )
[ [ continuation-data stack. ] when* ] [ [ data>> stack. ] when* ]
t "Data stack" <labelled-pane> ; t "Data stack" <labelled-pane> ;
: <retainstack-display> ( model -- gadget ) : <retainstack-display> ( model -- gadget )
[ [ continuation-retain stack. ] when* ] [ [ return>> stack. ] when* ]
t "Retain stack" <labelled-pane> ; t "Retain stack" <labelled-pane> ;
TUPLE: traceback-gadget < track ; TUPLE: traceback-gadget < track ;
@ -39,7 +39,7 @@ M: traceback-gadget pref-dim* drop { 550 600 } ;
dup <toolbar> f track-add ; dup <toolbar> f track-add ;
: <namestack-display> ( model -- gadget ) : <namestack-display> ( model -- gadget )
[ [ continuation-name namestack. ] when* ] [ [ name>> namestack. ] when* ]
<pane-control> ; <pane-control> ;
: <variables-gadget> ( model -- gadget ) : <variables-gadget> ( model -- gadget )

View File

@ -41,7 +41,7 @@ M: walker-gadget focusable-child*
: walker-state-string ( status thread -- string ) : walker-state-string ( status thread -- string )
[ [
"Thread: " % "Thread: " %
dup thread-name % dup name>> %
" (" % " (" %
swap { swap {
{ +stopped+ "Stopped" } { +stopped+ "Stopped" }
@ -92,7 +92,7 @@ walker-gadget "toolbar" f {
[ swap walker-for-thread? ] curry find-window ; [ swap walker-for-thread? ] curry find-window ;
: walker-window ( status continuation thread -- ) : walker-window ( status continuation thread -- )
[ <walker-gadget> ] [ thread-name ] bi open-status-window ; [ <walker-gadget> ] [ name>> ] bi open-status-window ;
[ [
dup find-walker-window dup dup find-walker-window dup