]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/ui/tools/traceback/traceback.factor
ui.theme: updates to color scheme.
[factor.git] / basis / ui / tools / traceback / traceback.factor
index f8f5dd382cd047fa6141f463939ba76d423c0a29..d2a839ba737cdb24ca85d78152e9a543ff2ff7c4 100644 (file)
@@ -1,18 +1,20 @@
-! Copyright (C) 2006, 2009 Slava Pestov.
+! Copyright (C) 2006, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors continuations kernel models namespaces arrays
-fry prettyprint ui ui.commands ui.gadgets ui.gadgets.labeled assocs
-ui.gadgets.tracks ui.gadgets.buttons ui.gadgets.panes
-ui.gadgets.status-bar ui.gadgets.scrollers ui.gadgets.borders
-ui.gadgets.tables ui.gestures sequences inspector
-models.filter fonts ;
+USING: accessors arrays colors.constants continuations fonts fry inspector
+kernel models models.arrow prettyprint sequences ui.commands
+ui.gadgets ui.gadgets.borders ui.gadgets.buttons
+ui.gadgets.labeled ui.gadgets.panes ui.gadgets.scrollers
+ui.gadgets.status-bar ui.gadgets.tables ui.gadgets.toolbar
+ui.theme ui.gadgets.theme ui.gadgets.tracks
+ui.gestures ui.tools.common ;
 QUALIFIED-WITH: ui.tools.inspector i
 IN: ui.tools.traceback
 
 TUPLE: stack-entry object string ;
 
 : <stack-entry> ( object -- stack-entry )
-    dup unparse-short stack-entry boa ;
+    dup [ unparse-short ] [ drop error-in-pprint ] recover
+    stack-entry boa ;
 
 SINGLETON: stack-entry-renderer
 
@@ -21,53 +23,53 @@ M: stack-entry-renderer row-columns drop string>> 1array ;
 M: stack-entry-renderer row-value drop object>> ;
 
 : <stack-table> ( model -- table )
-    [ [ <stack-entry> ] map ] <filter> stack-entry-renderer <table>
+    [ [ <stack-entry> ] map ] <arrow> stack-entry-renderer <table>
         10 >>min-rows
         10 >>max-rows
         40 >>min-cols
         40 >>max-cols
-        monospace-font >>font
+        monospace-font >>font theme-font-colors
         [ i:inspector ] >>action
         t >>single-click? ;
 
-: <stack-display> ( model quot title -- gadget )
-    [ '[ dup _ when ] <filter> <stack-table> <scroller> ] dip
-    <labeled-gadget> ;
+: <stack-display> ( model quot title color -- gadget )
+    [ '[ dup _ when ] <arrow> <stack-table> margins <scroller> white-interior ] 2dip
+    <labeled> ;
 
 : <callstack-display> ( model -- gadget )
     [ [ call>> callstack. ] when* ]
-    <pane-control> t >>scrolls? <scroller>
-    "Call stack" <labeled-gadget> ;
+    <pane-control> t >>scrolls? margins <scroller> white-interior
+    "Call stack" call-stack-color <labeled> ;
 
 : <datastack-display> ( model -- gadget )
-    [ data>> ] "Data stack" <stack-display> ;
+    [ data>> ] "Data stack" data-stack-color <stack-display> ;
 
 : <retainstack-display> ( model -- gadget )
-    [ retain>> ] "Retain stack" <stack-display> ;
+    [ retain>> ] "Retain stack" retain-stack-color <stack-display> ;
 
-TUPLE: traceback-gadget < track ;
+TUPLE: traceback-gadget < tool ;
 
 : <traceback-gadget> ( model -- gadget )
     [
         vertical traceback-gadget new-track
-        { 3 3 } >>gap
+        with-lines
     ] dip
     [ >>model ]
     [
-        [ vertical <track> { 3 3 } >>gap ] dip
+        [ vertical <track> with-lines ] dip
         [
-            [ horizontal <track> { 3 3 } >>gap ] dip
+            [ horizontal <track> with-lines ] dip
             [ <datastack-display> 1/2 track-add ]
             [ <retainstack-display> 1/2 track-add ] bi
             1/3 track-add
         ]
         [ <callstack-display> 2/3 track-add ] bi
-        { 3 3 } <filled-border> 1 track-add
+         1 track-add
     ] bi
     add-toolbar ;
 
 : variables ( traceback -- )
-    model>> [ dup [ name>> vars-in-scope ] when ] <filter> i:inspect-model ;
+    model>> [ dup [ name>> vars-in-scope ] when ] <arrow> i:inspect-model ;
 
 : traceback-window ( continuation -- )
     <model> <traceback-gadget> "Traceback" open-status-window ;
@@ -78,4 +80,4 @@ TUPLE: traceback-gadget < track ;
 traceback-gadget "toolbar" f {
     { T{ key-down f f "v" } variables }
     { T{ key-down f f "n" } inspect-continuation }
-} define-command-map
\ No newline at end of file
+} define-command-map