-! Copyright (C) 2006, 2009 Slava Pestov.
+! Copyright (C) 2006, 2011 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays hashtables io kernel math models
-colors.constants namespaces sequences sequences words continuations
-debugger prettyprint help editors fonts ui ui.commands ui.gestures
-ui.gadgets ui.pens.solid ui.gadgets.worlds ui.gadgets.packs
-ui.gadgets.buttons ui.gadgets.labels ui.gadgets.panes
-ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.tables
-ui.gadgets.tracks ui.gadgets.scrollers ui.gadgets.panes
-ui.gadgets.borders ui.gadgets.status-bar ui.tools.traceback
-ui.tools.inspector ui.tools.browser ;
+colors.constants namespaces sequences words continuations
+debugger prettyprint help editors fonts ui ui.commands
+ui.debugger ui.gestures ui.gadgets ui.pens.solid
+ui.gadgets.worlds ui.gadgets.packs ui.gadgets.buttons
+ui.gadgets.labels ui.gadgets.presentations ui.gadgets.panes
+ui.gadgets.viewports ui.gadgets.tables ui.theme
+ui.gadgets.theme ui.gadgets.tracks ui.gadgets.toolbar
+ui.gadgets.scrollers ui.gadgets.borders ui.gadgets.status-bar
+ui.tools.traceback ui.tools.inspector ui.tools.browser ui.tools.common ;
IN: ui.tools.debugger
TUPLE: debugger < track error restarts restart-hook restart-list continuation ;
: <restart-list> ( debugger -- gadget )
dup restarts>> f prefix <model> restart-renderer <table>
- [ [ \ restart invoke-command ] when* ] >>action
+ [ [ \ continue-restart invoke-command ] when* ] >>action
swap restart-hook>> >>hook
t >>selection-required?
t >>single-click? ; inline
[ error>> <error-pane> add-gadget ]
[
dup restart-hook>> [
- [ "To continue, pick one of the options below:" <label> add-gadget ] dip
+ [ "To continue, pick one of the options below:" <label> theme-font-colors add-gadget ] dip
restart-list>> add-gadget
] [ drop ] if
] bi ;
PRIVATE>
: <debugger> ( error continuation restarts restart-hook -- debugger )
- vertical debugger new-track
- { 3 3 } >>gap
+ vertical debugger new-track with-lines
swap >>restart-hook
swap >>restarts
swap >>continuation
swap >>error
- add-toolbar
dup <restart-list> >>restart-list
- dup <error-display> f track-add
- COLOR: white <solid> >>interior ;
+ dup <error-display> margins white-interior f track-add
+ add-toolbar ;
M: debugger focusable-child*
dup restart-hook>> [ restart-list>> ] [ drop t ] if ;
: debugger-window ( error continuation -- )
- #! No restarts for the debugger window
+ ! No restarts for the debugger window
f f <debugger> "Error" open-status-window ;
GENERIC: error-in-debugger? ( error -- ? )
-M: world-error error-in-debugger? world>> gadget-child debugger? ;
+M: world-error error-in-debugger?
+ world>> children>> [ f ] [ first debugger? ] if-empty ;
M: object error-in-debugger? drop f ;
[
dup error-in-debugger?
- [ rethrow ] [ error-continuation get debugger-window ] if
+ [ error-alert ] [ error-continuation get debugger-window ] if
] ui-error-hook set-global
-M: world-error error.
- "An error occurred while drawing the world " write
- dup world>> pprint-short "." print
- "This world has been deactivated to prevent cascading errors." print
- error>> error. ;
-
debugger "gestures" f {
{ T{ button-down } request-focus }
} define-command-map
: com-help ( debugger -- ) error>> error-help-window ;
-: com-edit ( debugger -- ) error>> (:edit) ;
+: com-edit ( debugger -- ) error>> edit-error ;
\ com-edit H{ { +listener+ t } } define-command