Debugging threads

[factor.git] / extra / ui / tools / listener / listener.factor

diff --git a/extra/ui/tools/listener/listener.factor b/extra/ui/tools/listener/listener.factor
index 484b0008613f931337d83ee5537e1dec4e8795bb..b09732ed2c9f6c19c37514f4620e127ce6d58d93 100755 (executable)
--- a/extra/ui/tools/listener/listener.factor
+++ b/extra/ui/tools/listener/listener.factor
@@ -20,7 +20,7 @@ TUPLE: listener-gadget input output stack ;
     [ input>> ] [ output>> <pane-stream> ] bi ;
 
 : <listener-input> ( listener -- gadget )
-    listener-gadget-output <pane-stream> <interactor> ;
+    output>> <pane-stream> <interactor> ;
 
 : listener-input, ( -- )
     g <listener-input> g-> set-listener-gadget-input
@@ -32,31 +32,29 @@ TUPLE: listener-gadget input output stack ;
    "cookbook" ($link) "." print nl ;
 
 M: listener-gadget focusable-child*
-    listener-gadget-input ;
+    input>> ;
 
 M: listener-gadget call-tool* ( input listener -- )
-    >r input-string r> listener-gadget-input set-editor-string ;
+    >r string>> r> input>> set-editor-string ;
 
 M: listener-gadget tool-scroller
-    listener-gadget-output find-scroller ;
+    output>> find-scroller ;
 
 : wait-for-listener ( listener -- )
     #! Wait for the listener to start.
-    listener-gadget-input interactor-flag wait-for-flag ;
+    input>> flag>> wait-for-flag ;
 
 : workspace-busy? ( workspace -- ? )
-    workspace-listener listener-gadget-input interactor-busy? ;
+    listener>> input>> interactor-busy? ;
 
 : listener-input ( string -- )
-    get-workspace
-    workspace-listener
-    listener-gadget-input set-editor-string ;
+    get-workspace listener>> input>> set-editor-string ;
 
 : (call-listener) ( quot listener -- )
-    listener-gadget-input interactor-call ;
+    input>> interactor-call ;
 
 : call-listener ( quot -- )
-    [ workspace-busy? not ] get-workspace* workspace-listener
+    [ workspace-busy? not ] get-workspace* listener>>
     [ dup wait-for-listener (call-listener) ] 2curry
     "Listener call" spawn drop ;
 
@@ -68,8 +66,7 @@ M: listener-operation invoke-command ( target command -- )
 
 : eval-listener ( string -- )
     get-workspace
-    workspace-listener
-    listener-gadget-input [ set-editor-string ] keep
+    listener>> input>> [ set-editor-string ] keep
     evaluate-input ;
 
 : listener-run-files ( seq -- )
@@ -80,10 +77,10 @@ M: listener-operation invoke-command ( target command -- )
     ] if ;
 
 : com-end ( listener -- )
-    listener-gadget-input interactor-eof ;
+    input>> interactor-eof ;
 
 : clear-output ( listener -- )
-    listener-gadget-output pane-clear ;
+    output>> pane-clear ;
 
 \ clear-output H{ { +listener+ t } } define-command
 
@@ -147,23 +144,26 @@ M: stack-display tool-scroller
 
 : listener-thread ( listener -- )
     dup listener-streams [
-        [
-            [ [ ui-listener-hook ] curry listener-hook set ]
-            [ [ ui-error-hook ] curry error-hook set ]
-            [ [ ui-inspector-hook ] curry inspector-hook set ] tri
-            welcome.
-            listener
-        ] with-input-stream*
-    ] with-output-stream* ;
+        [ [ ui-listener-hook ] curry listener-hook set ]
+        [ [ ui-error-hook ] curry error-hook set ]
+        [ [ ui-inspector-hook ] curry inspector-hook set ] tri
+        welcome.
+        listener
+    ] with-streams* ;
 
 : start-listener-thread ( listener -- )
-    [ listener-thread ] curry "Listener" spawn drop ;
+    [
+        [ input>> register-self ] [ listener-thread ] bi
+    ] curry "Listener" spawn drop ;
 
 : restart-listener ( listener -- )
     #! Returns when listener is ready to receive input.
-    dup com-end dup clear-output
-    dup start-listener-thread
-    wait-for-listener ;
+    {
+        [ com-end ]
+        [ clear-output ]
+        [ start-listener-thread ]
+        [ wait-for-listener ]
+    } cleave ;
 
 : init-listener ( listener -- )
     f <model> swap set-listener-gadget-stack ;
@@ -189,10 +189,7 @@ M: listener-gadget handle-gesture* ( gadget gesture delegate -- ? )
     [ default-gesture-handler ] [ 3drop f ] if ;
 
 M: listener-gadget graft*
-    dup delegate graft*
-    dup listener-gadget-input interactor-thread ?box 2drop
-    restart-listener ;
+    [ delegate graft* ] [ restart-listener ] bi ;
 
 M: listener-gadget ungraft*
-    dup com-end
-    delegate ungraft* ;
+    [ com-end ] [ delegate ungraft* ] bi ;