1 ! Copyright (C) 2006, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays hashtables io kernel math models
4 colors.constants namespaces sequences sequences words continuations
5 debugger prettyprint help editors fonts ui ui.commands ui.gestures
6 ui.gadgets ui.pens.solid ui.gadgets.worlds ui.gadgets.packs
7 ui.gadgets.buttons ui.gadgets.labels ui.gadgets.panes
8 ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.tables
9 ui.gadgets.tracks ui.gadgets.scrollers ui.gadgets.panes
10 ui.gadgets.borders ui.gadgets.status-bar ui.tools.traceback
11 ui.tools.inspector ui.tools.browser ;
14 TUPLE: debugger < track error restarts restart-hook restart-list continuation ;
18 SINGLETON: restart-renderer
20 M: restart-renderer row-columns
21 drop [ name>> ] [ "Abort" ] if* "• " prepend 1array ;
23 : <restart-list> ( debugger -- gadget )
24 dup restarts>> f prefix <model> restart-renderer <table>
25 [ [ \ restart invoke-command ] when* ] >>action
26 swap restart-hook>> >>hook
27 t >>selection-required?
28 t >>single-click? ; inline
30 : <error-pane> ( error -- pane )
31 <pane> [ [ print-error ] with-pane ] keep ; inline
33 : <error-display> ( debugger -- gadget )
35 [ error>> <error-pane> add-gadget ]
38 [ "To continue, pick one of the options below:" <label> add-gadget ] dip
39 restart-list>> add-gadget
45 : <debugger> ( error continuation restarts restart-hook -- debugger )
46 vertical debugger new-track
53 dup <restart-list> >>restart-list
54 dup <error-display> f track-add
55 COLOR: white <solid> >>interior ;
57 M: debugger focusable-child*
58 dup restart-hook>> [ restart-list>> ] [ drop t ] if ;
60 : debugger-window ( error continuation -- )
61 #! No restarts for the debugger window
62 f f <debugger> "Error" open-status-window ;
64 GENERIC: error-in-debugger? ( error -- ? )
66 M: world-error error-in-debugger? world>> gadget-child debugger? ;
68 M: object error-in-debugger? drop f ;
71 dup error-in-debugger?
72 [ rethrow ] [ error-continuation get debugger-window ] if
73 ] ui-error-hook set-global
76 "An error occurred while drawing the world " write
77 dup world>> pprint-short "." print
78 "This world has been deactivated to prevent cascading errors." print
81 debugger "gestures" f {
82 { T{ button-down } request-focus }
85 : com-inspect ( debugger -- ) error>> inspector ;
87 : com-traceback ( debugger -- ) continuation>> traceback-window ;
89 : com-help ( debugger -- ) error>> error-help-window ;
91 : com-edit ( debugger -- ) error>> (:edit) ;
93 \ com-edit H{ { +listener+ t } } define-command
95 debugger "toolbar" f {
96 { T{ key-down f { C+ } "i" } com-inspect }
97 { T{ key-down f { C+ } "t" } com-traceback }
98 { T{ key-down f { C+ } "h" } com-help }
99 { T{ key-down f { C+ } "e" } com-edit }