steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ui.tools.traceback: rewrite <traceback-gadget>

db4
Eduardo Cavazos 2008-07-14 00:39:02 -05:00
parent f48efe0540
commit 4e5551759a
1 changed files with 17 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
extra/ui/tools/traceback/traceback.factor
View File

@ -1,10 +1,11 @@
! Copyright (C) 2006, 2008 Slava Pestov. ! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors continuations kernel models namespaces USING: accessors continuations kernel models namespaces
prettyprint ui ui.commands ui.gadgets ui.gadgets.labelled assocs prettyprint ui ui.commands ui.gadgets ui.gadgets.labelled assocs
ui.gadgets.tracks ui.gadgets.buttons ui.gadgets.panes ui.gadgets.tracks ui.gadgets.buttons ui.gadgets.panes
ui.gadgets.status-bar ui.gadgets.scrollers ui.gestures sequences ui.gadgets.status-bar ui.gadgets.scrollers ui.gestures sequences
hashtables inspector ; hashtables inspector ;
IN: ui.tools.traceback IN: ui.tools.traceback
: <callstack-display> ( model -- gadget ) : <callstack-display> ( model -- gadget )
@ -24,20 +25,18 @@ TUPLE: traceback-gadget < track ;
M: traceback-gadget pref-dim* drop { 550 600 } ; M: traceback-gadget pref-dim* drop { 550 600 } ;
: <traceback-gadget> ( model -- gadget ) : <traceback-gadget> ( model -- gadget )
{ 0 1 } traceback-gadget new-track { 0 1 } traceback-gadget new-track
swap >>model swap >>model
[
g model>> dup model>>
[ { 1 0 } <track>
[ over <datastack-display> 1/2 track-add*
[ <datastack-display> 1/2 track, ] swap <retainstack-display> 1/2 track-add*
[ <retainstack-display> 1/2 track, ] 1/3 track-add*
bi
] { 1 0 } make-track 1/3 track, dup model>> <callstack-display> 2/3 track-add*
]
[ <callstack-display> 2/3 track, ] bi dup <toolbar> f track-add* ;
toolbar,
] make-gadget ;
: <namestack-display> ( model -- gadget ) : <namestack-display> ( model -- gadget )
[ [ continuation-name namestack. ] when* ] [ [ continuation-name namestack. ] when* ]