1 ! Copyright (C) 2006, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors continuations kernel models namespaces arrays
4 fry prettyprint ui ui.commands ui.gadgets ui.gadgets.labeled assocs
5 ui.gadgets.tracks ui.gadgets.buttons ui.gadgets.panes
6 ui.gadgets.status-bar ui.gadgets.scrollers ui.gadgets.borders
7 ui.gadgets.tables ui.gestures sequences inspector
9 QUALIFIED-WITH: ui.tools.inspector i
10 IN: ui.tools.traceback
12 TUPLE: stack-entry object string ;
14 : <stack-entry> ( object -- stack-entry )
15 dup unparse-short stack-entry boa ;
17 SINGLETON: stack-entry-renderer
19 M: stack-entry-renderer row-columns drop string>> 1array ;
21 M: stack-entry-renderer row-value drop object>> ;
23 : <stack-table> ( model -- table )
24 [ [ <stack-entry> ] map ] <filter> stack-entry-renderer <table>
26 [ i:inspector ] >>action
29 : <stack-display> ( model quot title -- gadget )
30 [ '[ dup _ when ] <filter> <stack-table> <scroller> ] dip
33 : <callstack-display> ( model -- gadget )
34 [ [ call>> callstack. ] when* ]
35 <pane-control> t >>scrolls? <scroller>
36 "Call stack" <labeled-gadget> ;
38 : <datastack-display> ( model -- gadget )
39 [ data>> ] "Data stack" <stack-display> ;
41 : <retainstack-display> ( model -- gadget )
42 [ retain>> ] "Retain stack" <stack-display> ;
44 TUPLE: traceback-gadget < track ;
46 M: traceback-gadget pref-dim* drop { 550 600 } ;
48 : <traceback-gadget> ( model -- gadget )
50 vertical traceback-gadget new-track
55 [ vertical <track> { 3 3 } >>gap ] dip
57 [ horizontal <track> { 3 3 } >>gap ] dip
58 [ <datastack-display> 1/2 track-add ]
59 [ <retainstack-display> 1/2 track-add ] bi
62 [ <callstack-display> 2/3 track-add ] bi
63 { 3 3 } <filled-border> 1 track-add
67 : variables ( traceback -- )
68 model>> [ dup [ name>> vars-in-scope ] when ] <filter> i:inspect-model ;
70 : traceback-window ( continuation -- )
71 <model> <traceback-gadget> "Traceback" open-status-window ;
73 : inspect-continuation ( traceback -- )
74 control-value i:inspector ;
76 traceback-gadget "toolbar" f {
77 { T{ key-down f f "v" } variables }
78 { T{ key-down f f "n" } inspect-continuation }