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

ui.tools.walker: improved status text

db4
nicolas-p 2015-08-16 11:09:04 +02:00 committed by John Benediktsson
parent d71f7b955e
commit 2a7cc29693
1 changed files with 33 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,12 +1,12 @@
! 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 colors kernel concurrency.messaging colors.constants inspector formatting USING: accessors assocs colors colors.constants combinators
ui.tools.listener ui.tools.traceback ui.gadgets.buttons concurrency.messaging formatting fry inspector kernel make
ui.gadgets.status-bar ui.gadgets.toolbar ui.gadgets.theme ui.gadgets.tracks models models.arrow namespaces sequences threads tools.walker ui
ui.commands ui.gadgets ui.commands ui.gadgets ui.gadgets.buttons ui.gadgets.labels
models models.arrow ui.tools.browser ui.tools.common ui.gestures ui.gadgets.status-bar ui.gadgets.theme ui.gadgets.toolbar
ui.gadgets.labels ui.pens.solid ui threads namespaces make tools.walker assocs ui.gadgets.tracks ui.gestures ui.pens.solid ui.tools.browser
combinators fry ; ui.tools.common ui.tools.listener ui.tools.traceback ;
IN: ui.tools.walker IN: ui.tools.walker
TUPLE: walker-gadget < tool TUPLE: walker-gadget < tool
@ -39,14 +39,22 @@ M: walker-gadget ungraft*
M: walker-gadget focusable-child* M: walker-gadget focusable-child*
traceback>> ; traceback>> ;
: thread-status-text ( status thread -- string ) : thread-status-text ( status -- string )
name>> swap { {
{ +stopped+ "Stopped" } { +stopped+ "Stopped" }
{ +suspended+ "Suspended" } { +suspended+ "Suspended" }
{ +running+ "Running" } { +running+ "Running" }
} at "Thread: %s (%s)" sprintf ; } at "(" ")" surround ;
: thread-status-color ( status -- color ) : thread-status-foreground ( status -- color )
{
{ +stopped+ [ thread-status-stopped-foreground ] }
{ +suspended+ [ thread-status-suspended-foreground ] }
{ +running+ [ thread-status-running-foreground ] }
{ f [ text-color ] }
} case ;
: thread-status-background ( status -- color )
{ {
{ +stopped+ [ thread-status-stopped-background ] } { +stopped+ [ thread-status-stopped-background ] }
{ +suspended+ [ thread-status-suspended-background ] } { +suspended+ [ thread-status-suspended-background ] }
@ -54,22 +62,29 @@ M: walker-gadget focusable-child*
{ f [ content-background ] } { f [ content-background ] }
} case ; } case ;
TUPLE: thread-status < label thread ; TUPLE: thread-status < label ;
M: thread-status model-changed M: thread-status model-changed
[ value>> ] dip { [ value>> ] dip {
[ [ thread>> thread-status-text ] [ string<< ] bi ] [ [ thread-status-text ] [ string<< ] bi* ]
[ [ thread-status-color <solid> ] [ parent>> interior<< ] bi* ] [ [ thread-status-foreground ] [ font>> foreground<< ] bi* ]
[ [ thread-status-background <solid> ] [ parent>> parent>> interior<< ] bi* ]
} 2cleave ; } 2cleave ;
: <thread-status> ( model thread -- gadget ) : <thread-status> ( model -- gadget )
"" thread-status new-label "" thread-status new-label
swap >>thread
swap >>model ; swap >>model ;
: add-thread-status ( track -- track ) : add-thread-status ( track -- track )
dup status>> self <thread-status> margins horizontal <track> { 5 5 } >>gap
f track-add ; "Thread:" <label>
dup font>> t >>bold? drop
f track-add
self name>> <label> f track-add
over status>> <thread-status>
dup font>> t >>bold? drop
f track-add
margins f track-add ;
: add-traceback ( track -- track ) : add-traceback ( track -- track )
dup traceback>> 1 track-add ; dup traceback>> 1 track-add ;