Tweak debugger and traceback a bit
parent
e62a558cf4
commit
915bd51b20
|
@ -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 . ]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue