{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}
module XMonad.Util.NamedScratchpad (
NamedScratchpad(..),
scratchpadWorkspaceTag,
nonFloating,
defaultFloating,
customFloating,
NamedScratchpads,
namedScratchpadAction,
spawnHereNamedScratchpadAction,
customRunNamedScratchpadAction,
allNamedScratchpadAction,
namedScratchpadManageHook,
nsHideOnFocusLoss,
nsSingleScratchpadPerWorkspace,
dynamicNSPAction,
toggleDynamicNSP,
addExclusives,
resetFocusedNSP,
setNoexclusive,
resizeNoexclusive,
floatMoveNoexclusive,
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
data NamedScratchpad = NS { NamedScratchpad -> String
name :: String
, NamedScratchpad -> String
cmd :: String
, NamedScratchpad -> Query Bool
query :: Query Bool
, NamedScratchpad -> ManageHook
hook :: ManageHook
}
data NSPState = NSPState
{ NSPState -> Map String NamedScratchpads
nspExclusives :: !(Map String NamedScratchpads)
, NSPState -> Map String NamedScratchpad
nspScratchpads :: !(Map String NamedScratchpad)
}
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
fillNSPState :: NamedScratchpads -> X NSPState
fillNSPState :: NamedScratchpads -> X NSPState
fillNSPState NamedScratchpads
nsps = do
nsp@(NSPState exs scratches) <- X NSPState
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
if null scratches
then let 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 <$ XS.put nspState
else pure nsp
where
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)
nonFloating :: ManageHook
nonFloating :: ManageHook
nonFloating = ManageHook
forall a. Monoid a => a
idHook
defaultFloating :: ManageHook
defaultFloating :: ManageHook
defaultFloating = ManageHook
doFloat
customFloating :: W.RationalRect -> ManageHook
customFloating :: RationalRect -> ManageHook
customFloating = RationalRect -> ManageHook
doRectFloat
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)
type NamedScratchpads = [NamedScratchpad]
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
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
namedScratchpadAction :: NamedScratchpads
-> String
-> X ()
namedScratchpadAction :: NamedScratchpads -> String -> X ()
namedScratchpadAction = (NamedScratchpad -> X ()) -> NamedScratchpads -> String -> X ()
customRunNamedScratchpadAction NamedScratchpad -> X ()
runApplication
spawnHereNamedScratchpadAction :: NamedScratchpads
-> String
-> X ()
spawnHereNamedScratchpadAction :: NamedScratchpads -> String -> X ()
spawnHereNamedScratchpadAction = (NamedScratchpad -> X ()) -> NamedScratchpads -> String -> X ()
customRunNamedScratchpadAction NamedScratchpad -> X ()
runApplicationHere
customRunNamedScratchpadAction :: (NamedScratchpad -> X ())
-> NamedScratchpads
-> String
-> 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)
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
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
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
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)
whenX (isNSP curFocus scratches) $
for_ allScratchesButCurrent hideScratch
nsHideOnCondition
:: ( Window
-> Window
-> WindowSet
-> (Window -> X ())
-> 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 =
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
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
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{ nspScratchpads } <- NamedScratchpads -> X NSPState
fillNSPState NamedScratchpads
_ns
case nspScratchpads !? 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
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
matchingOnAll <- filterM (runQuery (query conf)) allWindows
case NE.nonEmpty matchingOnCurrent of
Maybe (NonEmpty Window)
Nothing -> do
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
String -> X ()
hideUnwanted (NamedScratchpad -> String
name NamedScratchpad
conf)
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 ()
scratchpadWorkspaceTag :: String
scratchpadWorkspaceTag :: String
scratchpadWorkspaceTag = String
"NSP"
namedScratchpadManageHook :: NamedScratchpads
-> ManageHook
namedScratchpadManageHook :: NamedScratchpads -> ManageHook
namedScratchpadManageHook NamedScratchpads
nsps = do
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)
composeAll $ 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) ns
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)
mkDynamicNSP :: String -> Window -> NamedScratchpad
mkDynamicNSP :: String -> Window -> NamedScratchpad
mkDynamicNSP String
s Window
w =
NS { name :: String
name = String
s
, cmd :: String
cmd = String
""
, 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
}
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)
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)
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 ()) []
toggleDynamicNSP :: String -> Window -> X ()
toggleDynamicNSP :: String -> Window -> X ()
toggleDynamicNSP String
s Window
w = do
NSPState{ nspScratchpads } <- X NSPState
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
case nspScratchpads !? 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)
addExclusives :: [[String]] -> X ()
addExclusives :: [[String]] -> X ()
addExclusives [[String]]
exs = do
NSPState _ ws <- X NSPState
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
XS.put (NSPState (foldl' (go []) mempty exs) mempty)
unless (null ws) $
void (fillNSPState (Map.elems ws))
where
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 :: Window -> X ()
setNoexclusive :: Window -> X ()
setNoexclusive Window
w = do
NSPState _ ws <- X NSPState
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
whenX (isNSP w (Map.elems ws)) $
addTag "_NSP_NOEXCLUSIVE" w
resetFocusedNSP :: X ()
resetFocusedNSP :: X ()
resetFocusedNSP = do
NSPState _ (Map.elems -> ws) <- X NSPState
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
withFocused $ \Window
w -> do
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
whenJust mbWin $ \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 :: 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{ nspExclusives } <- X NSPState
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
whenJust (nspExclusives !? nspWindow) $ \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)
floatMoveNoexclusive :: Window
-> X ()
floatMoveNoexclusive :: Window -> X ()
floatMoveNoexclusive = (Window -> X ()) -> Window -> X ()
forall a. (Window -> X a) -> Window -> X ()
mouseHelper Window -> X ()
mouseMoveWindow
resizeNoexclusive :: Window
-> 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
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" #-}
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" #-}