1 ! Copyright (C) 2006, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors kernel concurrency.messaging inspector
4 ui.tools.listener ui.tools.traceback ui.gadgets.buttons
5 ui.gadgets.status-bar ui.gadgets.tracks ui.commands ui.gadgets
6 models models.filter ui.tools.workspace ui.gestures
7 ui.gadgets.labels ui threads namespaces make tools.walker assocs
11 TUPLE: walker-gadget < track
12 status continuation thread
16 : walker-command ( walker msg -- )
18 dup thread>> thread-registered?
19 [ thread>> send-synchronous drop ]
23 : com-step ( walker -- ) step walker-command ;
25 : com-into ( walker -- ) step-into walker-command ;
27 : com-out ( walker -- ) step-out walker-command ;
29 : com-back ( walker -- ) step-back walker-command ;
31 : com-continue ( walker -- ) step-all walker-command ;
33 : com-abandon ( walker -- ) abandon walker-command ;
35 M: walker-gadget ungraft*
36 [ t >>closing? drop ] [ com-continue ] [ call-next-method ] tri ;
38 M: walker-gadget focusable-child*
41 : walker-state-string ( status thread -- string )
47 { +stopped+ "Stopped" }
48 { +suspended+ "Suspended" }
49 { +running+ "Running" }
55 : <thread-status> ( model thread -- gadget )
56 '[ _ walker-state-string ] <filter> <label-control> ;
58 : <walker-gadget> ( status continuation thread -- gadget )
59 { 0 1 } walker-gadget new-track
63 dup continuation>> <traceback-gadget> >>traceback
66 dup status>> self <thread-status> f track-add
67 dup traceback>> 1 track-add ;
69 : walker-help ( -- ) "ui-walker" help-window ;
71 \ walker-help H{ { +nullary+ t } } define-command
73 walker-gadget "toolbar" f {
74 { T{ key-down f f "s" } com-step }
75 { T{ key-down f f "i" } com-into }
76 { T{ key-down f f "o" } com-out }
77 { T{ key-down f f "b" } com-back }
78 { T{ key-down f f "c" } com-continue }
79 { T{ key-down f f "a" } com-abandon }
80 { T{ key-down f f "d" } close-window }
81 { T{ key-down f f "F1" } walker-help }
84 : walker-for-thread? ( thread gadget -- ? )
86 { [ dup walker-gadget? not ] [ 2drop f ] }
87 { [ dup closing?>> ] [ 2drop f ] }
91 : find-walker-window ( thread -- world/f )
92 '[ _ swap walker-for-thread? ] find-window ;
94 : walker-window ( status continuation thread -- )
95 [ <walker-gadget> ] [ name>> ] bi open-status-window ;
98 dup find-walker-window dup
99 [ raise-window 3drop ] [ drop [ walker-window ] with-ui ] if
100 ] show-walker-hook set-global