{-# 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 forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
fillNSPState :: NamedScratchpads -> X NSPState
fillNSPState :: NamedScratchpads -> X NSPState
fillNSPState NamedScratchpads
nsps = do
nsp :: NSPState
nsp@(NSPState Map String NamedScratchpads
exs Map String NamedScratchpad
scratches) <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
if 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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put NSPState
nspState
else forall (f :: * -> *) a. Applicative f => a -> f a
pure NSPState
nsp
where
nspScratches :: Map String NamedScratchpad
nspScratches :: Map String NamedScratchpad
nspScratches = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map String NamedScratchpads
nspMap NamedScratchpad
n -> 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 = forall a b. (a -> b) -> [a] -> [b]
map (\NamedScratchpad
x -> if NamedScratchpad -> String
name NamedScratchpad
x forall a. Eq a => a -> a -> Bool
== NamedScratchpad -> String
name NamedScratchpad
n then NamedScratchpad
n else NamedScratchpad
x)
nonFloating :: ManageHook
nonFloating :: ManageHook
nonFloating = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *). Foldable t => t Bool -> Bool
or forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((forall a. Query a -> Window -> X a
`runQuery` Window
w) forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedScratchpad -> Query Bool
query)
type NamedScratchpads = [NamedScratchpad]
runApplication :: NamedScratchpad -> X ()
runApplication :: NamedScratchpad -> X ()
runApplication = forall (m :: * -> *). MonadIO m => String -> m ()
spawn forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedScratchpad -> String
cmd
runApplicationHere :: NamedScratchpad -> X ()
runApplicationHere :: NamedScratchpad -> X ()
runApplicationHere = String -> X ()
spawnHere 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 forall a b. (a -> b) -> a -> b
$ 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 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 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) 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 forall a b. (a -> b) -> a -> b
$ \ Window
_lastFocus Window
curFocus WindowSet
winSet Window -> X ()
hideScratch -> do
[Window]
allScratchesButCurrent <-
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
(<||>) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
/= Window
curFocus)) (Window -> NamedScratchpads -> X Bool
`isNSP` NamedScratchpads
scratches))
(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) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Window]
allScratchesButCurrent Window -> X ()
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 = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
winSet -> do
let cur :: String
cur = forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
winSet
forall a. String -> a -> (Window -> Window -> X a) -> X a
withRecentsIn String
cur () 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 (forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces WindowSet
winSet) (forall a b. (a -> b) -> a -> b
$ Window
win)
isWorthy :: Bool
isWorthy =
Window
lastFocus forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall i l a s sd. StackSet i l a s sd -> [a]
W.index WindowSet
winSet Bool -> Bool -> Bool
&& Window
lastFocus forall a. Eq a => a -> a -> Bool
/= Window
curFocus
Bool -> Bool -> Bool
&& String
cur forall a. Eq a => a -> a -> Bool
/= String
scratchpadWorkspaceTag
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isWorthy 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{ Map String NamedScratchpad
nspScratchpads :: Map String NamedScratchpad
nspScratchpads :: NSPState -> Map String NamedScratchpad
nspScratchpads } <- NamedScratchpads -> X NSPState
fillNSPState NamedScratchpads
_ns
case Map String NamedScratchpad
nspScratchpads forall k a. Ord k => Map k a -> k -> Maybe a
!? String
scratchpadName of
Just NamedScratchpad
conf -> forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
winSet -> do
let focusedWspWindows :: [Window]
focusedWspWindows = forall i l a s sd. StackSet i l a s sd -> [a]
W.index WindowSet
winSet
allWindows :: [Window]
allWindows = forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
W.allWindows WindowSet
winSet
[Window]
matchingOnCurrent <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall a. Query a -> Window -> X a
runQuery (NamedScratchpad -> Query Bool
query NamedScratchpad
conf)) [Window]
focusedWspWindows
[Window]
matchingOnAll <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall a. Query a -> Window -> X a
runQuery (NamedScratchpad -> Query Bool
query NamedScratchpad
conf)) [Window]
allWindows
case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Window]
matchingOnCurrent of
Maybe (NonEmpty Window)
Nothing -> do
case 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (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 (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 -> 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
NamedScratchpads
ns <- forall k a. Map k a -> [a]
Map.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. NSPState -> Map String NamedScratchpad
nspScratchpads forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. X a -> Query a
liftX (NamedScratchpads -> X NSPState
fillNSPState NamedScratchpads
nsps)
forall m. Monoid m => [m] -> m
composeAll 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 forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> NamedScratchpad -> ManageHook
hook NamedScratchpad
c) NamedScratchpads
ns
shiftToNSP :: [WindowSpace] -> ((Window -> X ()) -> X ()) -> X ()
shiftToNSP :: [WindowSpace] -> ((Window -> X ()) -> X ()) -> X ()
shiftToNSP [WindowSpace]
ws (Window -> X ()) -> X ()
f = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String
scratchpadWorkspaceTag forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> i
W.tag) [WindowSpace]
ws) forall a b. (a -> b) -> a -> b
$
String -> X ()
addHiddenWorkspace String
scratchpadWorkspaceTag
(Window -> X ()) -> X ()
f ((WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Eq a => a -> a -> Bool
==) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
, hook :: ManageHook
hook = forall a. Monoid a => a
mempty
}
addDynamicNSP :: String -> Window -> X ()
addDynamicNSP :: String -> Window -> X ()
addDynamicNSP String
s Window
w = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify 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 (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 = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify 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 (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 (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) []
toggleDynamicNSP :: String -> Window -> X ()
toggleDynamicNSP :: String -> Window -> X ()
toggleDynamicNSP String
s Window
w = do
NSPState{ Map String NamedScratchpad
nspScratchpads :: Map String NamedScratchpad
nspScratchpads :: NSPState -> Map String NamedScratchpad
nspScratchpads } <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
case Map String NamedScratchpad
nspScratchpads 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 -> forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (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 Map String NamedScratchpads
_ Map String NamedScratchpad
ws <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (Map String NamedScratchpads
-> Map String NamedScratchpad -> NSPState
NSPState (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([String]
-> Map String NamedScratchpads
-> [String]
-> Map String NamedScratchpads
go []) forall a. Monoid a => a
mempty [[String]]
exs) forall a. Monoid a => a
mempty)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map String NamedScratchpad
ws) forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. Functor f => f a -> f ()
void (NamedScratchpads -> X NSPState
fillNSPState (forall k a. Map k a -> [a]
Map.elems Map String NamedScratchpad
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 forall a. a -> [a] -> [a]
: [String]
ms) (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Semigroup a => a -> a -> a
(<>) String
n ([String] -> NamedScratchpads
mkNSP ([String]
ms forall a. Semigroup a => a -> a -> a
<> [String]
ns)) Map String NamedScratchpads
m) [String]
ns
mkNSP :: [String] -> NamedScratchpads
mkNSP = forall a b. (a -> b) -> [a] -> [b]
map (\String
n -> String -> String -> Query Bool -> ManageHook -> NamedScratchpad
NS String
n forall a. Monoid a => a
mempty (forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) forall a. Monoid a => a
mempty)
setNoexclusive :: Window -> X ()
setNoexclusive :: Window -> X ()
setNoexclusive Window
w = do
NSPState Map String NamedScratchpads
_ Map String NamedScratchpad
ws <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
X Bool -> X () -> X ()
whenX (Window -> NamedScratchpads -> X Bool
isNSP Window
w (forall k a. Map k a -> [a]
Map.elems Map String NamedScratchpad
ws)) forall a b. (a -> b) -> a -> b
$
String -> Window -> X ()
addTag String
"_NSP_NOEXCLUSIVE" Window
w
resetFocusedNSP :: X ()
resetFocusedNSP :: X ()
resetFocusedNSP = do
NSPState Map String NamedScratchpads
_ (forall k a. Map k a -> [a]
Map.elems -> NamedScratchpads
ws) <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
(Window -> X ()) -> X ()
withFocused forall a b. (a -> b) -> a -> b
$ \Window
w -> do
Maybe NamedScratchpad
mbWin <- forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM ((forall a. Query a -> Window -> X a
`runQuery` Window
w) forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedScratchpad -> Query Bool
query) NamedScratchpads
ws
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe NamedScratchpad
mbWin forall a b. (a -> b) -> a -> b
$ \NamedScratchpad
win -> do
((WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Endo a -> a -> a
appEndo forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< 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 = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
winSet -> do
NSPState{ Map String NamedScratchpads
nspExclusives :: Map String NamedScratchpads
nspExclusives :: NSPState -> Map String NamedScratchpads
nspExclusives } <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (Map String NamedScratchpads
nspExclusives forall k a. Ord k => Map k a -> k -> Maybe a
!? String
nspWindow) forall a b. (a -> b) -> a -> b
$ \NamedScratchpads
unwanted ->
(Window -> X ()) -> X ()
withFocused forall a b. (a -> b) -> a -> b
$ \Window
w -> X Bool -> X () -> X ()
whenX (forall a. Query a -> Window -> X a
runQuery Query Bool
notIgnored Window
w) forall a b. (a -> b) -> a -> b
$ do
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall i l a s sd. StackSet i l a s sd -> [a]
W.index WindowSet
winSet) forall a b. (a -> b) -> a -> b
$ \Window
win ->
X Bool -> X () -> X ()
whenX (forall a. Query a -> Window -> X a
runQuery (NamedScratchpads -> Query Bool
isUnwanted NamedScratchpads
unwanted) Window
win) forall a b. (a -> b) -> a -> b
$
[WindowSpace] -> ((Window -> X ()) -> X ()) -> X ()
shiftToNSP (forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces WindowSet
winSet) (forall a b. (a -> b) -> a -> b
$ Window
win)
where
notIgnored :: Query Bool
notIgnored :: Query Bool
notIgnored = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem String
"_NSP_NOEXCLUSIVE" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words 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 forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\NamedScratchpad
nsp Query Bool
qs -> Query Bool
qs forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<||> NamedScratchpad -> Query Bool
query NamedScratchpad
nsp) (forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
floatMoveNoexclusive :: Window
-> X ()
floatMoveNoexclusive :: Window -> X ()
floatMoveNoexclusive = forall a. (Window -> X a) -> Window -> X ()
mouseHelper Window -> X ()
mouseMoveWindow
resizeNoexclusive :: Window
-> X ()
resizeNoexclusive :: Window -> X ()
resizeNoexclusive = 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
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> X ()
focus Window
w
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> X a
f Window
w
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (WindowSet -> WindowSet) -> X ()
windows 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 = forall a. (a -> Bool) -> [a] -> [a]
filter (\(W.Workspace String
tag Layout Window
_ Maybe (Stack Window)
_) -> String
tag 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 :: X ([WindowSpace] -> [WindowSpace])
ppSort = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WindowSpace] -> [WindowSpace]
namedScratchpadFilterOutWorkspace) (PP -> X ([WindowSpace] -> [WindowSpace])
ppSort PP
pp)
}
{-# DEPRECATED namedScratchpadFilterOutWorkspacePP "Use XMonad.Hooks.StatusBar.PP.filterOutWsPP [scratchpadWorkspaceTag] instead" #-}