Better handling of in-listener operations

diff --git a/library/ui/tools/listener.factor b/library/ui/tools/listener.factor
index 62c8c76eac516bcce46245cdf90993ca6b9e9ffd..9413c7ca124d02c88d37e44091e47b1cda073393 100644 (file)
--- a/library/ui/tools/listener.factor
+++ b/library/ui/tools/listener.factor
@@ -76,8 +76,14 @@ M: listener-gadget tool-scroller
 M: listener-gadget tool-help
     drop "ui-listener" ;
 
+: workspace-busy? ( workspace -- ? )
+    listener-gadget swap find-tool nip tool-gadget
+    listener-gadget-input interactor-busy? ;
+
 : find-listener ( -- listener )
-    listener-gadget find-workspace show-tool tool-gadget ;
+    listener-gadget
+    [ workspace-busy? not ] find-workspace*
+    show-tool tool-gadget ;
 
 : (call-listener) ( quot listener -- )
     listener-gadget-input interactor-call ;

diff --git a/library/ui/tools/tools.factor b/library/ui/tools/tools.factor
index 46d65bb1fe07f0f2c82939e4ccd3c450a69da71f..477ed3f3f5d71e861d870fd619bfa797c87ec4fd 100644 (file)
--- a/library/ui/tools/tools.factor
+++ b/library/ui/tools/tools.factor
@@ -32,12 +32,12 @@ TUPLE: tool gadget ;
 
 : select-tool ( workspace class -- ) swap show-tool drop ;
 
-: find-workspace ( -- workspace )
-    [ workspace? ] find-window [
-        dup raise-window world-gadget
-    ] [
-        workspace-window find-workspace
-    ] if* ;
+: find-workspace* ( quot -- workspace )
+    [ dup workspace? [ over call ] [ drop f ] if ] find-window
+    [ nip dup raise-window world-gadget ]
+    [ workspace-window drop find-workspace* ] if* ; inline
+
+: find-workspace ( -- workspace ) [ drop t ] find-workspace* ;
 
 : call-tool ( arg class -- )
     find-workspace show-tool call-tool* ;

diff --git a/library/ui/tools/workspace.factor b/library/ui/tools/workspace.factor
index a7b0a61e808b68097faf6c78a72ebf5470bf58a7..c0d2019f2f3d5f42c63f7ed4613e6ea59062b48c 100644 (file)
--- a/library/ui/tools/workspace.factor
+++ b/library/ui/tools/workspace.factor
@@ -77,7 +77,7 @@ M: workspace pref-dim* delegate pref-dim* { 550 650 } vmax ;
     open-window
     listener-gadget get-tool start-listener ;
 
-: tool-window ( class -- ) workspace-window show-tool drop ;
+: tool-window ( class -- ) workspace-window show-tool 2drop ;
 
 : tool-scroll-up ( workspace -- )
     current-page tool-scroller [ scroll-up-page ] when* ;
@@ -100,9 +100,9 @@ workspace "tool-switch" {
 } define-commands
 
 workspace "tool-window" {
-    { "New listener" T{ key-down f { S+ } "F2" } [ listener-gadget tool-window drop ] }
-    { "New definitions" T{ key-down f { S+ } "F3" } [ browser tool-window drop ] }
-    { "New documentation" T{ key-down f { S+ } "F4" } [ help-gadget tool-window drop ] }
+    { "New listener" T{ key-down f { S+ } "F2" } [ listener-gadget tool-window ] }
+    { "New definitions" T{ key-down f { S+ } "F3" } [ browser tool-window ] }
+    { "New documentation" T{ key-down f { S+ } "F4" } [ help-gadget tool-window ] }
 } define-commands
 
 workspace "workflow" {