interactor-busy? flag added

TODO.FACTOR.txt

@@ -1,10 +1,5 @@
 + 0.84:
 
-+ remaining walker tasks:
-- <input> handled by walker itself
-- ^W in interactor
-- ^I in interactor
-
 - windows native i/o
 - fix contribs: parser-combinators, boids, automata, space-invaders
 - unix i/o: problems with passing f to syscalls
@@ -22,8 +17,6 @@
 - services do not launch if factor not running
 - integrated error documentation
 - roundoff is still not quite right with tracks
-- 'show' doesn't work if invoked from a listener on an object which is
-  itself inspected in the listener
 - fix top level window positioning
 - nasty inference regressions
 - [ [ dup call ] dup call ] infer hangs
@@ -56,6 +49,12 @@
 
 + ui:
 
+- remaining walker tasks:
+  - <input> handled by walker itself
+  - ^W in interactor
+  - ^I in interactor
+  - error handling is still screwy
+  - continuation handling is also screwy
 - add-gadget, model-changed, set-model should compile
 - shortcuts:
   - find a listener

library/threads.factor

@@ -9,7 +9,10 @@ namespaces queues sequences vectors ;
 
 : run-queue ( -- queue ) \ run-queue get-global ;
 
-: schedule-thread ( continuation -- ) run-queue enque ;
+: schedule-thread ( continuation0 -- ) run-queue enque ;
+
+: schedule-thread-with ( obj continuation1 -- )
+    2array schedule-thread ;
 
 : sleep-queue ( -- vec ) \ sleep-queue get-global ;
 
@@ -19,7 +22,9 @@ namespaces queues sequences vectors ;
 : sleep-time ( sorted-queue -- ms )
     dup empty? [ drop 1000 ] [ peek first millis [-] ] if ;
 
-: stop ( -- ) run-queue deque continue ;
+: stop ( -- )
+    run-queue deque dup array?
+    [ first2 continue-with ] [ continue ] if ;
 
 : yield ( -- ) [ schedule-thread stop ] callcc0 ;
 

library/tools/interpreter.factor

@@ -105,7 +105,7 @@ SYMBOL: callframe-end
 : restore-harness ( obj -- )
     dup array? [
         init-meta-interp [ ] (meta-call)
-        [ first2 continue-with ] in-thread drop
+        first2 schedule-thread-with
     ] [
         set-meta-interp
     ] if ;

library/ui/text/interactor.factor

@@ -1,29 +1,36 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-text
-USING: gadgets gadgets-controls gadgets-panes hashtables help io
-kernel namespaces prettyprint styles threads ;
+USING: gadgets gadgets-controls gadgets-panes generic hashtables
+help io kernel namespaces prettyprint styles threads ;
 
-TUPLE: interactor output continuation ;
+TUPLE: interactor output continuation busy? ;
 
 C: interactor ( output -- gadget )
     [ set-interactor-output ] keep
     f <field> over set-gadget-delegate
     dup dup set-control-self ;
 
-: interactor-eval ( string gadget -- )
-    interactor-continuation dup
-    [ [ continue-with ] in-thread ] when 2drop ;
+M: interactor graft* ( interactor -- )
+    f over set-interactor-busy? delegate graft* ;
+
+: interactor-eval ( string interactor -- )
+    t over set-interactor-busy?
+    interactor-continuation schedule-thread-with ;
 
 SYMBOL: structured-input
 
 : interactor-call ( quot gadget -- )
-    dup interactor-output [
-        "Command: " write over short.
-    ] with-stream*
-    >r structured-input set-global
-    "\"structured-input\" \"gadgets-text\" lookup get-global call"
-    r> interactor-eval ;
+    dup interactor-busy? [
+        2drop
+    ] [
+        dup interactor-output [
+            "Command: " write over short.
+        ] with-stream*
+        >r structured-input set-global
+        "\"structured-input\" \"gadgets-text\" lookup get-global call"
+        r> interactor-eval
+    ] if ;
 
 : print-input ( string interactor -- )
     interactor-output [
@@ -33,10 +40,14 @@ SYMBOL: structured-input
         ] with-style
     ] with-stream* ;
 
-: interactor-commit ( gadget -- )
-    dup field-commit
-    over control-model clear-doc
-    swap 2dup print-input interactor-eval ;
+: interactor-commit ( interactor -- )
+    dup interactor-busy? [
+        drop
+    ] [
+        dup field-commit
+        over control-model clear-doc
+        swap 2dup print-input interactor-eval
+    ] if ;
 
 interactor H{
     { T{ key-down f f "RETURN" } [ interactor-commit ] }
@@ -44,5 +55,6 @@ interactor H{
     { T{ key-down f { C+ } "d" } [ f swap interactor-eval ] }
 } set-gestures
 
-M: interactor stream-readln ( pane -- line )
+M: interactor stream-readln ( interactor -- line )
+    f over set-interactor-busy?
     [ over set-interactor-continuation stop ] callcc1 nip ;

library/ui/tools/listener.factor

@@ -62,8 +62,15 @@ M: listener-gadget gadget-title drop "Listener" <model> ;
     listener-gadget-input over quotation?
     [ interactor-call ] [ set-editor-text ] if ;
 
+: listener-available? ( gadget -- ? )
+    dup listener-gadget? [
+        listener-gadget-input interactor-busy? not
+    ] [
+        drop f
+    ] if ;
+
 : listener-tool
-    [ listener-gadget? ]
+    [ listener-available? ]
     [ <listener-gadget> ]
     [ call-listener ] ;