Traceback and Walker now use the new labeled gadget

db4
nicolas-p 2015-07-20 20:20:32 +02:00 committed by John Benediktsson
parent 06fa803cca
commit 09f68f7a98
2 changed files with 24 additions and 14 deletions

View File

@ -3,8 +3,8 @@
USING: accessors arrays continuations fonts fry inspector USING: accessors arrays continuations fonts fry inspector
kernel models models.arrow prettyprint sequences ui.commands kernel models models.arrow prettyprint sequences ui.commands
ui.gadgets ui.gadgets.borders ui.gadgets.buttons ui.gadgets ui.gadgets.borders ui.gadgets.buttons
ui.gadgets.labeled ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.labeled ui.gadgets.lines ui.gadgets.panes ui.gadgets.scrollers
ui.gadgets.status-bar ui.gadgets.tables ui.gadgets.tracks ui.gadgets.status-bar ui.gadgets.tables ui.gadgets.toolbar ui.gadgets.tracks
ui.gestures ui.tools.common ; ui.gestures ui.tools.common ;
QUALIFIED-WITH: ui.tools.inspector i QUALIFIED-WITH: ui.tools.inspector i
IN: ui.tools.traceback IN: ui.tools.traceback
@ -51,19 +51,19 @@ TUPLE: traceback-gadget < tool ;
: <traceback-gadget> ( model -- gadget ) : <traceback-gadget> ( model -- gadget )
[ [
vertical traceback-gadget new-track vertical traceback-gadget new-track
{ 3 3 } >>gap with-lines
] dip ] dip
[ >>model ] [ >>model ]
[ [
[ vertical <track> { 3 3 } >>gap ] dip [ vertical <track> with-lines ] dip
[ [
[ horizontal <track> { 3 3 } >>gap ] dip [ horizontal <track> with-lines ] dip
[ <datastack-display> 1/2 track-add ] [ <datastack-display> 1/2 track-add ]
[ <retainstack-display> 1/2 track-add ] bi [ <retainstack-display> 1/2 track-add ] bi
1/3 track-add 1/3 track-add
] ]
[ <callstack-display> 2/3 track-add ] bi [ <callstack-display> 2/3 track-add ] bi
{ 3 3 } <filled-border> 1 track-add 1 track-add
] bi ] bi
add-toolbar ; add-toolbar ;

View File

@ -1,10 +1,10 @@
! Copyright (C) 2006, 2009 Slava Pestov. ! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel concurrency.messaging inspector USING: accessors colors kernel concurrency.messaging colors.constants inspector
ui.tools.listener ui.tools.traceback ui.gadgets.buttons ui.tools.listener ui.tools.traceback ui.gadgets.buttons ui.gadgets.lines
ui.gadgets.status-bar ui.gadgets.tracks ui.commands ui.gadgets ui.gadgets.status-bar ui.gadgets.toolbar ui.gadgets.tracks ui.commands ui.gadgets
models models.arrow ui.tools.browser ui.tools.common ui.gestures models models.arrow ui.tools.browser ui.tools.common ui.gestures
ui.gadgets.labels ui threads namespaces make tools.walker assocs ui.gadgets.labels ui.pens.solid ui threads namespaces make tools.walker assocs
combinators fry ; combinators fry ;
IN: ui.tools.walker IN: ui.tools.walker
@ -54,17 +54,27 @@ M: walker-gadget focusable-child*
: <thread-status> ( model thread -- gadget ) : <thread-status> ( model thread -- gadget )
'[ _ walker-state-string ] <arrow> <label-control> ; '[ _ walker-state-string ] <arrow> <label-control> ;
CONSTANT: thread-status-color
T{ rgba { red 0.9295 } { green 0.9569 } { blue 0.8510 } { alpha 1.0 } } inline
: add-thread-status ( track -- track )
dup status>> self <thread-status> margins
thread-status-color <solid> >>interior
f track-add ;
: add-traceback ( track -- track )
dup traceback>> 1 track-add ;
: <walker-gadget> ( status continuation thread -- gadget ) : <walker-gadget> ( status continuation thread -- gadget )
vertical walker-gadget new-track vertical walker-gadget new-track with-lines
swap >>thread swap >>thread
swap >>continuation swap >>continuation
swap >>status swap >>status
dup continuation>> <traceback-gadget> >>traceback dup continuation>> <traceback-gadget> >>traceback
add-toolbar add-toolbar
dup status>> self <thread-status> f track-add add-thread-status
dup traceback>> 1 track-add ; add-traceback ;
: walker-help ( -- ) "ui-walker" com-browse ; : walker-help ( -- ) "ui-walker" com-browse ;