Tweak debugger and traceback a bit

db4
Slava Pestov 2008-11-24 12:29:24 -06:00
parent e62a558cf4
commit 915bd51b20
4 changed files with 48 additions and 30 deletions

View File

@ -64,10 +64,13 @@ M: object error-file
M: object error-line M: object error-line
drop f ; drop f ;
: :edit ( -- ) : (:edit) ( error -- )
error get [ error-file ] [ error-line ] bi [ error-file ] [ error-line ] bi
2dup and [ edit-location ] [ 2drop ] if ; 2dup and [ edit-location ] [ 2drop ] if ;
: :edit ( -- )
error get (:edit) ;
: edit-each ( seq -- ) : edit-each ( seq -- )
[ [
[ "Editing " write . ] [ "Editing " write . ]

View File

@ -155,10 +155,13 @@ help-hook global [ [ print-topic ] or ] change-at
":get ( var -- value ) accesses variables at time of the error" print ":get ( var -- value ) accesses variables at time of the error" print
":vars - list all variables at error time" print ; ":vars - list all variables at error time" print ;
: :help ( -- ) : (:help) ( error -- )
error get error-help [ help ] [ "No help for this error. " print ] if* error-help [ help ] [ "No help for this error. " print ] if*
:help-debugger ; :help-debugger ;
: :help ( -- )
error get (:help) ;
: remove-article ( name -- ) : remove-article ( name -- )
dup articles get key? [ dup articles get key? [
dup unxref-article dup unxref-article

View File

@ -1,35 +1,43 @@
! Copyright (C) 2006, 2008 Slava Pestov. ! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays ui ui.commands ui.gestures ui.gadgets USING: accessors arrays hashtables io kernel math models
ui.gadgets.worlds ui.gadgets.packs ui.gadgets.buttons namespaces sequences sequences words continuations debugger
ui.gadgets.labels ui.gadgets.panes ui.gadgets.presentations prettyprint help editors ui ui.commands ui.gestures ui.gadgets
ui.gadgets.viewports ui.gadgets.lists ui.gadgets.tracks ui.gadgets.worlds ui.gadgets.packs ui.gadgets.buttons
ui.gadgets.scrollers ui.gadgets.panes hashtables io kernel math ui.gadgets.labels ui.gadgets.panes ui.gadgets.presentations
models namespaces sequences sequences words continuations ui.gadgets.viewports ui.gadgets.lists ui.gadgets.tracks
debugger prettyprint ui.tools.traceback help editors ; ui.gadgets.scrollers ui.gadgets.panes ui.tools.traceback ;
IN: ui.tools.debugger IN: ui.tools.debugger
: <restart-list> ( restarts restart-hook -- gadget ) TUPLE: debugger < track error restarts restart-hook restart-list continuation ;
[ name>> ] rot <model> <list> ;
TUPLE: debugger < track restarts ; <PRIVATE
: <debugger-display> ( restart-list error -- gadget ) : <restart-list> ( debugger -- gadget )
[ restart-hook>> ] [ restarts>> ] bi
[ name>> ] swap <model> <list> ; inline
: <error-pane> ( error -- pane )
<pane> [ [ print-error ] with-pane ] keep ; inline
: <debugger-display> ( debugger -- gadget )
<filled-pile> <filled-pile>
<pane> over error>> <error-pane> add-gadget
swapd tuck [ print-error ] with-pane swap restart-list>> add-gadget ; inline
add-gadget
swap add-gadget ; PRIVATE>
: <debugger> ( error restarts restart-hook -- gadget ) : <debugger> ( error restarts restart-hook -- gadget )
{ 0 1 } debugger new-track { 0 1 } debugger new-track
add-toolbar add-toolbar
-rot <restart-list> >>restarts swap >>restart-hook
dup restarts>> rot <debugger-display> <scroller> 1 track-add ; swap >>restarts
swap >>error
error-continuation get >>continuation
dup <restart-list> >>restart-list
dup <debugger-display> <scroller> 1 track-add ;
M: debugger focusable-child* restarts>> ; M: debugger focusable-child* restart-list>> ;
: debugger-window ( error -- ) : debugger-window ( error -- )
#! No restarts for the debugger window #! No restarts for the debugger window
@ -55,16 +63,20 @@ debugger "gestures" f {
{ T{ button-down } request-focus } { T{ button-down } request-focus }
} define-command-map } define-command-map
: com-traceback ( -- ) error-continuation get traceback-window ; : com-traceback ( debugger -- ) continuation>> traceback-window ;
\ com-traceback H{ { +nullary+ t } } define-command \ com-traceback H{ } define-command
\ :help H{ { +nullary+ t } { +listener+ t } } define-command : com-help ( debugger -- ) error>> (:help) ;
\ :edit H{ { +nullary+ t } { +listener+ t } } define-command \ com-help H{ { +listener+ t } } define-command
: com-edit ( debugger -- ) error>> (:edit) ;
\ com-edit H{ { +listener+ t } } define-command
debugger "toolbar" f { debugger "toolbar" f {
{ T{ key-down f f "s" } com-traceback } { T{ key-down f f "s" } com-traceback }
{ T{ key-down f f "h" } :help } { T{ key-down f f "h" } com-help }
{ T{ key-down f f "e" } :edit } { T{ key-down f f "e" } com-edit }
} define-command-map } define-command-map

View File

@ -53,4 +53,4 @@ M: traceback-gadget pref-dim* drop { 550 600 } ;
"Dynamic variables" open-status-window ; "Dynamic variables" open-status-window ;
: traceback-window ( continuation -- ) : traceback-window ( continuation -- )
<model> <traceback-gadget> "Traceback" open-window ; <model> <traceback-gadget> "Traceback" open-status-window ;