From d6ee5b642499de9b85cfdd3ef530987a61df9a7d Mon Sep 17 00:00:00 2001
From: Braden Shepherdson <Braden.Shepherdson@gmail.com>
Date: Sun, 8 Jun 2008 06:54:57 +0200
Subject: Replaced old "spawn on mod+s" semantics with "spawn/summon or banish
 on mod+s".

Originally the key binding just spawned a new floating terminal on every keypress.
Now it spawns if it doesn't exist, summons from another workspace if it does but
isn't visible, or banishes it to a dynamically created workspace if it is on the
current workspace.

darcs-hash:20080608045457-d53a8-e8bca6a987f7f408c18481d2173dd2f87a8d40fb.gz
---
 XMonad/Util/Scratchpad.hs | 98 +++++++++++++++++++++++++++++++++++++----------
 1 file changed, 77 insertions(+), 21 deletions(-)

diff --git a/XMonad/Util/Scratchpad.hs b/XMonad/Util/Scratchpad.hs
index a7b1ef0..65da63d 100644
--- a/XMonad/Util/Scratchpad.hs
+++ b/XMonad/Util/Scratchpad.hs
@@ -10,6 +10,38 @@
 --
 -- Very handy hotkey-launched floating terminal window.
 --
+-----------------------------------------------------------------------------
+
+module XMonad.Util.Scratchpad (
+  -- * Usage
+  -- $usage
+  scratchpadSpawnAction
+  ,scratchpadSpawnActionTerminal
+  ,scratchpadManageHookDefault
+  ,scratchpadManageHook
+  ) where
+
+import XMonad
+import XMonad.Core
+import XMonad.Hooks.ManageHelpers (doRectFloat)
+import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace)
+
+import Control.Monad (filterM)
+
+import qualified XMonad.StackSet as W
+
+
+-- $usage
+-- Bind a key to 'scratchpadSpawnAction'
+-- Pressing it will spawn the terminal, or bring it to the current
+-- workspace if it already exists.
+-- Pressing the key with the terminal on the current workspace will 
+-- send it to a hidden workspace called @SP@.
+--
+-- If you already have a workspace called @SP@, it will use that.
+-- @SP@ will also appear in xmobar and dzen status bars. You can tweak your
+-- @dynamicLog@ settings to filter it out if you like.
+--
 -- A tool like detach (<http://detach.sourceforge.net>) turns it
 -- into a launchpad for X apps.
 --
@@ -32,32 +64,57 @@
 -- The default rectangle is half the screen wide and a quarter of the
 -- screen tall, centered.
 --
------------------------------------------------------------------------------
-
-module XMonad.Util.Scratchpad (
-  scratchpadSpawnAction
-  ,scratchpadSpawnActionTerminal
-  ,scratchpadManageHookDefault
-  ,scratchpadManageHook
-  ) where
-
-import XMonad
-import XMonad.Core
-import XMonad.Hooks.ManageHelpers (doRectFloat)
-import qualified XMonad.StackSet
 
 
 
 -- | Action to pop up the terminal, for the user to bind to a custom key.
 scratchpadSpawnAction :: XConfig l -- ^ The configuration, to retrieve the terminal
                       -> X ()
-scratchpadSpawnAction conf = spawn $ terminal conf ++ " -title scratchpad"
+scratchpadSpawnAction conf = 
+    scratchpadAction $ spawn $ terminal conf ++ " -title scratchpad"
 
 
 -- | Action to pop up the terminal, with a directly specified terminal.
 scratchpadSpawnActionTerminal :: String -- ^ Name of the terminal program
                                  -> X ()
-scratchpadSpawnActionTerminal term = spawn $ term ++ " -title scratchpad"
+scratchpadSpawnActionTerminal term = 
+    scratchpadAction $ spawn $ term ++ " -title scratchpad"
+
+
+
+
+-- The heart of the new summon/banish terminal. 
+-- The logic is thus:
+-- 1. if the scratchpad is on the current workspace, send it to the hidden one.
+--    - if the scratchpad workspace doesn't exist yet, create it first.
+-- 2. if the scratchpad is elsewhere, bring it here. 
+scratchpadAction :: X () -> X ()
+scratchpadAction action = withWindowSet $ \s -> do
+  filterCurrent <- filterM (runQuery scratchpadQuery) 
+                     ( (maybe [] W.integrate 
+                        . W.stack 
+                        . W.workspace 
+                        . W.current) s)
+  case filterCurrent of
+    (x:_) -> do
+      if null (filter ( (== scratchpadWorkspaceTag) . W.tag) (W.workspaces s))
+         then addHiddenWorkspace scratchpadWorkspaceTag
+         else return ()
+      windows (W.shiftWin scratchpadWorkspaceTag x)
+    []    -> do
+      filterAll <- filterM (runQuery scratchpadQuery) (W.allWindows s)
+      case filterAll of
+        (x:_) -> windows (W.shiftWin (W.currentTag s) x)
+        []    -> action -- run the provided action to spawn it.
+
+
+-- factored out since it appears in several places
+scratchpadWorkspaceTag :: String
+scratchpadWorkspaceTag = "SP"
+
+-- factored out since this is common to both the ManageHook and the action
+scratchpadQuery :: Query Bool
+scratchpadQuery = title =? "scratchpad"
 
 
 -- | The ManageHook, with the default rectangle:
@@ -66,17 +123,16 @@ scratchpadManageHookDefault :: ManageHook
 scratchpadManageHookDefault = scratchpadManageHook scratchpadDefaultRect
 
 
--- | The ManageHook, with a user-specified StackSet.RationalRect.
+-- | The ManageHook, with a user-specified StackSet.RationalRect,
 -- eg.
 --
 -- > scratchpadManageHook (W.RationalRect 0.25 0.375 0.5 0.25)
---
-scratchpadManageHook :: XMonad.StackSet.RationalRect -- ^ User-specified screen rectangle.
+scratchpadManageHook :: W.RationalRect -- ^ User-specified screen rectangle.
                      -> ManageHook
-scratchpadManageHook rect = title =? "scratchpad" --> doRectFloat rect
+scratchpadManageHook rect = scratchpadQuery --> doRectFloat rect
 
 
-scratchpadDefaultRect :: XMonad.StackSet.RationalRect
-scratchpadDefaultRect = XMonad.StackSet.RationalRect 0.25 0.375 0.5 0.25
+scratchpadDefaultRect :: W.RationalRect
+scratchpadDefaultRect = W.RationalRect 0.25 0.375 0.5 0.25
 
 
-- 
cgit v1.2.3