{-# LANGUAGE InstanceSigs   #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns   #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.NamedScratchpad
-- Description :  Toggle arbitrary windows to and from the current workspace.
-- Copyright   :  (c) Konstantin Sobolev <konstantin.sobolev@gmail.com>
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Konstantin Sobolev <konstantin.sobolev@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Named scratchpads that support several arbitrary applications at the same time.
--
-----------------------------------------------------------------------------

module XMonad.Util.NamedScratchpad (
  -- * Usage
  -- $usage
  NamedScratchpad(..),
  scratchpadWorkspaceTag,
  nonFloating,
  defaultFloating,
  customFloating,
  NamedScratchpads,
  namedScratchpadAction,
  spawnHereNamedScratchpadAction,
  customRunNamedScratchpadAction,
  allNamedScratchpadAction,
  namedScratchpadManageHook,
  nsHideOnFocusLoss,
  nsSingleScratchpadPerWorkspace,

  -- * Dynamic Scratchpads
  -- $dynamic-scratchpads
  dynamicNSPAction,
  toggleDynamicNSP,

  -- * Exclusive Scratchpads
  -- $exclusive-scratchpads
  addExclusives,
  -- ** Keyboard related
  resetFocusedNSP,
  -- ** Mouse related
  setNoexclusive,
  resizeNoexclusive,
  floatMoveNoexclusive,

  -- * Deprecations
  namedScratchpadFilterOutWorkspace,
  namedScratchpadFilterOutWorkspacePP,

  ) where

import Data.Map.Strict (Map, (!?))
import XMonad
import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace)
import XMonad.Actions.SpawnOn (spawnHere)
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_, liftA2, unless, void, when, (<=<))

import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict    as Map

import qualified XMonad.StackSet             as W
import qualified XMonad.Util.ExtensibleState as XS

-- $usage
-- Allows to have several floating scratchpads running different applications.
-- Bind a key to 'namedScratchpadAction'.
-- Pressing it will spawn configured application, or bring it to the current
-- workspace if it already exists.
-- Pressing the key with the application on the current workspace will
-- send it to a hidden workspace called @NSP@.
--
-- If you already have a workspace called @NSP@, it will use that.
-- @NSP@ will also appear in xmobar and dzen status bars. You can tweak your
-- @dynamicLog@ settings to filter it out if you like.
--
-- Create named scratchpads configuration in your xmonad.hs like this:
--
-- > import XMonad.StackSet as W
-- > import XMonad.ManageHook
-- > import XMonad.Util.NamedScratchpad
-- >
-- > scratchpads = [
-- > -- run htop in xterm, find it by title, use default floating window placement
-- >     NS "htop" "xterm -e htop" (title =? "htop") defaultFloating ,
-- >
-- > -- run stardict, find it by class name, place it in the floating window
-- > -- 1/6 of screen width from the left, 1/6 of screen height
-- > -- from the top, 2/3 of screen width by 2/3 of screen height
-- >     NS "stardict" "stardict" (className =? "Stardict")
-- >         (customFloating $ W.RationalRect (1/6) (1/6) (2/3) (2/3)) ,
-- >
-- > -- run gvim, find by role, don't float
-- >     NS "notes" "gvim --role notes ~/notes.txt" (role =? "notes") nonFloating
-- > ] where role = stringProperty "WM_WINDOW_ROLE"
--
-- Add keybindings:
--
-- >  , ((modm .|. controlMask .|. shiftMask, xK_t), namedScratchpadAction scratchpads "htop")
-- >  , ((modm .|. controlMask .|. shiftMask, xK_s), namedScratchpadAction scratchpads "stardict")
-- >  , ((modm .|. controlMask .|. shiftMask, xK_n), namedScratchpadAction scratchpads "notes")
--
-- ... and a manage hook:
--
-- >  , manageHook = namedScratchpadManageHook scratchpads
--
-- For detailed instruction on editing the key binding see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>
--
-- For some applications (like displaying your workspaces in a status bar) it
-- is convenient to filter out the @NSP@ workspace when looking at all
-- workspaces. For this, you can use 'XMonad.Hooks.StatusBar.PP.filterOutWsPP',
-- or 'XMonad.Util.WorkspaceCompare.filterOutWs' together with
-- 'XMonad.Hooks.EwmhDesktops.addEwmhWorkspaceSort' if your status bar gets
-- the list of workspaces from EWMH.  See the documentation of these functions
-- for examples.
--
-- If you want to explore this module further, scratchpads can come in
-- many forms and flavours:
--
--   + \"Regular\" scratchpads: they can be predefined and
--     summoned/banished with a key press.  These are the scratchpads
--     that you have seen above.
--
--   + [Dynamic scratchpads](#g:dynamic-scratchpads), which allow you to
--     dynamically declare existing windows as scratchpads.  These can
--     be treated as a separate type of scratchpad.
--
--   + [Exclusive](#g:exclusive-scratchpads) scratchpads, which can be
--     seen as a property of already existing scratchpads.  Marking
--     scratchpads as exclusive will not allow them to be shown on the
--     same workspace; the scratchpad being brought up will hide the
--     others.
--
-- See the relevant sections in the documentation for more information.
--
-- Further, there is also a @logHook@ that you can use to hide
-- scratchpads when they lose focus; this is functionality akin to what
-- some dropdown terminals provide.  See the documentation of
-- 'nsHideOnFocusLoss' for an example how to set this up.
--

-- | Single named scratchpad configuration
data NamedScratchpad = NS { NamedScratchpad -> String
name   :: String      -- ^ Scratchpad name
                          , NamedScratchpad -> String
cmd    :: String      -- ^ Command used to run application
                          , NamedScratchpad -> Query Bool
query  :: Query Bool  -- ^ Query to find already running application
                          , NamedScratchpad -> ManageHook
hook   :: ManageHook  -- ^ Manage hook called for application window, use it to define the placement. See @nonFloating@, @defaultFloating@ and @customFloating@
                          }

-- | The NSP state.
data NSPState = NSPState
  { NSPState -> Map String NamedScratchpads
nspExclusives  :: !(Map String NamedScratchpads)
    -- ^ Associates the name of a scratchpad to some list of scratchpads
    -- that should be mutually exclusive to it.
  , NSPState -> Map String NamedScratchpad
nspScratchpads :: !(Map String NamedScratchpad)
    -- ^ Associates a name to an entire scratchpad.
  }

instance ExtensionClass NSPState where
  initialValue :: NSPState
  initialValue :: NSPState
initialValue = Map String NamedScratchpads
-> Map String NamedScratchpad -> NSPState
NSPState Map String NamedScratchpads
forall a. Monoid a => a
mempty Map String NamedScratchpad
forall a. Monoid a => a
mempty

-- | Try to:
--
--    (i) Fill the 'nspScratchpads' portion of the 'NSPState' with the
--        given list of scratchpads.  In case that particular map of the
--        state is already non-empty, don't do anything and return that
--        state.
--
--   (ii) Replace possibly dummy scratchpads in @nspExclusives@ with
--        proper values.  For convenience, the user may specify
--        exclusive scratchpads by name in the startup hook.  However,
--        we don't necessarily have all information then to immediately
--        turn these into proper NamedScratchpads.  As such, we thinly
--        wrap the names into an NSP skeleton, to be filled in later.
--        This function, to be executed _before_
--        'someNamedScratchpadAction' is the (latest) point where that
--        happens.
fillNSPState :: NamedScratchpads -> X NSPState
fillNSPState :: NamedScratchpads -> X NSPState
fillNSPState NamedScratchpads
nsps = do
    nsp :: NSPState
nsp@(NSPState Map String NamedScratchpads
exs Map String NamedScratchpad
scratches) <- X NSPState
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
    if Map String NamedScratchpad -> Bool
forall a. Map String a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map String NamedScratchpad
scratches
      then let nspState :: NSPState
nspState = Map String NamedScratchpads
-> Map String NamedScratchpad -> NSPState
NSPState (Map String NamedScratchpads -> Map String NamedScratchpads
fillOut Map String NamedScratchpads
exs) Map String NamedScratchpad
nspScratches
            in NSPState
nspState NSPState -> X () -> X NSPState
forall a b. a -> X b -> X a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ NSPState -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put NSPState
nspState
      else NSPState -> X NSPState
forall a. a -> X a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NSPState
nsp
  where
    -- @fillNSPState@ only runs once, so the complexity here is probably
    -- not a big deal.
    nspScratches :: Map String NamedScratchpad
    nspScratches :: Map String NamedScratchpad
nspScratches = [(String, NamedScratchpad)] -> Map String NamedScratchpad
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, NamedScratchpad)] -> Map String NamedScratchpad)
-> [(String, NamedScratchpad)] -> Map String NamedScratchpad
forall a b. (a -> b) -> a -> b
$ [String] -> NamedScratchpads -> [(String, NamedScratchpad)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((NamedScratchpad -> String) -> NamedScratchpads -> [String]
forall a b. (a -> b) -> [a] -> [b]
map NamedScratchpad -> String
name NamedScratchpads
nsps) NamedScratchpads
nsps
    fillOut :: Map String [NamedScratchpad] -> Map String [NamedScratchpad]
    fillOut :: Map String NamedScratchpads -> Map String NamedScratchpads
fillOut Map String NamedScratchpads
exs = (Map String NamedScratchpads
 -> NamedScratchpad -> Map String NamedScratchpads)
-> Map String NamedScratchpads
-> NamedScratchpads
-> Map String NamedScratchpads
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map String NamedScratchpads
nspMap NamedScratchpad
n -> (NamedScratchpads -> NamedScratchpads)
-> Map String NamedScratchpads -> Map String NamedScratchpads
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (NamedScratchpad -> NamedScratchpads -> NamedScratchpads
replaceWith NamedScratchpad
n) Map String NamedScratchpads
nspMap) Map String NamedScratchpads
exs NamedScratchpads
nsps
    replaceWith :: NamedScratchpad -> [NamedScratchpad] -> [NamedScratchpad]
    replaceWith :: NamedScratchpad -> NamedScratchpads -> NamedScratchpads
replaceWith NamedScratchpad
n = (NamedScratchpad -> NamedScratchpad)
-> NamedScratchpads -> NamedScratchpads
forall a b. (a -> b) -> [a] -> [b]
map (\NamedScratchpad
x -> if NamedScratchpad -> String
name NamedScratchpad
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== NamedScratchpad -> String
name NamedScratchpad
n then NamedScratchpad
n else NamedScratchpad
x)

-- | Manage hook that makes the window non-floating
nonFloating :: ManageHook
nonFloating :: ManageHook
nonFloating = ManageHook
forall a. Monoid a => a
idHook

-- | Manage hook that makes the window floating with the default placement
defaultFloating :: ManageHook
defaultFloating :: ManageHook
defaultFloating = ManageHook
doFloat

-- | Manage hook that makes the window floating with custom placement
customFloating :: W.RationalRect -> ManageHook
customFloating :: RationalRect -> ManageHook
customFloating = RationalRect -> ManageHook
doRectFloat

-- | @isNSP win nsps@ checks whether the window @win@ is any scratchpad
-- in @nsps@.
isNSP :: Window -> NamedScratchpads -> X Bool
isNSP :: Window -> NamedScratchpads -> X Bool
isNSP Window
w = ([Bool] -> Bool) -> X [Bool] -> X Bool
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (X [Bool] -> X Bool)
-> (NamedScratchpads -> X [Bool]) -> NamedScratchpads -> X Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NamedScratchpad -> X Bool) -> NamedScratchpads -> X [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
`runQuery` Window
w) (Query Bool -> X Bool)
-> (NamedScratchpad -> Query Bool) -> NamedScratchpad -> X Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedScratchpad -> Query Bool
query)

-- | Named scratchpads configuration
type NamedScratchpads = [NamedScratchpad]

-- | Runs application which should appear in specified scratchpad
runApplication :: NamedScratchpad -> X ()
runApplication :: NamedScratchpad -> X ()
runApplication = String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
spawn (String -> X ())
-> (NamedScratchpad -> String) -> NamedScratchpad -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedScratchpad -> String
cmd

-- | Runs application which should appear in a specified scratchpad on the workspace it was launched on
runApplicationHere :: NamedScratchpad -> X ()
runApplicationHere :: NamedScratchpad -> X ()
runApplicationHere = String -> X ()
spawnHere (String -> X ())
-> (NamedScratchpad -> String) -> NamedScratchpad -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedScratchpad -> String
cmd

-- | Action to pop up specified named scratchpad
--
-- Note [Ignored Arguments]: Most of the time, this function ignores its
-- first argument and uses 'NSPState' instead.  The only time when it
-- does not is when no other window has been opened before in the
-- running xmonad instance.  If this is not your use-case, you can
-- safely call this function with an empty list.
namedScratchpadAction :: NamedScratchpads -- ^ Named scratchpads configuration
                      -> String           -- ^ Scratchpad name
                      -> X ()
namedScratchpadAction :: NamedScratchpads -> String -> X ()
namedScratchpadAction = (NamedScratchpad -> X ()) -> NamedScratchpads -> String -> X ()
customRunNamedScratchpadAction NamedScratchpad -> X ()
runApplication

-- | Action to pop up specified named scratchpad, initially starting it on the current workspace.
--
-- This function /almost always/ ignores its first argument; see Note
-- [Ignored Arguments] for 'namedScratchpadAction'.
spawnHereNamedScratchpadAction :: NamedScratchpads           -- ^ Named scratchpads configuration
                               -> String                     -- ^ Scratchpad name
                               -> X ()
spawnHereNamedScratchpadAction :: NamedScratchpads -> String -> X ()
spawnHereNamedScratchpadAction = (NamedScratchpad -> X ()) -> NamedScratchpads -> String -> X ()
customRunNamedScratchpadAction NamedScratchpad -> X ()
runApplicationHere

-- | Action to pop up specified named scratchpad, given a custom way to initially start the application.
--
-- This function /almost always/ ignores its second argument; see Note
-- [Ignored Arguments] for 'namedScratchpadAction'.
customRunNamedScratchpadAction :: (NamedScratchpad -> X ())  -- ^ Function initially running the application, given the configured @scratchpad@ cmd
                               -> NamedScratchpads           -- ^ Named scratchpads configuration
                               -> String                     -- ^ Scratchpad name
                               -> X ()
customRunNamedScratchpadAction :: (NamedScratchpad -> X ()) -> NamedScratchpads -> String -> X ()
customRunNamedScratchpadAction = ((Window -> X ()) -> NonEmpty Window -> X ())
-> (NamedScratchpad -> X ()) -> NamedScratchpads -> String -> X ()
someNamedScratchpadAction (\Window -> X ()
f NonEmpty Window
ws -> Window -> X ()
f (Window -> X ()) -> Window -> X ()
forall a b. (a -> b) -> a -> b
$ NonEmpty Window -> Window
forall a. NonEmpty a -> a
NE.head NonEmpty Window
ws)

-- | Like 'namedScratchpadAction', but execute the action for all
-- scratchpads that match the query.
--
-- This function /almost always/ ignores its first argument; see Note
-- [Ignored Arguments] for 'namedScratchpadAction'.
allNamedScratchpadAction :: NamedScratchpads
                         -> String
                         -> X ()
allNamedScratchpadAction :: NamedScratchpads -> String -> X ()
allNamedScratchpadAction = ((Window -> X ()) -> NonEmpty Window -> X ())
-> (NamedScratchpad -> X ()) -> NamedScratchpads -> String -> X ()
someNamedScratchpadAction (Window -> X ()) -> NonEmpty Window -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ NamedScratchpad -> X ()
runApplication

-- | A @logHook@ to hide scratchpads when they lose focus.  This can be
-- useful for e.g. dropdown terminals.  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
-- >            >> nsHideOnFocusLoss myScratchpads
-- >               -- enable hiding for all of @myScratchpads@
-- >   }
nsHideOnFocusLoss :: NamedScratchpads -> X ()
nsHideOnFocusLoss :: NamedScratchpads -> X ()
nsHideOnFocusLoss NamedScratchpads
scratches =
    (Window -> Window -> WindowSet -> (Window -> X ()) -> X ()) -> X ()
nsHideOnCondition ((Window -> Window -> WindowSet -> (Window -> X ()) -> X ())
 -> X ())
-> (Window -> Window -> WindowSet -> (Window -> X ()) -> X ())
-> X ()
forall a b. (a -> b) -> a -> b
$ \ Window
lastFocus Window
_curFoc WindowSet
_ws Window -> X ()
hideScratch ->
        X Bool -> X () -> X ()
whenX (Window -> NamedScratchpads -> X Bool
isNSP Window
lastFocus NamedScratchpads
scratches) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$
            Window -> X ()
hideScratch Window
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 :: NamedScratchpads -> X ()
nsSingleScratchpadPerWorkspace NamedScratchpads
scratches =
    (Window -> Window -> WindowSet -> (Window -> X ()) -> X ()) -> X ()
nsHideOnCondition ((Window -> Window -> WindowSet -> (Window -> X ()) -> X ())
 -> X ())
-> (Window -> Window -> WindowSet -> (Window -> X ()) -> X ())
-> X ()
forall a b. (a -> b) -> a -> b
$ \ Window
_lastFocus Window
curFocus WindowSet
winSet Window -> X ()
hideScratch -> do
        [Window]
allScratchesButCurrent <-
            (Window -> X Bool) -> [Window] -> X [Window]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((X Bool -> X Bool -> X Bool)
-> (Window -> X Bool) -> (Window -> X Bool) -> Window -> X Bool
forall a b c.
(a -> b -> c) -> (Window -> a) -> (Window -> b) -> Window -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 X Bool -> X Bool -> X Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
(<||>) (Bool -> X Bool
forall a. a -> X a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> X Bool) -> (Window -> Bool) -> Window -> X Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Window
curFocus)) (Window -> NamedScratchpads -> X Bool
`isNSP` NamedScratchpads
scratches))
                    (WindowSet -> [Window]
forall i l a s sd. StackSet i l a s sd -> [a]
W.index WindowSet
winSet)
        X Bool -> X () -> X ()
whenX (Window -> NamedScratchpads -> X Bool
isNSP Window
curFocus NamedScratchpads
scratches) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$
            [Window] -> (Window -> X ()) -> X ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Window]
allScratchesButCurrent Window -> X ()
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 :: (Window -> Window -> WindowSet -> (Window -> X ()) -> X ()) -> X ()
nsHideOnCondition Window -> Window -> WindowSet -> (Window -> X ()) -> X ()
cond = (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
winSet -> do
    let cur :: String
cur = WindowSet -> String
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
winSet
    String -> () -> (Window -> Window -> X ()) -> X ()
forall a. String -> a -> (Window -> Window -> X a) -> X a
withRecentsIn String
cur () ((Window -> Window -> X ()) -> X ())
-> (Window -> Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
lastFocus Window
curFocus -> do
        let hideScratch :: Window -> X ()
            hideScratch :: Window -> X ()
hideScratch Window
win = [WindowSpace] -> ((Window -> X ()) -> X ()) -> X ()
shiftToNSP (WindowSet -> [WindowSpace]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces WindowSet
winSet) ((Window -> X ()) -> Window -> X ()
forall a b. (a -> b) -> a -> b
$ Window
win)
            isWorthy :: Bool
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.
                Window
lastFocus Window -> [Window] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` WindowSet -> [Window]
forall i l a s sd. StackSet i l a s sd -> [a]
W.index WindowSet
winSet Bool -> Bool -> Bool
&& Window
lastFocus Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Window
curFocus
                -- Don't do anything on the NSP workspace, lest the world explodes.
                Bool -> Bool -> Bool
&& String
cur String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
scratchpadWorkspaceTag
        Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isWorthy (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$
            Window -> Window -> WindowSet -> (Window -> X ()) -> X ()
cond Window
lastFocus Window
curFocus WindowSet
winSet Window -> X ()
hideScratch

-- | Execute some action on a named scratchpad.
--
-- This function /almost always/ ignores its third argument; see Note
-- [Ignored Arguments] for 'namedScratchpadAction'.
someNamedScratchpadAction :: ((Window -> X ()) -> NE.NonEmpty Window -> X ())
                          -> (NamedScratchpad -> X ())
                          -> NamedScratchpads
                          -> String
                          -> X ()
someNamedScratchpadAction :: ((Window -> X ()) -> NonEmpty Window -> X ())
-> (NamedScratchpad -> X ()) -> NamedScratchpads -> String -> X ()
someNamedScratchpadAction (Window -> X ()) -> NonEmpty Window -> X ()
f NamedScratchpad -> X ()
runApp NamedScratchpads
_ns String
scratchpadName = do
    NSPState{ Map String NamedScratchpad
nspScratchpads :: NSPState -> Map String NamedScratchpad
nspScratchpads :: Map String NamedScratchpad
nspScratchpads } <- NamedScratchpads -> X NSPState
fillNSPState NamedScratchpads
_ns  -- See Note [Filling NSPState]
    case Map String NamedScratchpad
nspScratchpads Map String NamedScratchpad -> String -> Maybe NamedScratchpad
forall k a. Ord k => Map k a -> k -> Maybe a
!? String
scratchpadName of
        Just NamedScratchpad
conf -> (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
winSet -> do
            let focusedWspWindows :: [Window]
focusedWspWindows = WindowSet -> [Window]
forall i l a s sd. StackSet i l a s sd -> [a]
W.index WindowSet
winSet
                allWindows :: [Window]
allWindows        = WindowSet -> [Window]
forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
W.allWindows WindowSet
winSet
            [Window]
matchingOnCurrent <- (Window -> X Bool) -> [Window] -> X [Window]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
runQuery (NamedScratchpad -> Query Bool
query NamedScratchpad
conf)) [Window]
focusedWspWindows
            [Window]
matchingOnAll     <- (Window -> X Bool) -> [Window] -> X [Window]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
runQuery (NamedScratchpad -> Query Bool
query NamedScratchpad
conf)) [Window]
allWindows

            case [Window] -> Maybe (NonEmpty Window)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Window]
matchingOnCurrent of
                -- no matching window on the current workspace -> scratchpad not running or in background
                Maybe (NonEmpty Window)
Nothing -> do
                    -- summon the scratchpad
                    case [Window] -> Maybe (NonEmpty Window)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Window]
matchingOnAll of
                        Maybe (NonEmpty Window)
Nothing   -> NamedScratchpad -> X ()
runApp NamedScratchpad
conf
                        Just NonEmpty Window
wins -> (Window -> X ()) -> NonEmpty Window -> X ()
f ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (Window -> WindowSet -> WindowSet) -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Window -> WindowSet -> WindowSet
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> a -> StackSet i l a s sd -> StackSet i l a s sd
W.shiftWin (WindowSet -> String
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
winSet)) NonEmpty Window
wins
                    -- check for exclusive scratchpads to hide
                    String -> X ()
hideUnwanted (NamedScratchpad -> String
name NamedScratchpad
conf)

                -- matching window running on current workspace -> window should be shifted to scratchpad workspace
                Just NonEmpty Window
wins -> [WindowSpace] -> ((Window -> X ()) -> X ()) -> X ()
shiftToNSP (WindowSet -> [WindowSpace]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces WindowSet
winSet) ((Window -> X ()) -> NonEmpty Window -> X ()
`f` NonEmpty Window
wins)
        Maybe NamedScratchpad
Nothing -> () -> X ()
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{- Note [Filling NSPState]

We have to potentially populate the state with the given scratchpads
here, in case the manageHook didn't run yet and it's still empty.

For backwards compatibility, 3fc830aa09368dca04df24bf7ec4ac817f2de479
introduced an internal state that's filled in the
namedScratchpadManageHook.  A priori, this means that we would need some
kind of MapRequestEvent to happen before processing scratchpads, since
the manageHook doesn't run otherwise, leaving the extensible state empty
until then.  When trying to open a scratchpad right after starting
xmonad—i.e., before having opened a window—we thus have to populate the
NSPState before looking for scratchpads.

Related: https://github.com/xmonad/xmonad-contrib/issues/728
-}

-- | Tag of the scratchpad workspace
scratchpadWorkspaceTag :: String
scratchpadWorkspaceTag :: String
scratchpadWorkspaceTag = String
"NSP"

-- | Manage hook to use with named scratchpads
namedScratchpadManageHook :: NamedScratchpads -- ^ Named scratchpads configuration
                          -> ManageHook
namedScratchpadManageHook :: NamedScratchpads -> ManageHook
namedScratchpadManageHook NamedScratchpads
nsps = do
    NamedScratchpads
ns <- Map String NamedScratchpad -> NamedScratchpads
forall k a. Map k a -> [a]
Map.elems (Map String NamedScratchpad -> NamedScratchpads)
-> (NSPState -> Map String NamedScratchpad)
-> NSPState
-> NamedScratchpads
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NSPState -> Map String NamedScratchpad
nspScratchpads (NSPState -> NamedScratchpads)
-> Query NSPState -> Query NamedScratchpads
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X NSPState -> Query NSPState
forall a. X a -> Query a
liftX (NamedScratchpads -> X NSPState
fillNSPState NamedScratchpads
nsps)
    [ManageHook] -> ManageHook
forall m. Monoid m => [m] -> m
composeAll ([ManageHook] -> ManageHook) -> [ManageHook] -> ManageHook
forall a b. (a -> b) -> a -> b
$ (NamedScratchpad -> ManageHook) -> NamedScratchpads -> [ManageHook]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\NamedScratchpad
c -> NamedScratchpad -> Query Bool
query NamedScratchpad
c Query Bool -> ManageHook -> ManageHook
forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> NamedScratchpad -> ManageHook
hook NamedScratchpad
c) NamedScratchpads
ns

-- | Shift some windows to the scratchpad workspace according to the
-- given function.  The workspace is created if necessary.
shiftToNSP :: [WindowSpace] -> ((Window -> X ()) -> X ()) -> X ()
shiftToNSP :: [WindowSpace] -> ((Window -> X ()) -> X ()) -> X ()
shiftToNSP [WindowSpace]
ws (Window -> X ()) -> X ()
f = do
    Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((WindowSpace -> Bool) -> [WindowSpace] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String
scratchpadWorkspaceTag String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool) -> (WindowSpace -> String) -> WindowSpace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSpace -> String
forall i l a. Workspace i l a -> i
W.tag) [WindowSpace]
ws) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$
        String -> X ()
addHiddenWorkspace String
scratchpadWorkspaceTag
    (Window -> X ()) -> X ()
f ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (Window -> WindowSet -> WindowSet) -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Window -> WindowSet -> WindowSet
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> a -> StackSet i l a s sd -> StackSet i l a s sd
W.shiftWin String
scratchpadWorkspaceTag)

------------------------------------------------------------------------
-- Dynamic scratchpad functionality

-- $dynamic-scratchpads
--
-- Dynamic scratchpads allow you to declare existing windows as
-- scratchpads.  You can bind a key to make a window start/stop being a
-- scratchpad, and another key to toggle its visibility.  Because
-- dynamic scratchpads are based on existing windows, they have some
-- caveats in comparison to "normal" scratchpads:
--
--   * @xmonad@ has no way of knowing /how/ windows were spawned and
--     thus one is not able to "start" dynamic scratchpads again after
--     the associated window has been closed.
--
--   * If you already have an active dynamic scratchpad @"dyn1"@ and you
--     call 'toggleDynamicNSP' with another window, that window will
--     henceforth occupy the @"dyn1"@ scratchpad.  If you still need the
--     old window, you might have to travel to your scratchpad workspace
--     ('scratchpadWorkspaceTag') in order to retrieve it.
--
-- As an example, the following snippet contains keybindings for two
-- dynamic scratchpads, called @"dyn1"@ and @"dyn2"@:
--
-- > import XMonad.Util.NamedScratchpads
-- >
-- > , ("M-s-a", withFocused $ toggleDynamicNSP "dyn1")
-- > , ("M-s-b", withFocused $ toggleDynamicNSP "dyn2")
-- > , ("M-a"  , dynamicNSPAction "dyn1")
-- > , ("M-b"  , dynamicNSPAction "dyn2")
--

-- | A 'NamedScratchpad' representing a "dynamic" scratchpad; i.e., a
-- scratchpad based on an already existing window.
mkDynamicNSP :: String -> Window -> NamedScratchpad
mkDynamicNSP :: String -> Window -> NamedScratchpad
mkDynamicNSP String
s Window
w =
    NS { name :: String
name  = String
s
       , cmd :: String
cmd   = String
""               -- we are never going to spawn a dynamic scratchpad
       , query :: Query Bool
query = (Window
w Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
==) (Window -> Bool) -> Query Window -> Query Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask
       , hook :: ManageHook
hook  = ManageHook
forall a. Monoid a => a
mempty           -- cmd is never called so this will never run
       }

-- | Make a window a dynamic scratchpad
addDynamicNSP :: String -> Window -> X ()
addDynamicNSP :: String -> Window -> X ()
addDynamicNSP String
s Window
w = (NSPState -> NSPState) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((NSPState -> NSPState) -> X ()) -> (NSPState -> NSPState) -> X ()
forall a b. (a -> b) -> a -> b
$ \(NSPState Map String NamedScratchpads
exs Map String NamedScratchpad
ws) ->
  Map String NamedScratchpads
-> Map String NamedScratchpad -> NSPState
NSPState Map String NamedScratchpads
exs (String
-> NamedScratchpad
-> Map String NamedScratchpad
-> Map String NamedScratchpad
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
s (String -> Window -> NamedScratchpad
mkDynamicNSP String
s Window
w) Map String NamedScratchpad
ws)

-- | Make a window stop being a dynamic scratchpad
removeDynamicNSP :: String -> X ()
removeDynamicNSP :: String -> X ()
removeDynamicNSP String
s = (NSPState -> NSPState) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((NSPState -> NSPState) -> X ()) -> (NSPState -> NSPState) -> X ()
forall a b. (a -> b) -> a -> b
$ \(NSPState Map String NamedScratchpads
exs Map String NamedScratchpad
ws) -> Map String NamedScratchpads
-> Map String NamedScratchpad -> NSPState
NSPState Map String NamedScratchpads
exs (String -> Map String NamedScratchpad -> Map String NamedScratchpad
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete String
s Map String NamedScratchpad
ws)

-- | Toggle the visibility of a dynamic scratchpad.
dynamicNSPAction :: String -> X ()
dynamicNSPAction :: String -> X ()
dynamicNSPAction = (NamedScratchpad -> X ()) -> NamedScratchpads -> String -> X ()
customRunNamedScratchpadAction (X () -> NamedScratchpad -> X ()
forall a b. a -> b -> a
const (X () -> NamedScratchpad -> X ())
-> X () -> NamedScratchpad -> X ()
forall a b. (a -> b) -> a -> b
$ () -> X ()
forall a. a -> X a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) []

-- | Either create a dynamic scratchpad out of the given window, or stop
-- a window from being one if it already is.
toggleDynamicNSP :: String -> Window -> X ()
toggleDynamicNSP :: String -> Window -> X ()
toggleDynamicNSP String
s Window
w = do
    NSPState{ Map String NamedScratchpad
nspScratchpads :: NSPState -> Map String NamedScratchpad
nspScratchpads :: Map String NamedScratchpad
nspScratchpads } <- X NSPState
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
    case Map String NamedScratchpad
nspScratchpads Map String NamedScratchpad -> String -> Maybe NamedScratchpad
forall k a. Ord k => Map k a -> k -> Maybe a
!? String
s of
        Maybe NamedScratchpad
Nothing  -> String -> Window -> X ()
addDynamicNSP String
s Window
w
        Just NamedScratchpad
nsp -> X Bool -> X () -> X () -> X ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
runQuery (NamedScratchpad -> Query Bool
query NamedScratchpad
nsp) Window
w)
                        (String -> X ()
removeDynamicNSP String
s)
                        (String -> Window -> X ()
addDynamicNSP String
s Window
w)

-----------------------------------------------------------------------
-- Exclusive scratchpads

-- $exclusive-scratchpads
--
-- Exclusive scratchpads allow you to hide certain scratchpads in
-- relation to others.  There can be multiple groups of pairwise
-- exclusive scratchpads; whenever one such scratchpad gets called, it
-- will hide all other scratchpads on the focused workspace that are in
-- this group.
--
-- For example, having defined "Calc", "Mail", and "Term" scratchpads,
-- you can use 'addExclusives' to make some of them dislike each other:
--
-- > myExclusives = addExclusives
-- >   [ ["Calc", "Mail"]
-- >   , ["Mail", "Term"]
-- >   ]
--
-- You now have to add @myExclusives@ to you startupHook:
--
-- > main :: IO
-- > main = xmonad . … . $ def
-- >   { …
-- >   , startupHook = myStartupHook >> myExclusives
-- >   }
--
-- This will hide the "Mail" scratchpad whenever the "Calc" scratchpad
-- is brought up, and vice-versa.  Likewise, "Mail" and "Term" behave in
-- this way, but "Calc" and "Term" may peacefully coexist.
--
-- If you move a scratchpad it still gets hidden when you fetch a
-- scratchpad of the same family.  To change that behaviour—and make
-- windows not exclusive anymore when they get resized or moved—add
-- these mouse bindings (see
-- "XMonad.Doc.Extending#Editing_mouse_bindings"):
--
-- >     , ((mod4Mask, button1), floatMoveNoexclusive)
-- >     , ((mod4Mask, button3), resizeNoexclusive)
--
-- To reset a moved scratchpad to the original position that you set
-- with its hook, focus is and then call 'resetFocusedNSP'.  For
-- example, if you want to extend @M-\<Return\>@ to reset the placement
-- when a scratchpad is in focus but keep the default behaviour for
-- tiled windows, set these key bindings:
--
-- > , ((modMask, xK_Return), windows W.swapMaster >> resetFocusedNSP)

-- | Make some scratchpads exclusive.
addExclusives :: [[String]] -> X ()
addExclusives :: [[String]] -> X ()
addExclusives [[String]]
exs = do
    NSPState Map String NamedScratchpads
_ Map String NamedScratchpad
ws <- X NSPState
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
    -- Re-initialise `ws' to nothing, so we can react to changes in case
    -- of a restart.  See 'fillNSPState' for more details on filling.
    NSPState -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (Map String NamedScratchpads
-> Map String NamedScratchpad -> NSPState
NSPState ((Map String NamedScratchpads
 -> [String] -> Map String NamedScratchpads)
-> Map String NamedScratchpads
-> [[String]]
-> Map String NamedScratchpads
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([String]
-> Map String NamedScratchpads
-> [String]
-> Map String NamedScratchpads
go []) Map String NamedScratchpads
forall a. Monoid a => a
mempty [[String]]
exs) Map String NamedScratchpad
forall a. Monoid a => a
mempty)
    Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Map String NamedScratchpad -> Bool
forall a. Map String a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map String NamedScratchpad
ws) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$
        X NSPState -> X ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (NamedScratchpads -> X NSPState
fillNSPState (Map String NamedScratchpad -> NamedScratchpads
forall k a. Map k a -> [a]
Map.elems Map String NamedScratchpad
ws))
  where
    -- Ignoring that this is specialised to NSPs, it works something like
    -- >>> foldl' (go []) mempty [[1, 2], [3, 4], [1, 3]]
    -- fromList [(1, [3, 2]), (2, [1]), (3, [1, 4]), (4, [3])]
    go :: [String]
-> Map String NamedScratchpads
-> [String]
-> Map String NamedScratchpads
go [String]
_  Map String NamedScratchpads
m []       = Map String NamedScratchpads
m
    go [String]
ms Map String NamedScratchpads
m (String
n : [String]
ns) = [String]
-> Map String NamedScratchpads
-> [String]
-> Map String NamedScratchpads
go (String
n String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ms) ((NamedScratchpads -> NamedScratchpads -> NamedScratchpads)
-> String
-> NamedScratchpads
-> Map String NamedScratchpads
-> Map String NamedScratchpads
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith NamedScratchpads -> NamedScratchpads -> NamedScratchpads
forall a. Semigroup a => a -> a -> a
(<>) String
n ([String] -> NamedScratchpads
mkNSP ([String]
ms [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
ns)) Map String NamedScratchpads
m) [String]
ns
    mkNSP :: [String] -> NamedScratchpads
mkNSP = (String -> NamedScratchpad) -> [String] -> NamedScratchpads
forall a b. (a -> b) -> [a] -> [b]
map (\String
n -> String -> String -> Query Bool -> ManageHook -> NamedScratchpad
NS String
n String
forall a. Monoid a => a
mempty (Bool -> Query Bool
forall a. a -> Query a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) ManageHook
forall a. Monoid a => a
mempty)

-- | @setNoexclusive w@ makes the window @w@ lose its exclusivity
-- features.
setNoexclusive :: Window -> X ()
setNoexclusive :: Window -> X ()
setNoexclusive Window
w = do
    NSPState Map String NamedScratchpads
_ Map String NamedScratchpad
ws <- X NSPState
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
    X Bool -> X () -> X ()
whenX (Window -> NamedScratchpads -> X Bool
isNSP Window
w (Map String NamedScratchpad -> NamedScratchpads
forall k a. Map k a -> [a]
Map.elems Map String NamedScratchpad
ws)) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$
        String -> Window -> X ()
addTag String
"_NSP_NOEXCLUSIVE" Window
w

-- | If the focused window is a scratchpad, the scratchpad gets reset to
-- the original placement specified with the hook and becomes exclusive
-- again.
resetFocusedNSP :: X ()
resetFocusedNSP :: X ()
resetFocusedNSP = do
    NSPState Map String NamedScratchpads
_ (Map String NamedScratchpad -> NamedScratchpads
forall k a. Map k a -> [a]
Map.elems -> NamedScratchpads
ws) <- X NSPState
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
    (Window -> X ()) -> X ()
withFocused ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
w -> do
        Maybe NamedScratchpad
mbWin <- (NamedScratchpad -> X Bool)
-> NamedScratchpads -> X (Maybe NamedScratchpad)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM ((Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
`runQuery` Window
w) (Query Bool -> X Bool)
-> (NamedScratchpad -> Query Bool) -> NamedScratchpad -> X Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedScratchpad -> Query Bool
query) NamedScratchpads
ws
        Maybe NamedScratchpad -> (NamedScratchpad -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe NamedScratchpad
mbWin ((NamedScratchpad -> X ()) -> X ())
-> (NamedScratchpad -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \NamedScratchpad
win -> do
            ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (Endo WindowSet -> WindowSet -> WindowSet)
-> Endo WindowSet
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endo WindowSet -> WindowSet -> WindowSet
forall a. Endo a -> a -> a
appEndo (Endo WindowSet -> X ())
-> (Window -> X (Endo WindowSet)) -> Window -> X ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ManageHook -> Window -> X (Endo WindowSet)
forall a. Query a -> Window -> X a
runQuery (NamedScratchpad -> ManageHook
hook NamedScratchpad
win)) Window
w
            String -> X ()
hideUnwanted (NamedScratchpad -> String
name NamedScratchpad
win)
            String -> Window -> X ()
delTag String
"_NSP_NOEXCLUSIVE" Window
w

-- | @hideUnwanted nspWindow@ hides all windows that @nspWindow@ does
-- not like; i.e., windows that are in some kind of exclusivity contract
-- with it.
--
-- A consistency assumption for this is that @nspWindow@ must be the
-- currently focused window.  For this to take effect, @nspWindow@ must
-- not have set the @_NSP_NOEXCLUSIVE@ property, neither must any
-- exclusive window we'd like to hide.
hideUnwanted :: String -> X ()
hideUnwanted :: String -> X ()
hideUnwanted String
nspWindow = (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
winSet -> do
    NSPState{ Map String NamedScratchpads
nspExclusives :: NSPState -> Map String NamedScratchpads
nspExclusives :: Map String NamedScratchpads
nspExclusives } <- X NSPState
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
    Maybe NamedScratchpads -> (NamedScratchpads -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (Map String NamedScratchpads
nspExclusives Map String NamedScratchpads -> String -> Maybe NamedScratchpads
forall k a. Ord k => Map k a -> k -> Maybe a
!? String
nspWindow) ((NamedScratchpads -> X ()) -> X ())
-> (NamedScratchpads -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \NamedScratchpads
unwanted ->
        (Window -> X ()) -> X ()
withFocused ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
w -> X Bool -> X () -> X ()
whenX (Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
runQuery Query Bool
notIgnored Window
w) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
            [Window] -> (Window -> X ()) -> X ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (WindowSet -> [Window]
forall i l a s sd. StackSet i l a s sd -> [a]
W.index WindowSet
winSet) ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
win ->
                X Bool -> X () -> X ()
whenX (Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
runQuery (NamedScratchpads -> Query Bool
isUnwanted NamedScratchpads
unwanted) Window
win) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$
                    [WindowSpace] -> ((Window -> X ()) -> X ()) -> X ()
shiftToNSP (WindowSet -> [WindowSpace]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces WindowSet
winSet) ((Window -> X ()) -> Window -> X ()
forall a b. (a -> b) -> a -> b
$ Window
win)
  where
    notIgnored :: Query Bool
    notIgnored :: Query Bool
notIgnored = String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem String
"_NSP_NOEXCLUSIVE" ([String] -> Bool) -> (String -> [String]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> Bool) -> Query String -> Query Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Query String
stringProperty String
"_XMONAD_TAGS"

    isUnwanted :: [NamedScratchpad] -> Query Bool
    isUnwanted :: NamedScratchpads -> Query Bool
isUnwanted = (Query Bool
notIgnored Query Bool -> Query Bool -> Query Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&>) (Query Bool -> Query Bool)
-> (NamedScratchpads -> Query Bool)
-> NamedScratchpads
-> Query Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NamedScratchpad -> Query Bool -> Query Bool)
-> Query Bool -> NamedScratchpads -> Query Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\NamedScratchpad
nsp Query Bool
qs -> Query Bool
qs Query Bool -> Query Bool -> Query Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<||> NamedScratchpad -> Query Bool
query NamedScratchpad
nsp) (Bool -> Query Bool
forall a. a -> Query a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)

-- | Float and drag the window; make it lose its exclusivity status in
-- the process.
floatMoveNoexclusive :: Window -- ^ Window which should be moved
                     -> X ()
floatMoveNoexclusive :: Window -> X ()
floatMoveNoexclusive = (Window -> X ()) -> Window -> X ()
forall a. (Window -> X a) -> Window -> X ()
mouseHelper Window -> X ()
mouseMoveWindow

-- | Resize window and make it lose its exclusivity status in the
-- process.
resizeNoexclusive :: Window -- ^ Window which should be resized
                  -> X ()
resizeNoexclusive :: Window -> X ()
resizeNoexclusive = (Window -> X ()) -> Window -> X ()
forall a. (Window -> X a) -> Window -> X ()
mouseHelper Window -> X ()
mouseResizeWindow

mouseHelper :: (Window -> X a) -> Window -> X ()
mouseHelper :: forall a. (Window -> X a) -> Window -> X ()
mouseHelper Window -> X a
f Window
w = Window -> X ()
setNoexclusive Window
w
               X () -> X () -> X ()
forall a b. X a -> X b -> X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> X ()
focus Window
w
               X () -> X a -> X a
forall a b. X a -> X b -> X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> X a
f Window
w
               X a -> X () -> X ()
forall a b. X a -> X b -> X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.shiftMaster

------------------------------------------------------------------------
-- Deprecations

-- | Transforms a workspace list containing the NSP workspace into one that
-- doesn't contain it. Intended for use with logHooks.
namedScratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace]
namedScratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace]
namedScratchpadFilterOutWorkspace = (WindowSpace -> Bool) -> [WindowSpace] -> [WindowSpace]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(W.Workspace String
tag Layout Window
_ Maybe (Stack Window)
_) -> String
tag String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
scratchpadWorkspaceTag)
{-# DEPRECATED namedScratchpadFilterOutWorkspace "Use XMonad.Util.WorkspaceCompare.filterOutWs [scratchpadWorkspaceTag] instead" #-}

-- | Transforms a pretty-printer into one not displaying the NSP workspace.
--
-- A simple use could be:
--
-- > logHook = dynamicLogWithPP . namedScratchpadFilterOutWorkspace $ def
--
-- Here is another example, when using "XMonad.Layout.IndependentScreens".
-- If you have handles @hLeft@ and @hRight@ for bars on the left and right screens, respectively, and @pp@ is a pretty-printer function that takes a handle, you could write
--
-- > logHook = let log screen handle = dynamicLogWithPP . namedScratchpadFilterOutWorkspacePP . marshallPP screen . pp $ handle
-- >           in log 0 hLeft >> log 1 hRight
namedScratchpadFilterOutWorkspacePP :: PP -> PP
namedScratchpadFilterOutWorkspacePP :: PP -> PP
namedScratchpadFilterOutWorkspacePP PP
pp = PP
pp {
  ppSort = fmap (. namedScratchpadFilterOutWorkspace) (ppSort pp)
  }
{-# DEPRECATED namedScratchpadFilterOutWorkspacePP "Use XMonad.Hooks.StatusBar.PP.filterOutWsPP [scratchpadWorkspaceTag] instead" #-}