]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/ui/tools/debugger/debugger.factor
ui.theme: updates to color scheme.
[factor.git] / basis / ui / tools / debugger / debugger.factor
index a4fda6600e6e6b8f8b70d48fc73c61e0d1afa6ae..f1ec3fb2d7ba01c8a504008710ee1e53b29aaa35 100644 (file)
@@ -1,13 +1,15 @@
-! 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 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.presentations ui.gadgets.viewports
-ui.gadgets.tables ui.gadgets.tracks ui.gadgets.scrollers
-ui.gadgets.borders ui.gadgets.status-bar ui.tools.traceback
-ui.tools.inspector ui.tools.browser ui.debugger ;
+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 ;
@@ -21,17 +23,20 @@ M: restart-renderer row-columns
 
 : <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-pane> ( error -- pane )
+    <pane> [ [ print-error ] with-pane ] keep ; inline
+
 : <error-display> ( debugger -- gadget )
     [ <filled-pile> ] dip
     [ 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 ;
@@ -39,22 +44,20 @@ M: restart-renderer row-columns
 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 -- ? )
@@ -66,7 +69,7 @@ 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
 
 debugger "gestures" f {