Listener doesn't print a garbage quotation when commands are invoked

diff --git a/basis/ui/backend/cocoa/tools/tools.factor b/basis/ui/backend/cocoa/tools/tools.factor
index d3d2233958ee7893ea1405e9dad5d493ada2db09..02b2f0a4dead70d40a4358c4f48622b41f4ec15d 100644 (file)
--- a/basis/ui/backend/cocoa/tools/tools.factor
+++ b/basis/ui/backend/cocoa/tools/tools.factor
@@ -57,7 +57,7 @@ CLASS: {
 }
 
 { "refreshAll:" "id" { "id" "SEL" "id" }
-    [ 3drop [ refresh-all ] call-listener f ]
+    [ 3drop [ refresh-all ] \ refresh-all call-listener f ]
 } ;
 
 : install-app-delegate ( -- )

diff --git a/basis/ui/tools/deploy/deploy.factor b/basis/ui/tools/deploy/deploy.factor
index 9a84dc5b75816548e594dfd3caafbca51f980012..bedd5aded2e8fc434a6d8cd7254811dadac99abd 100644 (file)
--- a/basis/ui/tools/deploy/deploy.factor
+++ b/basis/ui/tools/deploy/deploy.factor
@@ -77,9 +77,10 @@ TUPLE: deploy-gadget < pack vocab settings ;
     swap find-deploy-vocab set-deploy-config ;
 
 : com-deploy ( gadget -- )
-    dup com-save
-    dup find-deploy-vocab '[ _ deploy ] call-listener
-    close-window ;
+    [ com-save ]
+    [ find-deploy-vocab '[ _ deploy ] \ deploy call-listener ]
+    [ close-window ]
+    tri ;
 
 : com-help ( -- )
     "ui.tools.deploy" com-follow ;

diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor
index 929d6035f5b3058be59732bca62896f432acfd2e..36b92055c2c1e88cee1a46fcecf238cb8ce0aeae 100644 (file)
--- a/basis/ui/tools/listener/listener.factor
+++ b/basis/ui/tools/listener/listener.factor
@@ -90,8 +90,8 @@ M: input (print-input)
     dup presented associate
     [ string>> H{ { font-style bold } } format ] with-nesting nl ;
 
-M: object (print-input)
-    short. ;
+M: word (print-input)
+    "Command: " write . ;
 
 : print-input ( object interactor -- )
     output>> [ (print-input) ] with-output-stream* ;
@@ -131,9 +131,11 @@ M: object (print-input)
 M: interactor stream-readln
     interactor-read dup [ first ] when ;
 
-: interactor-call ( quot interactor -- )
-    dup interactor-busy? [ 2drop ] [
-        [ print-input ] [ interactor-continue ] 2bi
+: (call-listener) ( quot command listener -- )
+    input>> dup interactor-busy? [ 3drop ] [
+        [ print-input drop ]
+        [ nip interactor-continue ]
+        3bi
     ] if ;
 
 M: interactor stream-read
@@ -237,19 +239,16 @@ M: string listener-input
     get-listener input>>
     [ set-editor-string ] [ request-focus ] bi ;
 
-: (call-listener) ( quot listener -- )
-    input>> interactor-call ;
-
-: call-listener ( quot -- )
+: call-listener ( quot command -- )
     get-ready-listener
-    '[ _ _ dup wait-for-listener (call-listener) ]
+    '[ _ _ _ dup wait-for-listener (call-listener) ]
     "Listener call" spawn drop ;
 
 M: listener-command invoke-command ( target command -- )
-    command-quot call-listener ;
+    [ command-quot ] [ nip ] 2bi call-listener ;
 
 M: listener-operation invoke-command ( target command -- )
-    operation-quot call-listener ;
+    [ operation-quot ] [ nip command>> ] 2bi call-listener ;
 
 : eval-listener ( string -- )
     get-listener input>> [ set-editor-string ] keep
@@ -257,6 +256,7 @@ M: listener-operation invoke-command ( target command -- )
 
 : listener-run-files ( seq -- )
     [
+        [ \ listener-run-files ] dip
         '[ _ [ run-file ] each ] call-listener
     ] unless-empty ;
 
@@ -269,7 +269,7 @@ M: listener-operation invoke-command ( target command -- )
 \ clear-output H{ { +listener+ t } } define-command
 
 : clear-stack ( listener -- )
-    [ clear ] swap (call-listener) ;
+    [ [ clear ] \ clear ] dip (call-listener) ;
 
 : use-if-necessary ( word seq -- )
     2dup [ vocabulary>> ] dip and [

diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor
index 56c9b15c24ea08a601da341118831dba78f87c52..c445954771257ade1fe23c46a29da12706333653 100644 (file)
--- a/basis/ui/ui.factor
+++ b/basis/ui/ui.factor
@@ -95,7 +95,12 @@ M: world ungraft*
     children>> [ restore-gadget ] each ;
 
 : restore-world ( world -- )
-    [ reset-world ] [ init-text-rendering ] [ restore-gadget ] tri ;
+    {
+        [ reset-world ]
+        [ init-text-rendering ]
+        [ f >>images drop ]
+        [ restore-gadget ]
+    } cleave ;
 
 : update-hand ( world -- )
     dup hand-world get-global eq?