More walker work

extra/tools/walker/debug/debug.factor

@@ -2,15 +2,22 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: concurrency.promises models tools.walker kernel
 sequences concurrency.messaging locals continuations
-threads ;
+threads namespaces namespaces.private ;
 IN: tools.walker.debug
 
 :: test-walker | quot |
     [let | p [ <promise> ]
            s [ f <model> ]
            c [ f <model> ] |
-        [ s c start-walker-thread p fulfill break ]
-        quot compose "Walker test" spawn drop
+        [
+            H{ } clone >n
+            [ s c start-walker-thread p fulfill ] new-walker-hook set
+            [ drop ] show-walker-hook set
+
+            break
+            
+            quot call
+        ] "Walker test" spawn drop
 
         step-into-all
         p ?promise

extra/tools/walker/walker-tests.factor

@@ -97,10 +97,6 @@ IN: temporary
 [ { 6 } ]
 [ [ [ 3 throw ] [ 2 * ] recover ] test-walker ] unit-test
 
-[ { "{ 1 2 3 }\n" } ] [
-    [ [ { 1 2 3 } . ] with-string-writer ] test-walker
-] unit-test
-
 [ { } ] [
     [ "a" "b" set "c" "d" set [ ] test-walker ] with-scope
 ] unit-test

extra/tools/walker/walker.factor

@@ -6,8 +6,8 @@ concurrency.messaging quotations kernel.private words
 sequences.private assocs models ;
 IN: tools.walker
 
-SYMBOL: new-walker-hook
-SYMBOL: show-walker-hook
+SYMBOL: new-walker-hook ! ( -- )
+SYMBOL: show-walker-hook ! ( thread -- )
 
 ! Thread local
 SYMBOL: walker-thread
@@ -169,16 +169,19 @@ SYMBOL: +detached+
     [ status +running+ eq? ] [
         [
             {
-                { detach [ detach-msg ] }
-                { step [ ] }
-                { step-out [ ] }
-                { step-into [ ] }
-                { step-all [ ] }
-                { step-into-all [ ] }
-                { step-back [ ] }
-                { f [ walker-stopped ] }
-                [ step-into-msg ]
-            } case f
+                { detach [ detach-msg f ] }
+                { step [ f ] }
+                { step-out [ f ] }
+                { step-into [ f ] }
+                { step-all [ f ] }
+                { step-into-all [ f ] }
+                { step-back [ f ] }
+                { f [ +stopped+ set-status f ] }
+                [
+                    dup walker-continuation tget set-model
+                    step-into-msg
+                ]
+            } case
         ] handle-synchronous
     ] [ ] while ;
 

extra/ui/gadgets/labelled/labelled-docs.factor

@@ -18,7 +18,7 @@ HELP: <closable-gadget>
 { $notes "The quotation can find the " { $link closable-gadget } " instance, or any other parent gadget by calling " { $link find-parent } " with the gadget it receives on the stack." } ;
 
 HELP: <labelled-pane>
-{ $values { "model" model } { "quot" "a quotation with stack effect " { $snippet "( value -- )" } } { "title" string } { "gadget" "a new " { $link gadget } } }
+{ $values { "model" model } { "quot" "a quotation with stack effect " { $snippet "( value -- )" } } { "scrolls?" "a boolean" } { "title" string } { "gadget" "a new " { $link gadget } } }
 { $description "Creates a new control delegating to a " { $link pane } ", and wraps it in a " { $link labelled-gadget } ". When the value of the model changes, the value is pushed on the stack and the quotation is called using " { $link with-pane } "." } ;
 
 { <labelled-pane> <pane-control> } related-words

extra/ui/gadgets/labelled/labelled.factor

@@ -21,8 +21,8 @@ M: labelled-gadget focusable-child* labelled-gadget-content ;
 : <labelled-scroller> ( gadget title -- gadget )
     >r <scroller> r> <labelled-gadget> ;
 
-: <labelled-pane> ( model quot title -- gadget )
-    >r <pane-control> t over set-pane-scrolls? r>
+: <labelled-pane> ( model quot scrolls? title -- gadget )
+    >r >r <pane-control> r> over set-pane-scrolls? r>
     <labelled-scroller> ;
 
 : <close-box> ( quot -- button/f )

extra/ui/tools/listener/listener.factor

@@ -106,7 +106,7 @@ TUPLE: stack-display ;
     g workspace-listener swap [
         dup <toolbar> f track,
         listener-gadget-stack [ stack. ]
-        "Data stack" <labelled-pane> 1 track,
+        t "Data stack" <labelled-pane> 1 track,
     ] { 0 1 } build-track ;
 
 M: stack-display tool-scroller

extra/ui/tools/traceback/traceback.factor

@@ -1,25 +1,29 @@
 ! Copyright (C) 2006, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: continuations kernel models namespaces prettyprint ui
-ui.commands ui.gadgets ui.gadgets.labelled
-ui.gadgets.tracks ui.gestures ;
+ui.commands ui.gadgets ui.gadgets.labelled assocs
+ui.gadgets.tracks ui.gestures sequences hashtables inspector ;
 IN: ui.tools.traceback
 
 : <callstack-display> ( model -- gadget )
     [ [ continuation-call callstack. ] when* ]
-    "Call stack" <labelled-pane> ;
+    t "Call stack" <labelled-pane> ;
 
 : <datastack-display> ( model -- gadget )
     [ [ continuation-data stack. ] when* ]
-    "Data stack" <labelled-pane> ;
+    t "Data stack" <labelled-pane> ;
 
 : <retainstack-display> ( model -- gadget )
     [ [ continuation-retain stack. ] when* ]
-    "Retain stack" <labelled-pane> ;
+    t "Retain stack" <labelled-pane> ;
+
+: <namestack-display> ( model -- gadget )
+    [ [ continuation-name namestack. ] when* ]
+    f "Dynamic variables" <labelled-pane> ;
 
 TUPLE: traceback-gadget ;
 
-M: traceback-gadget pref-dim* drop { 300 400 } ;
+M: traceback-gadget pref-dim* drop { 550 600 } ;
 
 : <traceback-gadget> ( model -- gadget )
     { 0 1 } <track> traceback-gadget construct-control [
@@ -27,8 +31,9 @@ M: traceback-gadget pref-dim* drop { 300 400 } ;
             [
                 g gadget-model <datastack-display> 1/2 track,
                 g gadget-model <retainstack-display> 1/2 track,
-            ] { 1 0 } make-track 1/3 track,
-            g gadget-model <callstack-display> 2/3 track,
+            ] { 1 0 } make-track 1/5 track,
+            g gadget-model <callstack-display> 2/5 track,
+            g gadget-model <namestack-display> 2/5 track,
         ] with-gadget
     ] keep ;