2007-09-20 18:09:08 -04:00
|
|
|
! Copyright (C) 2006, 2007 Slava Pestov.
|
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
|
USING: arrays assocs ui.tools.listener ui.tools.traceback
|
|
|
|
|
ui.tools.workspace inspector kernel models namespaces
|
|
|
|
|
prettyprint quotations sequences threads tools.interpreter
|
|
|
|
|
ui.commands ui.gadgets ui.gadgets.labelled ui.gadgets.tracks
|
|
|
|
|
ui.gestures ui.gadgets.buttons ui.gadgets.panes
|
|
|
|
|
prettyprint.config prettyprint.backend ;
|
|
|
|
|
IN: ui.tools.walker
|
|
|
|
|
|
2007-10-03 16:56:49 -04:00
|
|
|
TUPLE: walker-gadget model ns ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
|
: update-stacks ( walker -- )
|
2007-10-03 16:56:49 -04:00
|
|
|
interpreter get swap walker-gadget-model set-model ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
|
: with-walker ( gadget quot -- )
|
2007-10-03 16:56:49 -04:00
|
|
|
swap dup walker-gadget-ns [ slip update-stacks ] bind ;
|
|
|
|
|
inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
|
: walker-active? ( walker -- ? )
|
2007-10-03 16:56:49 -04:00
|
|
|
interpreter swap walker-gadget-ns key? ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
|
: walker-command ( gadget quot -- )
|
|
|
|
|
over walker-active? [ with-walker ] [ 2drop ] if ; inline
|
|
|
|
|
|
|
|
|
|
: com-step [ step ] walker-command ;
|
2007-10-03 16:56:49 -04:00
|
|
|
: com-into [ step-into ] walker-command ;
|
2007-09-20 18:09:08 -04:00
|
|
|
: com-out [ step-out ] walker-command ;
|
|
|
|
|
: com-back [ step-back ] walker-command ;
|
|
|
|
|
|
|
|
|
|
: init-walker-models ( walker -- )
|
|
|
|
|
f <model> over set-walker-gadget-model
|
|
|
|
|
H{ } clone swap set-walker-gadget-ns ;
|
|
|
|
|
|
|
|
|
|
: reset-walker ( walker -- )
|
|
|
|
|
dup walker-gadget-ns clear-assoc
|
2007-10-03 16:56:49 -04:00
|
|
|
[ V{ } clone history set ] with-walker ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
|
: <walker-gadget> ( -- gadget )
|
|
|
|
|
walker-gadget construct-empty
|
|
|
|
|
dup init-walker-models [
|
|
|
|
|
toolbar,
|
2007-10-03 16:56:49 -04:00
|
|
|
g walker-gadget-model <traceback-gadget> 1 track,
|
2007-09-20 18:09:08 -04:00
|
|
|
] { 0 1 } build-track
|
|
|
|
|
dup reset-walker ;
|
|
|
|
|
|
|
|
|
|
M: walker-gadget call-tool* ( continuation walker -- )
|
|
|
|
|
[ restore ] with-walker ;
|
|
|
|
|
|
|
|
|
|
: com-inspect ( walker -- )
|
|
|
|
|
dup walker-active? [
|
2007-10-03 16:56:49 -04:00
|
|
|
interpreter swap walker-gadget-ns at
|
2007-09-20 18:09:08 -04:00
|
|
|
[ inspect ] curry call-listener
|
|
|
|
|
] [
|
|
|
|
|
drop
|
|
|
|
|
] if ;
|
|
|
|
|
|
|
|
|
|
: com-continue ( walker -- )
|
|
|
|
|
dup [ step-all ] walker-command reset-walker ;
|
|
|
|
|
|
|
|
|
|
: walker-help "ui-walker" help-window ;
|
|
|
|
|
|
|
|
|
|
\ walker-help H{ { +nullary+ t } } define-command
|
|
|
|
|
|
|
|
|
|
walker-gadget "toolbar" f {
|
|
|
|
|
{ T{ key-down f { A+ } "s" } com-step }
|
|
|
|
|
{ T{ key-down f { A+ } "i" } com-into }
|
|
|
|
|
{ T{ key-down f { A+ } "o" } com-out }
|
|
|
|
|
{ T{ key-down f { A+ } "b" } com-back }
|
|
|
|
|
{ T{ key-down f { A+ } "c" } com-continue }
|
|
|
|
|
{ T{ key-down f f "F1" } walker-help }
|
|
|
|
|
} define-command-map
|
|
|
|
|
|
|
|
|
|
walker-gadget "other" f {
|
|
|
|
|
{ T{ key-down f { A+ } "n" } com-inspect }
|
|
|
|
|
} define-command-map
|
|
|
|
|
|
|
|
|
|
[ walker-gadget call-tool stop ] break-hook set-global
|
