Merge pull request #837 from philib/master

introduce single active scratchpad hook

CHANGES.md

@@ -83,6 +83,11 @@
       ordered lexicographically, as before.  Currently focused window will
       always be the topmost, meaning the last in the list.
 
+  * `XMonad.Util.NamedScratchpad`
+
+    - Added `nsSingleScratchpadPerWorkspace`—a logHook to allow only one
+      active scratchpad per workspace.
+
 ### New Modules
 
   * `XMonad.Layout.CenterMainFluid`

XMonad/Util/NamedScratchpad.hs

@@ -31,6 +31,7 @@ module XMonad.Util.NamedScratchpad (
   allNamedScratchpadAction,
   namedScratchpadManageHook,
   nsHideOnFocusLoss,
+  nsSingleScratchpadPerWorkspace,
 
   -- * Dynamic Scratchpads
   -- $dynamic-scratchpads
@@ -61,7 +62,7 @@ import XMonad.Actions.TagWindows (addTag, delTag)
 import XMonad.Hooks.ManageHelpers (doRectFloat)
 import XMonad.Hooks.RefocusLast (withRecentsIn)
 import XMonad.Hooks.StatusBar.PP (PP, ppSort)
-import XMonad.Prelude (appEndo, filterM, findM, foldl', for_, unless, void, when, (<=<))
+import XMonad.Prelude (appEndo, filterM, findM, foldl', for_, liftA2, unless, void, when, (<=<))
 
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict    as Map
@@ -284,10 +285,50 @@ allNamedScratchpadAction = someNamedScratchpadAction mapM_ runApplication
 -- >               -- enable hiding for all of @myScratchpads@
 -- >   }
 nsHideOnFocusLoss :: NamedScratchpads -> X ()
-nsHideOnFocusLoss scratches = withWindowSet $ \winSet -> do
+nsHideOnFocusLoss scratches =
+    nsHideOnCondition $ \ lastFocus _curFoc _ws hideScratch ->
+        whenX (isNSP lastFocus scratches) $
+            hideScratch lastFocus
+
+-- | A @logHook@ to have only one active scratchpad on a workspace. This can
+-- be useful when working with multiple floating scratchpads which would
+-- otherwise be stacked. Note that this also requires you to use the
+-- 'XMonad.Hooks.RefocusLast.refocusLastLogHook'.
+--
+-- ==== __Example__
+--
+-- > import XMonad.Hooks.RefocusLast (refocusLastLogHook)
+-- > import XMonad.Util.NamedScratchpad
+-- >
+-- > main = xmonad $ def
+-- >   { logHook = refocusLastLogHook
+-- >            >> nsHideOnNewScratchpad myScratchpads
+-- >               -- enable hiding for all of @myScratchpads@
+-- >   }
+nsSingleScratchpadPerWorkspace :: NamedScratchpads -> X ()
+nsSingleScratchpadPerWorkspace scratches =
+    nsHideOnCondition $ \ _lastFocus curFocus winSet hideScratch -> do
+        allScratchesButCurrent <-
+            filterM (liftA2 (<||>) (pure . (/= curFocus)) (`isNSP` scratches))
+                    (W.index winSet)
+        whenX (isNSP curFocus scratches) $
+            for_ allScratchesButCurrent hideScratch
+
+-- | Hide scratchpads according to some condition. See 'nsHideOnFocusLoss' and
+-- 'nsSingleScratchpadPerWorkspace' for usage examples.
+nsHideOnCondition
+    :: (  Window           -- Last focus.
+       -> Window           -- Current focus.
+       -> WindowSet        -- Current windowset.
+       -> (Window -> X ()) -- A function to hide the named scratchpad.
+       -> X ())
+    -> X ()
+nsHideOnCondition cond = withWindowSet $ \winSet -> do
     let cur = W.currentTag winSet
     withRecentsIn cur () $ \lastFocus curFocus -> do
-        let isWorthy =
+        let hideScratch :: Window -> X ()
+            hideScratch win = shiftToNSP (W.workspaces winSet) ($ win)
+            isWorthy =
                 -- Check for the window being on the current workspace; if there
                 -- is no history (i.e., curFocus ≡ lastFocus), don't do anything
                 -- because the potential scratchpad is definitely focused.
@@ -295,8 +336,7 @@ nsHideOnFocusLoss scratches = withWindowSet $ \winSet -> do
                 -- Don't do anything on the NSP workspace, lest the world explodes.
                 && cur /= scratchpadWorkspaceTag
         when isWorthy $
-            whenX (isNSP lastFocus scratches) $
-                shiftToNSP (W.workspaces winSet) ($ lastFocus)
+            cond lastFocus curFocus winSet hideScratch
 
 -- | Execute some action on a named scratchpad.
 --