diff --git a/CHANGES.md b/CHANGES.md index c7f5975a59..7a4873d50d 100644 --- a/CHANGES.md +++ b/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` diff --git a/XMonad/Util/NamedScratchpad.hs b/XMonad/Util/NamedScratchpad.hs index 61a533827b..c49caa7fbc 100644 --- a/XMonad/Util/NamedScratchpad.hs +++ b/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,19 +285,58 @@ 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 = - -- 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. - lastFocus `elem` W.index winSet && lastFocus /= curFocus - -- Don't do anything on the NSP workspace, lest the world explodes. - && cur /= scratchpadWorkspaceTag + 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. + lastFocus `elem` W.index winSet && lastFocus /= curFocus + -- 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. --