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
187
188
189
190
191
|
{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.UrgencyHook
-- Copyright : Devin Mullins <me@twifkak.com>
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Devin Mullins <me@twifkak.com>
-- Stability : unstable
-- Portability : unportable
--
-- UrgencyHook lets you configure an action to occur when a window demands
-- your attention. (In traditional WMs, this takes the form of \"flashing\"
-- on your \"taskbar.\" Blech.)
--
-----------------------------------------------------------------------------
module XMonad.Hooks.UrgencyHook (
-- * Usage
-- $usage
withUrgencyHook,
focusUrgent,
readUrgents, withUrgents,
urgencyLayoutHook,
NoUrgencyHook(..), StdoutUrgencyHook(..),
dzenUrgencyHook, DzenUrgencyHook(..),
seconds
) where
import XMonad
import XMonad.Operations (windows)
import qualified XMonad.StackSet as W
import XMonad.Layout.LayoutModifier hiding (hook)
import XMonad.Util.Dzen (dzenWithArgs, seconds)
import XMonad.Util.NamedWindows (getName)
import Control.Monad (when)
import Control.Monad.Reader (asks)
import Control.Monad.State (gets)
import Data.Bits (testBit, clearBit)
import Data.IORef
import Data.List ((\\), delete)
import Data.Maybe (listToMaybe)
import qualified Data.Set as S
import Foreign (unsafePerformIO)
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras
-- $usage
-- To wire this up, first add:
--
-- > import XMonad.Hooks.UrgencyHook
--
-- to your import list in your config file. Now, choose an urgency hook. If
-- you're just interested in displaying the urgency state in your custom
-- logHook, then choose NoUrgencyHook. Otherwise, you may use the provided
-- 'dzenUrgencyHook', or write your own.
--
-- Enable your urgency hook by wrapping your config record in a call to
-- 'withUrgencyHook'. For example:
--
-- > main = xmonad $ withUrgencyHook dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"] }
-- > $ defaultConfig
--
-- If you want to modify your logHook to print out information about urgent windows,
-- the functions 'readUrgents' and 'withUrgents' are there to help you with that.
-- No example for you.
-- | This is the preferred method of enabling an urgency hook. It will prepend
-- an action to your logHook that removes visible windows from the list of urgent
-- windows. If you don't like that behavior, you may use 'urgencyLayoutHook' instead.
withUrgencyHook :: (LayoutClass l Window, UrgencyHook h Window) =>
h -> XConfig l -> XConfig (ModifiedLayout (WithUrgencyHook h) l)
withUrgencyHook hook conf = conf { layoutHook = urgencyLayoutHook hook $ layoutHook conf
, logHook = removeVisiblesFromUrgents >> logHook conf
}
-- | The logHook action used by 'withUrgencyHook'.
removeVisiblesFromUrgents :: X ()
removeVisiblesFromUrgents = do
visibles <- gets mapped
adjustUrgents (\\ (S.toList visibles))
-- | Focuses the most recently urgent window. Good for what ails ya -- I mean, your keybindings.
-- Example keybinding:
--
-- > , ((modMask , xK_BackSpace), focusUrgent)
focusUrgent :: X ()
focusUrgent = withUrgents $ flip whenJust (windows . W.focusWindow) . listToMaybe
-- | Stores the global set of all urgent windows, across workspaces. Not exported -- use
-- 'readUrgents' or 'withUrgents' instead.
{-# NOINLINE urgents #-}
urgents :: IORef [Window]
urgents = unsafePerformIO (newIORef [])
-- (Hey, I don't like it any more than you do.)
-- | X action that returns a list of currently urgent windows. You might use
-- it, or 'withUrgents', in your custom logHook, to display the workspaces that
-- contain urgent windows.
readUrgents :: X [Window]
readUrgents = io $ readIORef urgents
-- | An HOF version of 'readUrgents', for those who prefer that sort of thing.
withUrgents :: ([Window] -> X a) -> X a
withUrgents f = readUrgents >>= f
data WithUrgencyHook h a = WithUrgencyHook h deriving (Read, Show)
-- The Non-ICCCM Manifesto:
-- Note: Some non-standard choices have been made in this implementation to
-- account for the fact that things are different in a tiling window manager:
-- 1. Several clients (e.g. Xchat2, rxvt-unicode) set the urgency flag
-- 9 or 10 times in a row. This would, in turn, trigger urgencyHook repeatedly.
-- so in order to prevent that, we immediately clear the urgency flag.
-- 2. In normal window managers, windows may overlap, so clients wait for focus to
-- be set before urgency is cleared. In a tiling WM, it's sufficient to be able
-- see the window, since we know that means you can see it completely.
-- 3. The urgentOnBell setting in rxvt-unicode sets urgency even when the window
-- has focus, and won't clear until it loses and regains focus. This is stupid.
-- In order to account for these quirks, we clear the urgency bit immediately upon
-- receiving notification (thus suppressing the repeated notifications) and track
-- the list of urgent windows ourselves, allowing us to clear urgency when a window
-- is visible, and not to set urgency if a window is visible.
-- If you have a better idea, please, let us know!
instance UrgencyHook h Window => LayoutModifier (WithUrgencyHook h) Window where
handleMess (WithUrgencyHook hook) mess
| Just PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } <- fromMessage mess = do
when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do
wmh@WMHints { wmh_flags = flags } <- io $ getWMHints dpy w
when (testBit flags urgencyHintBit) $ do
-- Call the urgencyHook.
userCode $ urgencyHook hook w
-- Clear the bit to prevent repeated notifications, as described above.
io $ setWMHints dpy w wmh { wmh_flags = clearBit flags urgencyHintBit }
-- Add to list of urgents.
adjustUrgents (\ws -> if elem w ws then ws else w : ws)
-- Call logHook after IORef has been modified.
userCode =<< asks (logHook . config)
return Nothing
| Just DestroyWindowEvent {ev_window = w} <- fromMessage mess = do
adjustUrgents (delete w)
return Nothing
| otherwise =
return Nothing
adjustUrgents :: ([Window] -> [Window]) -> X ()
adjustUrgents f = io $ modifyIORef urgents f
urgencyLayoutHook :: (UrgencyHook h Window, LayoutClass l Window) =>
h -> l Window -> ModifiedLayout (WithUrgencyHook h) l Window
urgencyLayoutHook hook = ModifiedLayout $ WithUrgencyHook hook
--------------------------------------------------------------------------------
-- Urgency Hooks
-- | The class definition, and some pre-defined instances.
class (Read h, Show h) => UrgencyHook h a where
urgencyHook :: h -> a -> X ()
data NoUrgencyHook = NoUrgencyHook deriving (Read, Show)
instance UrgencyHook NoUrgencyHook Window where
urgencyHook _ _ = return ()
data DzenUrgencyHook = DzenUrgencyHook { duration :: Int, args :: [String] }
deriving (Read, Show)
instance UrgencyHook DzenUrgencyHook Window where
urgencyHook DzenUrgencyHook { duration = d, args = a } w = do
visibles <- gets mapped
name <- getName w
ws <- gets windowset
whenJust (W.findTag w ws) (flash name visibles)
where flash name visibles index =
when (not $ S.member w visibles) $
dzenWithArgs (show name ++ " requests your attention on workspace " ++ index) a d
-- | Flashes when a window requests your attention and you can't see it. Configurable
-- duration and args to dzen.
dzenUrgencyHook :: DzenUrgencyHook
dzenUrgencyHook = DzenUrgencyHook { duration = (5 `seconds`), args = [] }
-- For debugging purposes, really.
data StdoutUrgencyHook = StdoutUrgencyHook deriving (Read, Show)
instance UrgencyHook StdoutUrgencyHook Window where
urgencyHook _ w = io $ putStrLn $ "Urgent: " ++ show w
|
