module XMonad.Hooks.ManageHelpers (
Side(..),
composeOne,
(-?>), (/=?), (<==?), (</=?), (-->>), (-?>>),
currentWs,
isInProperty,
isKDETrayWindow,
isFullscreen,
isDialog,
pid,
transientTo,
maybeToDefinite,
MaybeManageHook,
transience,
transience',
doRectFloat,
doFullFloat,
doCenterFloat,
doSideFloat,
doFloatAt,
doFloatDep,
doHideIgnore,
Match,
) where
import XMonad
import qualified XMonad.StackSet as W
import XMonad.Util.WindowProperties (getProp32s)
import Data.Maybe
import Data.Monoid
import System.Posix (ProcessID)
data Side = SC | NC | CE | CW | SE | SW | NE | NW | C
deriving (ReadPrec [Side]
ReadPrec Side
Int -> ReadS Side
ReadS [Side]
(Int -> ReadS Side)
-> ReadS [Side] -> ReadPrec Side -> ReadPrec [Side] -> Read Side
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Side]
$creadListPrec :: ReadPrec [Side]
readPrec :: ReadPrec Side
$creadPrec :: ReadPrec Side
readList :: ReadS [Side]
$creadList :: ReadS [Side]
readsPrec :: Int -> ReadS Side
$creadsPrec :: Int -> ReadS Side
Read, Int -> Side -> ShowS
[Side] -> ShowS
Side -> String
(Int -> Side -> ShowS)
-> (Side -> String) -> ([Side] -> ShowS) -> Show Side
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Side] -> ShowS
$cshowList :: [Side] -> ShowS
show :: Side -> String
$cshow :: Side -> String
showsPrec :: Int -> Side -> ShowS
$cshowsPrec :: Int -> Side -> ShowS
Show, Side -> Side -> Bool
(Side -> Side -> Bool) -> (Side -> Side -> Bool) -> Eq Side
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Side -> Side -> Bool
$c/= :: Side -> Side -> Bool
== :: Side -> Side -> Bool
$c== :: Side -> Side -> Bool
Eq)
type MaybeManageHook = Query (Maybe (Endo WindowSet))
data Match a = Match Bool a
composeOne :: [MaybeManageHook] -> ManageHook
composeOne :: [MaybeManageHook] -> ManageHook
composeOne = (MaybeManageHook -> ManageHook -> ManageHook)
-> ManageHook -> [MaybeManageHook] -> ManageHook
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr MaybeManageHook -> ManageHook -> ManageHook
forall (m :: * -> *) b. Monad m => m (Maybe b) -> m b -> m b
try ManageHook
forall m. Monoid m => m
idHook
where
try :: m (Maybe b) -> m b -> m b
try m (Maybe b)
q m b
z = do
Maybe b
x <- m (Maybe b)
q
case Maybe b
x of
Just b
h -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
h
Maybe b
Nothing -> m b
z
infixr 0 -?>, -->>, -?>>
(/=?) :: Eq a => Query a -> a -> Query Bool
Query a
q /=? :: Query a -> a -> Query Bool
/=? a
x = (a -> Bool) -> Query a -> Query Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
x) Query a
q
(<==?) :: Eq a => Query a -> a -> Query (Match a)
Query a
q <==? :: Query a -> a -> Query (Match a)
<==? a
x = (a -> Match a) -> Query a -> Query (Match a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> Match a
forall a. Eq a => a -> a -> Match a
`eq` a
x) Query a
q
where
eq :: a -> a -> Match a
eq a
q' a
x' = Bool -> a -> Match a
forall a. Bool -> a -> Match a
Match (a
q' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x') a
q'
(</=?) :: Eq a => Query a -> a -> Query (Match a)
Query a
q </=? :: Query a -> a -> Query (Match a)
</=? a
x = (a -> Match a) -> Query a -> Query (Match a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> Match a
forall a. Eq a => a -> a -> Match a
`neq` a
x) Query a
q
where
neq :: a -> a -> Match a
neq a
q' a
x' = Bool -> a -> Match a
forall a. Bool -> a -> Match a
Match (a
q' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
x') a
q'
(-?>) :: Query Bool -> ManageHook -> MaybeManageHook
Query Bool
p -?> :: Query Bool -> ManageHook -> MaybeManageHook
-?> ManageHook
f = do
Bool
x <- Query Bool
p
if Bool
x then (Endo WindowSet -> Maybe (Endo WindowSet))
-> ManageHook -> MaybeManageHook
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Endo WindowSet -> Maybe (Endo WindowSet)
forall a. a -> Maybe a
Just ManageHook
f else Maybe (Endo WindowSet) -> MaybeManageHook
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Endo WindowSet)
forall a. Maybe a
Nothing
(-->>) :: Query (Match a) -> (a -> ManageHook) -> ManageHook
Query (Match a)
p -->> :: Query (Match a) -> (a -> ManageHook) -> ManageHook
-->> a -> ManageHook
f = do
Match Bool
b a
m <- Query (Match a)
p
if Bool
b then (a -> ManageHook
f a
m) else ManageHook
forall m. Monoid m => m
mempty
(-?>>) :: Query (Match a) -> (a -> ManageHook) -> MaybeManageHook
Query (Match a)
p -?>> :: Query (Match a) -> (a -> ManageHook) -> MaybeManageHook
-?>> a -> ManageHook
f = do
Match Bool
b a
m <- Query (Match a)
p
if Bool
b then (Endo WindowSet -> Maybe (Endo WindowSet))
-> ManageHook -> MaybeManageHook
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Endo WindowSet -> Maybe (Endo WindowSet)
forall a. a -> Maybe a
Just (a -> ManageHook
f a
m) else Maybe (Endo WindowSet) -> MaybeManageHook
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Endo WindowSet)
forall a. Maybe a
Nothing
currentWs :: Query WorkspaceId
currentWs :: Query String
currentWs = X String -> Query String
forall a. X a -> Query a
liftX ((WindowSet -> X String) -> X String
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X String) -> X String)
-> (WindowSet -> X String) -> X String
forall a b. (a -> b) -> a -> b
$ String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> X String)
-> (WindowSet -> String) -> WindowSet -> X String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> String
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag)
isKDETrayWindow :: Query Bool
isKDETrayWindow :: Query Bool
isKDETrayWindow = Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask Query Window -> (Window -> Query Bool) -> Query Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> X Bool -> Query Bool
forall a. X a -> Query a
liftX (X Bool -> Query Bool) -> X Bool -> Query Bool
forall a b. (a -> b) -> a -> b
$ do
Maybe [CLong]
r <- String -> Window -> X (Maybe [CLong])
getProp32s String
"_KDE_NET_WM_SYSTEM_TRAY_WINDOW_FOR" Window
w
Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> X Bool) -> Bool -> X Bool
forall a b. (a -> b) -> a -> b
$ case Maybe [CLong]
r of
Just [CLong
_] -> Bool
True
Maybe [CLong]
_ -> Bool
False
isInProperty :: String -> String -> Query Bool
isInProperty :: String -> String -> Query Bool
isInProperty String
p String
v = Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask Query Window -> (Window -> Query Bool) -> Query Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> X Bool -> Query Bool
forall a. X a -> Query a
liftX (X Bool -> Query Bool) -> X Bool -> Query Bool
forall a b. (a -> b) -> a -> b
$ do
Window
va <- String -> X Window
getAtom String
v
Maybe [CLong]
r <- String -> Window -> X (Maybe [CLong])
getProp32s String
p Window
w
Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> X Bool) -> Bool -> X Bool
forall a b. (a -> b) -> a -> b
$ case Maybe [CLong]
r of
Just [CLong]
xs -> Window -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Window
va CLong -> [CLong] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CLong]
xs
Maybe [CLong]
_ -> Bool
False
isFullscreen :: Query Bool
isFullscreen :: Query Bool
isFullscreen = String -> String -> Query Bool
isInProperty String
"_NET_WM_STATE" String
"_NET_WM_STATE_FULLSCREEN"
isDialog :: Query Bool
isDialog :: Query Bool
isDialog = String -> String -> Query Bool
isInProperty String
"_NET_WM_WINDOW_TYPE" String
"_NET_WM_WINDOW_TYPE_DIALOG"
pid :: Query (Maybe ProcessID)
pid :: Query (Maybe ProcessID)
pid = Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask Query Window
-> (Window -> Query (Maybe ProcessID)) -> Query (Maybe ProcessID)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> X (Maybe ProcessID) -> Query (Maybe ProcessID)
forall a. X a -> Query a
liftX (X (Maybe ProcessID) -> Query (Maybe ProcessID))
-> X (Maybe ProcessID) -> Query (Maybe ProcessID)
forall a b. (a -> b) -> a -> b
$ do
Maybe [CLong]
p <- String -> Window -> X (Maybe [CLong])
getProp32s String
"_NET_WM_PID" Window
w
Maybe ProcessID -> X (Maybe ProcessID)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ProcessID -> X (Maybe ProcessID))
-> Maybe ProcessID -> X (Maybe ProcessID)
forall a b. (a -> b) -> a -> b
$ case Maybe [CLong]
p of
Just [CLong
x] -> ProcessID -> Maybe ProcessID
forall a. a -> Maybe a
Just (CLong -> ProcessID
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
x)
Maybe [CLong]
_ -> Maybe ProcessID
forall a. Maybe a
Nothing
transientTo :: Query (Maybe Window)
transientTo :: Query (Maybe Window)
transientTo = do
Window
w <- Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask
Display
d <- (X Display -> Query Display
forall a. X a -> Query a
liftX (X Display -> Query Display)
-> ((XConf -> Display) -> X Display)
-> (XConf -> Display)
-> Query Display
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks) XConf -> Display
display
IO (Maybe Window) -> Query (Maybe Window)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Window) -> Query (Maybe Window))
-> IO (Maybe Window) -> Query (Maybe Window)
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO (Maybe Window)
getTransientForHint Display
d Window
w
transience :: MaybeManageHook
transience :: MaybeManageHook
transience = Query (Maybe Window)
transientTo Query (Maybe Window)
-> Maybe Window -> Query (Match (Maybe Window))
forall a. Eq a => Query a -> a -> Query (Match a)
</=? Maybe Window
forall a. Maybe a
Nothing Query (Match (Maybe Window))
-> (Maybe Window -> ManageHook) -> MaybeManageHook
forall a. Query (Match a) -> (a -> ManageHook) -> MaybeManageHook
-?>> Maybe Window -> ManageHook
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
Maybe a -> Query (Endo (StackSet i l a s sd))
move
where
move :: Maybe a -> Query (Endo (StackSet i l a s sd))
move Maybe a
mw = Query (Endo (StackSet i l a s sd))
-> (a -> Query (Endo (StackSet i l a s sd)))
-> Maybe a
-> Query (Endo (StackSet i l a s sd))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Query (Endo (StackSet i l a s sd))
forall m. Monoid m => m
idHook ((StackSet i l a s sd -> StackSet i l a s sd)
-> Query (Endo (StackSet i l a s sd))
forall s. (s -> s) -> Query (Endo s)
doF ((StackSet i l a s sd -> StackSet i l a s sd)
-> Query (Endo (StackSet i l a s sd)))
-> (a -> StackSet i l a s sd -> StackSet i l a s sd)
-> a
-> Query (Endo (StackSet i l a s sd))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StackSet i l a s sd -> StackSet i l a s sd
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
move') Maybe a
mw
move' :: a -> StackSet i l a s sd -> StackSet i l a s sd
move' a
w StackSet i l a s sd
s = StackSet i l a s sd
-> (i -> StackSet i l a s sd) -> Maybe i -> StackSet i l a s sd
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StackSet i l a s sd
s (i -> StackSet i l a s sd -> StackSet i l a s sd
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
`W.shift` StackSet i l a s sd
s) (a -> StackSet i l a s sd -> Maybe i
forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
W.findTag a
w StackSet i l a s sd
s)
transience' :: ManageHook
transience' :: ManageHook
transience' = MaybeManageHook -> ManageHook
maybeToDefinite MaybeManageHook
transience
maybeToDefinite :: MaybeManageHook -> ManageHook
maybeToDefinite :: MaybeManageHook -> ManageHook
maybeToDefinite = (Maybe (Endo WindowSet) -> Endo WindowSet)
-> MaybeManageHook -> ManageHook
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Endo WindowSet -> Maybe (Endo WindowSet) -> Endo WindowSet
forall a. a -> Maybe a -> a
fromMaybe Endo WindowSet
forall m. Monoid m => m
mempty)
doRectFloat :: W.RationalRect
-> ManageHook
doRectFloat :: RationalRect -> ManageHook
doRectFloat RationalRect
r = Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask Query Window -> (Window -> ManageHook) -> ManageHook
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> (WindowSet -> WindowSet) -> ManageHook
forall s. (s -> s) -> Query (Endo s)
doF (Window -> RationalRect -> WindowSet -> WindowSet
forall a i l s sd.
Ord a =>
a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd
W.float Window
w RationalRect
r)
doFullFloat :: ManageHook
doFullFloat :: ManageHook
doFullFloat = RationalRect -> ManageHook
doRectFloat (RationalRect -> ManageHook) -> RationalRect -> ManageHook
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect Rational
0 Rational
0 Rational
1 Rational
1
doFloatDep :: (W.RationalRect -> W.RationalRect) -> ManageHook
doFloatDep :: (RationalRect -> RationalRect) -> ManageHook
doFloatDep RationalRect -> RationalRect
move = Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask Query Window -> (Window -> ManageHook) -> ManageHook
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> (WindowSet -> WindowSet) -> ManageHook
forall s. (s -> s) -> Query (Endo s)
doF ((WindowSet -> WindowSet) -> ManageHook)
-> ((ScreenId, RationalRect) -> WindowSet -> WindowSet)
-> (ScreenId, RationalRect)
-> ManageHook
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> RationalRect -> WindowSet -> WindowSet
forall a i l s sd.
Ord a =>
a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd
W.float Window
w (RationalRect -> WindowSet -> WindowSet)
-> ((ScreenId, RationalRect) -> RationalRect)
-> (ScreenId, RationalRect)
-> WindowSet
-> WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RationalRect -> RationalRect
move (RationalRect -> RationalRect)
-> ((ScreenId, RationalRect) -> RationalRect)
-> (ScreenId, RationalRect)
-> RationalRect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenId, RationalRect) -> RationalRect
forall a b. (a, b) -> b
snd ((ScreenId, RationalRect) -> ManageHook)
-> Query (ScreenId, RationalRect) -> ManageHook
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X (ScreenId, RationalRect) -> Query (ScreenId, RationalRect)
forall a. X a -> Query a
liftX (Window -> X (ScreenId, RationalRect)
floatLocation Window
w)
doFloatAt :: Rational -> Rational -> ManageHook
doFloatAt :: Rational -> Rational -> ManageHook
doFloatAt Rational
x Rational
y = (RationalRect -> RationalRect) -> ManageHook
doFloatDep RationalRect -> RationalRect
move
where
move :: RationalRect -> RationalRect
move (W.RationalRect Rational
_ Rational
_ Rational
w Rational
h) = Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect Rational
x Rational
y Rational
w Rational
h
doSideFloat :: Side -> ManageHook
doSideFloat :: Side -> ManageHook
doSideFloat Side
side = (RationalRect -> RationalRect) -> ManageHook
doFloatDep RationalRect -> RationalRect
move
where
move :: RationalRect -> RationalRect
move (W.RationalRect Rational
_ Rational
_ Rational
w Rational
h) = Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect Rational
cx Rational
cy Rational
w Rational
h
where cx :: Rational
cx = if Side
side Side -> [Side] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Side
SC,Side
C ,Side
NC] then (Rational
1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
w)Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2
else if Side
side Side -> [Side] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Side
SW,Side
CW,Side
NW] then Rational
0
else Rational
1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
w
cy :: Rational
cy = if Side
side Side -> [Side] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Side
CE,Side
C ,Side
CW] then (Rational
1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
h)Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2
else if Side
side Side -> [Side] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Side
NE,Side
NC,Side
NW] then Rational
0
else Rational
1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
h
doCenterFloat :: ManageHook
doCenterFloat :: ManageHook
doCenterFloat = Side -> ManageHook
doSideFloat Side
C
doHideIgnore :: ManageHook
doHideIgnore :: ManageHook
doHideIgnore = Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask Query Window -> (Window -> ManageHook) -> ManageHook
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> X () -> Query ()
forall a. X a -> Query a
liftX (Window -> X ()
hide Window
w) Query () -> ManageHook -> ManageHook
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (WindowSet -> WindowSet) -> ManageHook
forall s. (s -> s) -> Query (Endo s)
doF (Window -> WindowSet -> WindowSet
forall a i l s sd.
Ord a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.delete Window
w)