From 8ffa366c86c972a43d0ce7e5dc6b59754de1c949 Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Sat, 11 Nov 2006 05:43:39 +0000
Subject: [PATCH] Better handling of in-listener operations

---
 library/ui/tools/listener.factor  |  8 +++++++-
 library/ui/tools/tools.factor     | 12 ++++++------
 library/ui/tools/workspace.factor |  8 ++++----
 3 files changed, 17 insertions(+), 11 deletions(-)

diff --git a/library/ui/tools/listener.factor b/library/ui/tools/listener.factor
index 62c8c76eac..9413c7ca12 100644
--- 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 46d65bb1fe..477ed3f3f5 100644
--- 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 a7b0a61e80..c0d2019f2f 100644
--- 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" {