factor/extra/ui/tools/walker/walker.factor

95 lines
2.7 KiB
Factor
Executable File

! 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 continuations ;
IN: ui.tools.walker
TUPLE: walker model interpreter history ;
: update-stacks ( walker -- )
dup walker-interpreter interpreter-continuation
swap walker-model set-model ;
: with-walker ( walker quot -- )
over >r >r walker-interpreter r> call r>
update-stacks ; inline
: walker-active? ( walker -- ? )
walker-interpreter interpreter-continuation >boolean ;
: save-interpreter ( walker -- )
dup walker-interpreter interpreter-continuation clone
swap walker-history push ;
: walker-command ( gadget quot -- )
over walker-active? [
over save-interpreter
with-walker
] [ 2drop ] if ; inline
: com-step ( walker -- ) [ step ] walker-command ;
: com-into ( walker -- ) [ step-into ] walker-command ;
: com-out ( walker -- ) [ step-out ] walker-command ;
: com-back ( walker -- )
dup walker-history
dup empty? [ 2drop ] [ pop swap call-tool* ] if ;
: reset-walker ( walker -- )
<interpreter> over set-walker-interpreter
V{ } clone over set-walker-history
update-stacks ;
M: walker graft* dup delegate graft* reset-walker ;
: <walker> ( -- gadget )
f <model> f f walker construct-boa [
toolbar,
g walker-model <traceback-gadget> 1 track,
] { 0 1 } build-track ;
M: walker call-tool* ( continuation walker -- )
[ restore ] with-walker ;
: com-inspect ( walker -- )
dup walker-active? [
walker-interpreter interpreter-continuation
[ inspect ] curry call-listener
] [
drop
] if ;
: com-continue ( walker -- )
#! Reset walker first, in case step-all ends up calling
#! the walker again.
dup walker-active? [
dup walker-interpreter swap reset-walker step-all
] [
drop
] if ;
: walker-help "ui-walker" help-window ;
\ walker-help H{ { +nullary+ t } } define-command
walker "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 "other" f {
{ T{ key-down f { A+ } "n" } com-inspect }
} define-command-map
[ walker call-tool stop ] break-hook set-global