Fix hang when clicking presentations in the walker; improve traceback widget

extra/concurrency/flags/flags-docs.factor

@@ -14,6 +14,10 @@ HELP: raise-flag
 { $values { "flag" flag } }
 { $description "Raises a flag, notifying any threads waiting on it. Does nothing if the flag has already been raised." } ;
 
+HELP: wait-for-flag
+{ $values { "flag" flag } }
+{ $description "Waits for a flag to be raised. If the flag has already been raised, returns immediately." } ;
+
 HELP: lower-flag
 { $values { "flag" flag } }
 { $description "Attempts to lower a flag. If the flag has been raised previously, returns immediately, otherwise waits for it to be raised first." } ;
@@ -26,8 +30,9 @@ $nl
 "Essentially, a flag can be thought of as a counting semaphore where the count never goes above one."
 { $subsection flag }
 { $subsection flag? }
-"Raising and lowering flags:"
+"Waiting for a flag to be raised:"
 { $subsection raise-flag }
+{ $subsection wait-for-flag }
 { $subsection lower-flag } ;
 
 ABOUT: "concurrency.flags"

extra/concurrency/flags/flags.factor

@@ -13,9 +13,14 @@ TUPLE: flag value? thread ;
         [ resume ] [ drop t over set-flag-value? ] if
     ] unless drop ;
 
+: wait-for-flag ( flag -- )
+    dup flag-value? [ drop ] [
+        [ flag-thread >box ] curry "flag" suspend drop
+    ] if ;
+
 : lower-flag ( flag -- )
     dup flag-value? [
         f swap set-flag-value?
     ] [
-        [ flag-thread >box ] curry "flag" suspend drop
+        wait-for-flag
     ] if ;

extra/ui/tools/interactor/interactor.factor

@@ -1,18 +1,15 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs combinators continuations documents
-ui.tools.workspace hashtables io io.styles kernel math
+ hashtables io io.styles kernel math
 math.vectors models namespaces parser prettyprint quotations
 sequences sequences.lib strings threads listener
 tuples ui.commands ui.gadgets ui.gadgets.editors
 ui.gadgets.presentations ui.gadgets.worlds ui.gestures
-definitions boxes calendar ;
+definitions boxes calendar concurrency.flags ui.tools.workspace ;
 IN: ui.tools.interactor
 
-TUPLE: interactor
+TUPLE: interactor history output flag thread help ;
-history output
-thread quot
-help ;
 
 : interactor-continuation ( interactor -- continuation )
     interactor-thread box-value
@@ -35,12 +32,16 @@ help ;
 : init-interactor-history ( interactor -- )
     V{ } clone swap set-interactor-history ;
 
+: init-interactor-state ( interactor -- )
+    <flag> over set-interactor-flag
+    <box> swap set-interactor-thread ;
+
 : <interactor> ( output -- gadget )
     <source-editor>
     interactor construct-editor
     tuck set-interactor-output
-    <box> over set-interactor-thread
     dup init-interactor-history
+    dup init-interactor-state
     dup init-caret-help ;
 
 M: interactor graft*
@@ -97,7 +98,10 @@ M: interactor model-changed
     ] unless drop ;
 
 : interactor-yield ( interactor -- obj )
-    [ interactor-thread >box ] curry "input" suspend ;
+    [
+        [ interactor-thread >box ] keep
+        interactor-flag raise-flag
+    ] curry "input" suspend ;
 
 M: interactor stream-readln
     [ interactor-yield ] keep interactor-finish ?first ;

extra/ui/tools/listener/listener.factor

@@ -6,7 +6,7 @@ kernel models namespaces parser quotations sequences ui.commands
 ui.gadgets ui.gadgets.editors ui.gadgets.labelled
 ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers
 ui.gadgets.tracks ui.gestures ui.operations vocabs words
-prettyprint listener debugger threads boxes ;
+prettyprint listener debugger threads boxes concurrency.flags ;
 IN: ui.tools.listener
 
 TUPLE: listener-gadget input output stack ;
@@ -131,10 +131,18 @@ M: stack-display tool-scroller
         listener
     ] with-stream* ;
 
+: start-listener-thread ( listener -- )
+    [ listener-thread ] curry "Listener" spawn drop ;
+
+: wait-for-listener ( listener -- )
+    #! Wait for the listener to start.
+    listener-gadget-input interactor-flag wait-for-flag ;
+
 : restart-listener ( listener -- )
+    #! Returns when listener is ready to receive input.
     dup com-end dup clear-output
-    [ listener-thread ] curry
+    dup start-listener-thread
-    "Listener" spawn drop ;
+    wait-for-listener ;
 
 : init-listener ( listener -- )
     f <model> swap set-listener-gadget-stack ;

extra/ui/tools/tools.factor

@@ -83,5 +83,7 @@ workspace "workflow" f {
 } define-command-map
 
 [
-    <workspace> "Factor workspace" open-status-window
+    <workspace>
+    dup "Factor workspace" open-status-window
+    workspace-listener wait-for-listener
 ] workspace-window-hook set-global

extra/ui/tools/traceback/traceback.factor

@@ -1,8 +1,10 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 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 assocs
-ui.gadgets.tracks ui.gestures sequences hashtables inspector ;
+ui.gadgets.tracks ui.gadgets.buttons ui.gadgets.panes
+ui.gadgets.status-bar ui.gadgets.scrollers
+ui.gestures sequences hashtables inspector ;
 IN: ui.tools.traceback
 
 : <callstack-display> ( model -- gadget )
@@ -17,10 +19,6 @@ IN: ui.tools.traceback
     [ [ continuation-retain stack. ] when* ]
     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 { 550 600 } ;
@@ -31,11 +29,32 @@ M: traceback-gadget pref-dim* drop { 550 600 } ;
             [
                 g gadget-model <datastack-display> 1/2 track,
                 g gadget-model <retainstack-display> 1/2 track,
-            ] { 1 0 } make-track 1/5 track,
+            ] { 1 0 } make-track 1/3 track,
-            g gadget-model <callstack-display> 2/5 track,
+            g gadget-model <callstack-display> 2/3 track,
-            g gadget-model <namestack-display> 2/5 track,
+            toolbar,
         ] with-gadget
     ] keep ;
 
+: <namestack-display> ( model -- gadget )
+    [ [ continuation-name namestack. ] when* ]
+    <pane-control> ;
+
+TUPLE: variables-gadget ;
+
+: <variables-gadget> ( model -- gadget )
+    <namestack-display> <scroller>
+    variables-gadget construct-empty
+    [ set-gadget-delegate ] keep ;
+
+M: variables-gadget pref-dim* drop { 400 400 } ;
+
+: variables ( traceback -- )
+    gadget-model <variables-gadget>
+    "Dynamic variables" open-status-window ;
+
 : traceback-window ( continuation -- )
     <model> <traceback-gadget> "Traceback" open-window ;
+
+traceback-gadget "toolbar" f {
+    { T{ key-down f f "v" } variables }
+} define-command-map

extra/ui/tools/walker/walker-docs.factor

@@ -7,5 +7,4 @@ ARTICLE: "ui-walker" "UI walker"
 $nl
 "The walker can travel backwards through time, and restore stacks. This does not undo side effects and therefore can only be used reliably on referentially transparent code."
 { $command-map walker-gadget "toolbar" }
-{ $command-map walker-gadget "other" }
 "Walkers are instances of " { $link walker-gadget } "." ;

extra/ui/tools/walker/walker.factor

@@ -26,10 +26,6 @@ TUPLE: walker-gadget status continuation thread ;
 
 : com-abandon ( walker -- ) abandon walker-command ;
 
-: com-inspect ( walker -- )
-    walker-continuation model-value
-    [ inspect ] curry call-listener ;
-
 M: walker-gadget ungraft*
     dup delegate ungraft* detach walker-command ;
 
@@ -69,12 +65,8 @@ walker-gadget "toolbar" f {
     { T{ key-down f f "b" } com-back }
     { T{ key-down f f "c" } com-continue }
     { T{ key-down f f "a" } com-abandon }
-    { T{ key-down f f "F1" } walker-help }
-} define-command-map
-
-walker-gadget "other" f {
-    { T{ key-down f f "n" } com-inspect }
     { T{ key-down f f "d" } close-window }
+    { T{ key-down f f "F1" } walker-help }
 } define-command-map
 
 : walker-window ( -- )