1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.ManageHelpers
-- Copyright : (c) Lukas Mai
-- License : BSD
--
-- Maintainer : Lukas Mai <l.mai@web.de>
-- Stability : unstable
-- Portability : unportable
--
-- This module provides helper functions to be used in @manageHook@. Here's
-- how you might use this:
--
-- > import XMonad.Hooks.ManageHelpers
-- > main =
-- > xmonad defaultConfig{
-- > ...
-- > manageHook = composeOne [
-- > isKDETrayWindow -?> doIgnore,
-- > transience,
-- > isFullscreen -?> doFullFloat,
-- > resource =? "stalonetray" -?> doIgnore
-- > ],
-- > ...
-- > }
module XMonad.Hooks.ManageHelpers (
Side(..),
composeOne,
(-?>), (/=?), (<==?), (</=?), (-->>), (-?>>),
isKDETrayWindow,
isFullscreen,
transientTo,
maybeToDefinite,
MaybeManageHook,
transience,
transience',
doRectFloat,
doFullFloat,
doCenterFloat,
doSideFloat
) where
import XMonad
import qualified XMonad.StackSet as W
import Data.Maybe
import Data.Monoid
-- | Denotes a side of a screen. @S@ stands for South, @NE@ for Northwest
-- etc. @C@ stands for Center.
data Side = SC | NC | CE | CW | SE | SW | NE | NW | C
deriving (Read, Show, Eq)
-- | A ManageHook that may or may not have been executed; the outcome is embedded in the Maybe
type MaybeManageHook = Query (Maybe (Endo WindowSet))
-- | A grouping type, which can hold the outcome of a predicate Query.
-- This is analogous to group types in regular expressions.
-- TODO: create a better API for aggregating multiple Matches logically
data Match a = Match Bool a
-- | An alternative 'ManageHook' composer. Unlike 'composeAll' it stops as soon as
-- a candidate returns a 'Just' value, effectively running only the first match
-- (whereas 'composeAll' continues and executes all matching rules).
composeOne :: [MaybeManageHook] -> ManageHook
composeOne = foldr try idHook
where
try q z = do
x <- q
case x of
Just h -> return h
Nothing -> z
infixr 0 -?>, -->>, -?>>
-- | q \/=? x. if the result of q equals x, return False
(/=?) :: Eq a => Query a -> a -> Query Bool
q /=? x = fmap (/= x) q
-- | q <==? x. if the result of q equals x, return True grouped with q
(<==?) :: Eq a => Query a -> a -> Query (Match a)
q <==? x = fmap (`eq` x) q
where
eq q' x' = Match (q' == x') q'
-- | q <\/=? x. if the result of q notequals x, return True grouped with q
(</=?) :: Eq a => Query a -> a -> Query (Match a)
q </=? x = fmap (`neq` x) q
where
neq q' x' = Match (q' /= x') q'
-- | A helper operator for use in 'composeOne'. It takes a condition and an action;
-- if the condition fails, it returns 'Nothing' from the 'Query' so 'composeOne' will
-- go on and try the next rule.
(-?>) :: Query Bool -> ManageHook -> MaybeManageHook
p -?> f = do
x <- p
if x then fmap Just f else return Nothing
-- | A helper operator for use in 'composeAll'. It takes a condition and a function taking a grouped datum to action. If 'p' is true, it executes the resulting action.
(-->>) :: Query (Match a) -> (a -> ManageHook) -> ManageHook
p -->> f = do
Match b m <- p
if b then (f m) else mempty
-- | A helper operator for use in 'composeOne'. It takes a condition and a function taking a groupdatum to action. If 'p' is true, it executes the resulting action. If it fails, it returns 'Nothing' from the 'Query' so 'composeOne' will go on and try the next rule.
(-?>>) :: Query (Match a) -> (a -> ManageHook) -> MaybeManageHook
p -?>> f = do
Match b m <- p
if b then fmap Just (f m) else return Nothing
-- | A predicate to check whether a window is a KDE system tray icon.
isKDETrayWindow :: Query Bool
isKDETrayWindow = ask >>= \w -> liftX $ do
dpy <- asks display
kde_tray <- getAtom "_KDE_NET_WM_SYSTEM_TRAY_WINDOW_FOR"
r <- io $ getWindowProperty32 dpy kde_tray w
return $ case r of
Just [_] -> True
_ -> False
-- | A predicate to check whether a window wants to fill the whole screen.
-- See also 'doFullFloat'.
isFullscreen :: Query Bool
isFullscreen = ask >>= \w -> liftX $ do
dpy <- asks display
state <- getAtom "_NET_WM_STATE"
full <- getAtom "_NET_WM_STATE_FULLSCREEN"
r <- io $ getWindowProperty32 dpy state w
return $ case r of
Just xs -> fromIntegral full `elem` xs
_ -> False
-- | A predicate to check whether a window is Transient.
-- It holds the result which might be the window it is transient to
-- or it might be 'Nothing'.
transientTo :: Query (Maybe Window)
transientTo = do
w <- ask
d <- (liftX . asks) display
liftIO $ getTransientForHint d w
-- | A convenience 'MaybeManageHook' that will check to see if a window
-- is transient, and then move it to its parent.
transience :: MaybeManageHook
transience = transientTo </=? Nothing -?>> move
where
move mw = maybe idHook (doF . move') mw
move' w s = maybe s (`W.shift` s) (W.findTag w s)
-- | 'transience' set to a 'ManageHook'
transience' :: ManageHook
transience' = maybeToDefinite transience
-- | converts 'MaybeManageHook's to 'ManageHook's
maybeToDefinite :: MaybeManageHook -> ManageHook
maybeToDefinite = fmap (fromMaybe mempty)
-- | Floats the new window in the given rectangle.
doRectFloat :: W.RationalRect -- ^ The rectangle to float the window in. 0 to 1; x, y, w, h.
-> ManageHook
doRectFloat r = ask >>= \w -> doF (W.float w r)
-- | Floats the window and makes it use the whole screen. Equivalent to
-- @'doRectFloat' $ 'W.RationalRect' 0 0 1 1@.
doFullFloat :: ManageHook
doFullFloat = doRectFloat $ W.RationalRect 0 0 1 1
-- | Floats a new window with its original size on the specified side of a
-- screen
doSideFloat :: Side -> ManageHook
doSideFloat side = ask >>= \w -> doF . W.float w . move . snd =<< liftX (floatLocation w)
where
move (W.RationalRect _ _ w h) = W.RationalRect cx cy w h
where
cx = if side `elem` [SC,C ,NC] then (1-w)/2
else if side `elem` [SW,CW,NW] then 0
else {- side `elem` [SE,CE,NE] -} 1-w
cy = if side `elem` [CE,C ,CW] then (1-h)/2
else if side `elem` [NE,NC,NW] then 0
else {- side `elem` [SE,SC,SW] -} 1-h
-- | Floats a new window with its original size, but centered.
doCenterFloat :: ManageHook
doCenterFloat = doSideFloat C
|
