basis/ui/tools/traceback/traceback.factor

   1 ! Copyright (C) 2006, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors continuations kernel models namespaces
   4        prettyprint ui ui.commands ui.gadgets ui.gadgets.labelled assocs
   5        ui.gadgets.tracks ui.gadgets.buttons ui.gadgets.panes
   6        ui.gadgets.status-bar ui.gadgets.scrollers ui.gestures sequences
   7        hashtables inspector ;
   8
   9 IN: ui.tools.traceback
  10
  11 : <callstack-display> ( model -- gadget )
  12     [ [ call>> callstack. ] when* ]
  13     t "Call stack" <labelled-pane> ;
  14
  15 : <datastack-display> ( model -- gadget )
  16     [ [ data>> stack. ] when* ]
  17     t "Data stack" <labelled-pane> ;
  18
  19 : <retainstack-display> ( model -- gadget )
  20     [ [ retain>> stack. ] when* ]
  21     t "Retain stack" <labelled-pane> ;
  22
  23 TUPLE: traceback-gadget < track ;
  24
  25 M: traceback-gadget pref-dim* drop { 550 600 } ;
  26
  27 : <traceback-gadget> ( model -- gadget )
  28     { 0 1 } traceback-gadget new-track
  29         swap >>model
  30
  31     dup model>>
  32         { 1 0 } <track>
  33             over <datastack-display> 1/2 track-add
  34             swap <retainstack-display> 1/2 track-add
  35         1/3 track-add
  36
  37     dup model>> <callstack-display> 2/3 track-add
  38
  39     add-toolbar ;
  40
  41 : <namestack-display> ( model -- gadget )
  42     [ [ name>> namestack. ] when* ]
  43     <pane-control> ;
  44
  45 : <variables-gadget> ( model -- gadget )
  46     <namestack-display>
  47     <limited-scroller>
  48         { 400 400 } >>min-dim
  49         { 400 400 } >>max-dim ;
  50
  51 : variables ( traceback -- )
  52     model>> <variables-gadget>
  53     "Dynamic variables" open-status-window ;
  54
  55 : traceback-window ( continuation -- )
  56     <model> <traceback-gadget> "Traceback" open-status-window ;