basis/ui/tools/traceback/traceback.factor

   1 ! Copyright (C) 2006, 2009 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.tools.inspector
   7 ui.gestures sequences hashtables inspector ;
   8 IN: ui.tools.traceback
   9
  10 : <callstack-display> ( model -- gadget )
  11     [ [ call>> callstack. ] when* ]
  12     t "Call stack" <labelled-pane> ;
  13
  14 : <datastack-display> ( model -- gadget )
  15     [ [ data>> stack. ] when* ]
  16     t "Data stack" <labelled-pane> ;
  17
  18 : <retainstack-display> ( model -- gadget )
  19     [ [ retain>> stack. ] when* ]
  20     t "Retain stack" <labelled-pane> ;
  21
  22 TUPLE: traceback-gadget < track ;
  23
  24 M: traceback-gadget pref-dim* drop { 550 600 } ;
  25
  26 : <traceback-gadget> ( model -- gadget )
  27     { 0 1 } traceback-gadget new-track
  28         swap >>model
  29
  30     dup model>>
  31         { 1 0 } <track>
  32             over <datastack-display> 1/2 track-add
  33             swap <retainstack-display> 1/2 track-add
  34         1/3 track-add
  35
  36     dup model>> <callstack-display> 2/3 track-add
  37
  38     add-toolbar ;
  39
  40 : <namestack-display> ( model -- gadget )
  41     [ [ name>> namestack. ] when* ]
  42     <pane-control> ;
  43
  44 : <variables-gadget> ( model -- gadget )
  45     <namestack-display>
  46     <limited-scroller>
  47         { 400 400 } >>min-dim
  48         { 400 400 } >>max-dim ;
  49
  50 : variables ( traceback -- )
  51     model>> <variables-gadget>
  52     "Dynamic variables" open-status-window ;
  53
  54 : traceback-window ( continuation -- )
  55     <model> <traceback-gadget> "Traceback" open-status-window ;
  56
  57 : inspect-continuation ( traceback -- )
  58     control-value inspector ;
  59
  60 traceback-gadget "toolbar" f {
  61     { T{ key-down f f "v" } variables }
  62     { T{ key-down f f "n" } inspect-continuation }
  63 } define-command-map