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
drop f ;
: :edit ( -- )
error get [ error-file ] [ error-line ] bi
: (:edit) ( error -- )
[ error-file ] [ error-line ] bi
2dup and [ edit-location ] [ 2drop ] if ;
: :edit ( -- )
error get (:edit) ;
: edit-each ( seq -- )
[
[ "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
":vars - list all variables at error time" print ;
: :help ( -- )
error get error-help [ help ] [ "No help for this error. " print ] if*
: (:help) ( error -- )
error-help [ help ] [ "No help for this error. " print ] if*
:help-debugger ;
: :help ( -- )
error get (:help) ;
: remove-article ( name -- )
dup articles get key? [
dup unxref-article

View File

@ -1,35 +1,43 @@
! Copyright (C) 2006, 2008 Slava Pestov.
! 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
namespaces sequences sequences words continuations debugger
prettyprint help editors ui ui.commands ui.gestures ui.gadgets
ui.gadgets.worlds ui.gadgets.packs ui.gadgets.buttons
ui.gadgets.labels ui.gadgets.panes ui.gadgets.presentations
ui.gadgets.viewports ui.gadgets.lists ui.gadgets.tracks
ui.gadgets.scrollers ui.gadgets.panes hashtables io kernel math
models namespaces sequences sequences words continuations
debugger prettyprint ui.tools.traceback help editors ;
ui.gadgets.scrollers ui.gadgets.panes ui.tools.traceback ;
IN: ui.tools.debugger
: <restart-list> ( restarts restart-hook -- gadget )
[ name>> ] rot <model> <list> ;
TUPLE: debugger < track error restarts restart-hook restart-list continuation ;
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>
<pane>
swapd tuck [ print-error ] with-pane
add-gadget
over error>> <error-pane> add-gadget
swap restart-list>> add-gadget ; inline
swap add-gadget ;
PRIVATE>
: <debugger> ( error restarts restart-hook -- gadget )
{ 0 1 } debugger new-track
add-toolbar
-rot <restart-list> >>restarts
dup restarts>> rot <debugger-display> <scroller> 1 track-add ;
swap >>restart-hook
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 -- )
#! No restarts for the debugger window
@ -55,16 +63,20 @@ debugger "gestures" f {
{ T{ button-down } request-focus }
} 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 {
{ T{ key-down f f "s" } com-traceback }
{ T{ key-down f f "h" } :help }
{ T{ key-down f f "e" } :edit }
{ T{ key-down f f "h" } com-help }
{ T{ key-down f f "e" } com-edit }
} define-command-map

View File

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