{-# LANGUAGE LambdaCase #-}
module XMonad.Util.ExclusiveScratchpads
{-# DEPRECATED "Use the exclusive scratchpad functionality of \"XMonad.Util.NamedScratchpad\" insead." #-}
(
mkXScratchpads,
xScratchpadsManageHook,
scratchpadAction,
hideAll,
resetExclusiveSp,
setNoexclusive,
resizeNoexclusive,
floatMoveNoexclusive,
ExclusiveScratchpad(..),
ExclusiveScratchpads,
nonFloating,
defaultFloating,
customFloating
) where
import XMonad.Prelude
import XMonad
import XMonad.Actions.Minimize
import XMonad.Actions.TagWindows (addTag,delTag)
import XMonad.Hooks.ManageHelpers (doRectFloat,isInProperty)
import qualified XMonad.StackSet as W
import qualified Data.List.NonEmpty as NE
data ExclusiveScratchpad = XSP { ExclusiveScratchpad -> String
name :: String
, ExclusiveScratchpad -> String
cmd :: String
, ExclusiveScratchpad -> Query Bool
query :: Query Bool
, ExclusiveScratchpad -> ManageHook
hook :: ManageHook
, ExclusiveScratchpad -> [String]
exclusive :: [String]
}
type ExclusiveScratchpads = [ExclusiveScratchpad]
mkXScratchpads :: [(String,String,Query Bool)]
-> ManageHook
-> ExclusiveScratchpads
mkXScratchpads :: [(String, String, Query Bool)]
-> ManageHook -> ExclusiveScratchpads
mkXScratchpads [(String, String, Query Bool)]
xs ManageHook
h = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ExclusiveScratchpads
-> (String, String, Query Bool) -> ExclusiveScratchpads
accumulate [] [(String, String, Query Bool)]
xs
where
accumulate :: ExclusiveScratchpads
-> (String, String, Query Bool) -> ExclusiveScratchpads
accumulate ExclusiveScratchpads
a (String
n,String
c,Query Bool
q) = String
-> String
-> Query Bool
-> ManageHook
-> [String]
-> ExclusiveScratchpad
XSP String
n String
c Query Bool
q ManageHook
h (forall a. (a -> Bool) -> [a] -> [a]
filter (String
nforall a. Eq a => a -> a -> Bool
/=) [String]
names) forall a. a -> [a] -> [a]
: ExclusiveScratchpads
a
names :: [String]
names = forall a b. (a -> b) -> [a] -> [b]
map (\(String
n,String
_,Query Bool
_) -> String
n) [(String, String, Query Bool)]
xs
xScratchpadsManageHook :: ExclusiveScratchpads
-> ManageHook
xScratchpadsManageHook :: ExclusiveScratchpads -> ManageHook
xScratchpadsManageHook = forall m. Monoid m => [m] -> m
composeAll forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ExclusiveScratchpad
sp -> ExclusiveScratchpad -> Query Bool
query ExclusiveScratchpad
sp forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> ExclusiveScratchpad -> ManageHook
hook ExclusiveScratchpad
sp)
scratchpadAction :: ExclusiveScratchpads
-> String
-> X ()
scratchpadAction :: ExclusiveScratchpads -> String -> X ()
scratchpadAction ExclusiveScratchpads
xs String
n =
let ys :: ExclusiveScratchpads
ys = forall a. (a -> Bool) -> [a] -> [a]
filter ((String
nforall a. Eq a => a -> a -> Bool
==)forall b c a. (b -> c) -> (a -> b) -> a -> c
.ExclusiveScratchpad -> String
name) ExclusiveScratchpads
xs in
case ExclusiveScratchpads
ys of [] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
(ExclusiveScratchpad
sp:ExclusiveScratchpads
_) -> let q :: Query Bool
q = ExclusiveScratchpad -> Query Bool
query ExclusiveScratchpad
sp in forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
s -> do
[Window]
ws <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall a. Query a -> Window -> X a
runQuery Query Bool
q) forall a b. (a -> b) -> a -> b
$ forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
W.allWindows WindowSet
s
case [Window]
ws of [] -> do forall (m :: * -> *). MonadIO m => String -> m ()
spawn (ExclusiveScratchpad -> String
cmd ExclusiveScratchpad
sp)
ExclusiveScratchpads -> String -> X ()
hideOthers ExclusiveScratchpads
xs String
n
(WindowSet -> WindowSet) -> X ()
windows forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.shiftMaster
(Window
w:[Window]
_) -> do Window -> X ()
toggleWindow Window
w
X Bool -> X () -> X ()
whenX (forall a. Query a -> Window -> X a
runQuery Query Bool
isExclusive Window
w) (ExclusiveScratchpads -> String -> X ()
hideOthers ExclusiveScratchpads
xs String
n)
where
toggleWindow :: Window -> X ()
toggleWindow Window
w = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) (forall a. Query a -> Window -> X a
runQuery Query Bool
isMaximized Window
w) (Window -> X Bool
onCurrentScreen Window
w) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> X Bool -> X () -> X ()
whenX (Window -> X Bool
onCurrentScreen Window
w) (Window -> X ()
minimizeWindow Window
w)
Bool
False -> do (WindowSet -> WindowSet) -> X ()
windows (forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 Window
w forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall i l a s sd. StackSet i l a s sd -> i
W.currentTag)
Window -> X ()
maximizeWindowAndFocus Window
w
(WindowSet -> WindowSet) -> X ()
windows forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.shiftMaster
onCurrentScreen :: Window -> X Bool
onCurrentScreen Window
w = forall a. (WindowSet -> X a) -> X a
withWindowSet (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Window
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> [a]
currentWindows)
hideAll :: ExclusiveScratchpads
-> X ()
hideAll :: ExclusiveScratchpads -> X ()
hideAll ExclusiveScratchpads
xs = Query Bool -> (Window -> X ()) -> X ()
mapWithCurrentScreen Query Bool
q Window -> X ()
minimizeWindow
where q :: Query Bool
q = [Query Bool] -> Query Bool
joinQueries (forall a b. (a -> b) -> [a] -> [b]
map ExclusiveScratchpad -> Query Bool
query ExclusiveScratchpads
xs) forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> Query Bool
isExclusive forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> Query Bool
isMaximized
resetExclusiveSp :: ExclusiveScratchpads
-> X ()
resetExclusiveSp :: ExclusiveScratchpads -> X ()
resetExclusiveSp ExclusiveScratchpads
xs = (Window -> X ()) -> X ()
withFocused forall a b. (a -> b) -> a -> b
$ \Window
w -> X Bool -> X () -> X ()
whenX (ExclusiveScratchpads -> Window -> X Bool
isScratchpad ExclusiveScratchpads
xs Window
w) forall a b. (a -> b) -> a -> b
$ do
let ys :: X ExclusiveScratchpads
ys = forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Query a -> Window -> X a
runQuery Window
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExclusiveScratchpad -> Query Bool
query) ExclusiveScratchpads
xs
X Bool -> X () -> X ()
unlessX (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X ExclusiveScratchpads
ys) forall a b. (a -> b) -> a -> b
$ do
ManageHook
mh <- forall a. NonEmpty a -> a
NE.head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => [a] -> NonEmpty a
notEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ExclusiveScratchpad -> ManageHook
hook forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X ExclusiveScratchpads
ys
String
n <- forall a. NonEmpty a -> a
NE.head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => [a] -> NonEmpty a
notEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ExclusiveScratchpad -> String
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X ExclusiveScratchpads
ys
((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 ManageHook
mh) Window
w
ExclusiveScratchpads -> String -> X ()
hideOthers ExclusiveScratchpads
xs String
n
String -> Window -> X ()
delTag String
"_XSP_NOEXCLUSIVE" Window
w
where unlessX :: X Bool -> X () -> X ()
unlessX = X Bool -> X () -> X ()
whenX forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not
hideOthers :: ExclusiveScratchpads -> String -> X ()
hideOthers :: ExclusiveScratchpads -> String -> X ()
hideOthers ExclusiveScratchpads
xs String
n =
let ys :: [String]
ys = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ExclusiveScratchpad -> [String]
exclusive forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((String
nforall a. Eq a => a -> a -> Bool
==)forall b c a. (b -> c) -> (a -> b) -> a -> c
.ExclusiveScratchpad -> String
name) ExclusiveScratchpads
xs
qs :: [Query Bool]
qs = forall a b. (a -> b) -> [a] -> [b]
map ExclusiveScratchpad -> Query Bool
query forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ys)forall b c a. (b -> c) -> (a -> b) -> a -> c
.ExclusiveScratchpad -> String
name) ExclusiveScratchpads
xs
q :: Query Bool
q = [Query Bool] -> Query Bool
joinQueries [Query Bool]
qs forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> Query Bool
isExclusive forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> Query Bool
isMaximized in
Query Bool -> (Window -> X ()) -> X ()
mapWithCurrentScreen Query Bool
q Window -> X ()
minimizeWindow
mapWithCurrentScreen :: Query Bool -> (Window -> X ()) -> X ()
mapWithCurrentScreen :: Query Bool -> (Window -> X ()) -> X ()
mapWithCurrentScreen Query Bool
q Window -> X ()
f = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
s -> do
[Window]
ws <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall a. Query a -> Window -> X a
runQuery Query Bool
q) forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> [a]
currentWindows WindowSet
s
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Window -> X ()
f [Window]
ws
currentWindows :: W.StackSet i l a sid sd -> [a]
currentWindows :: forall i l a sid sd. StackSet i l a sid sd -> [a]
currentWindows = forall a. Maybe (Stack a) -> [a]
W.integrate' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current
isScratchpad :: ExclusiveScratchpads -> Window -> X Bool
isScratchpad :: ExclusiveScratchpads -> Window -> X Bool
isScratchpad ExclusiveScratchpads
xs Window
w = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
s -> do
let q :: Query Bool
q = [Query Bool] -> Query Bool
joinQueries forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ExclusiveScratchpad -> Query Bool
query ExclusiveScratchpads
xs
[Window]
ws <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall a. Query a -> Window -> X a
runQuery Query Bool
q) forall a b. (a -> b) -> a -> b
$ forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
W.allWindows WindowSet
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Window
w [Window]
ws
joinQueries :: [Query Bool] -> Query Bool
joinQueries :: [Query Bool] -> Query Bool
joinQueries = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
(<||>) (forall a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
isExclusive, isMaximized :: Query Bool
isExclusive :: Query Bool
isExclusive = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem String
"_XSP_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"
isMaximized :: Query Bool
isMaximized = Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Query Bool
isInProperty String
"_NET_WM_STATE" String
"_NET_WM_STATE_HIDDEN"
setNoexclusive :: ExclusiveScratchpads
-> Window
-> X ()
setNoexclusive :: ExclusiveScratchpads -> Window -> X ()
setNoexclusive ExclusiveScratchpads
xs Window
w = X Bool -> X () -> X ()
whenX (ExclusiveScratchpads -> Window -> X Bool
isScratchpad ExclusiveScratchpads
xs Window
w) forall a b. (a -> b) -> a -> b
$ String -> Window -> X ()
addTag String
"_XSP_NOEXCLUSIVE" Window
w
floatMoveNoexclusive :: ExclusiveScratchpads
-> Window
-> X ()
floatMoveNoexclusive :: ExclusiveScratchpads -> Window -> X ()
floatMoveNoexclusive ExclusiveScratchpads
xs Window
w = ExclusiveScratchpads -> Window -> X ()
setNoexclusive ExclusiveScratchpads
xs 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 ()
mouseMoveWindow 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
resizeNoexclusive :: ExclusiveScratchpads
-> Window
-> X ()
resizeNoexclusive :: ExclusiveScratchpads -> Window -> X ()
resizeNoexclusive ExclusiveScratchpads
xs Window
w = ExclusiveScratchpads -> Window -> X ()
setNoexclusive ExclusiveScratchpads
xs 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 ()
mouseResizeWindow 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
nonFloating :: ManageHook
nonFloating :: ManageHook
nonFloating = forall m. Monoid m => m
idHook
defaultFloating :: ManageHook
defaultFloating :: ManageHook
defaultFloating = ManageHook
doFloat
customFloating :: W.RationalRect
-> ManageHook
customFloating :: RationalRect -> ManageHook
customFloating = RationalRect -> ManageHook
doRectFloat