-! 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
-prettyprint ui ui.commands ui.gadgets ui.gadgets.labelled assocs
-ui.gadgets.tracks ui.gadgets.buttons ui.gadgets.panes
-ui.gadgets.status-bar ui.gadgets.scrollers ui.tools.inspector
-ui.gestures sequences hashtables inspector ;
+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
-: <callstack-display> ( model -- gadget )
- [ [ call>> callstack. ] when* ]
- t "Call stack" <labelled-pane> ;
+TUPLE: stack-entry object string ;
-: <datastack-display> ( model -- gadget )
- [ [ data>> stack. ] when* ]
- t "Data stack" <labelled-pane> ;
+: <stack-entry> ( object -- stack-entry )
+ dup [ unparse-short ] [ drop error-in-pprint ] recover
+ stack-entry boa ;
-: <retainstack-display> ( model -- gadget )
- [ [ retain>> stack. ] when* ]
- t "Retain stack" <labelled-pane> ;
+SINGLETON: stack-entry-renderer
-TUPLE: traceback-gadget < track ;
+M: stack-entry-renderer row-columns drop string>> 1array ;
-M: traceback-gadget pref-dim* drop { 550 600 } ;
+M: stack-entry-renderer row-value drop object>> ;
-: <traceback-gadget> ( model -- gadget )
- { 0 1 } traceback-gadget new-track
- swap >>model
+: <stack-table> ( model -- table )
+ [ [ <stack-entry> ] map ] <arrow> stack-entry-renderer <table>
+ 10 >>min-rows
+ 10 >>max-rows
+ 40 >>min-cols
+ 40 >>max-cols
+ monospace-font >>font theme-font-colors
+ [ i:inspector ] >>action
+ t >>single-click? ;
- dup model>>
- { 1 0 } <track>
- over <datastack-display> 1/2 track-add
- swap <retainstack-display> 1/2 track-add
- 1/3 track-add
+: <stack-display> ( model quot title color -- gadget )
+ [ '[ dup _ when ] <arrow> <stack-table> margins <scroller> white-interior ] 2dip
+ <labeled> ;
- dup model>> <callstack-display> 2/3 track-add
+: <callstack-display> ( model -- gadget )
+ [ [ call>> callstack. ] when* ]
+ <pane-control> t >>scrolls? margins <scroller> white-interior
+ "Call stack" call-stack-color <labeled> ;
- add-toolbar ;
+: <datastack-display> ( model -- gadget )
+ [ data>> ] "Data stack" data-stack-color <stack-display> ;
+
+: <retainstack-display> ( model -- gadget )
+ [ retain>> ] "Retain stack" retain-stack-color <stack-display> ;
-: <namestack-display> ( model -- gadget )
- [ [ name>> namestack. ] when* ]
- <pane-control> ;
+TUPLE: traceback-gadget < tool ;
-: <variables-gadget> ( model -- gadget )
- <namestack-display>
- <limited-scroller>
- { 400 400 } >>min-dim
- { 400 400 } >>max-dim ;
+: <traceback-gadget> ( model -- gadget )
+ [
+ vertical traceback-gadget new-track
+ with-lines
+ ] dip
+ [ >>model ]
+ [
+ [ vertical <track> with-lines ] 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
+ 1 track-add
+ ] bi
+ add-toolbar ;
: variables ( traceback -- )
- model>> <variables-gadget>
- "Dynamic variables" open-status-window ;
+ model>> [ dup [ name>> vars-in-scope ] when ] <arrow> i:inspect-model ;
: traceback-window ( continuation -- )
<model> <traceback-gadget> "Traceback" open-status-window ;
: inspect-continuation ( traceback -- )
- control-value inspector ;
+ control-value i:inspector ;
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