Merge branch 'pr/urgencyhook'

CHANGES.md

@@ -321,6 +321,8 @@
       that shifts a window to the workspace of other windows of the application
       (using either the `WM_CLIENT_LEADER` or `_NET_WM_PID` property).
 
+    - Added `windowTag`
+
   * `XMonad.Util.EZConfig`
 
     - Added support for XF86Bluetooth.
@@ -417,6 +419,15 @@
     - Fixed handling of floating window borders in multihead setups that was
       broken since 0.14.
 
+  * `XMonad.Hooks.UrgencyHook`
+
+    - It's now possible to clear urgency of selected windows only using the
+      newly exported `clearUrgents'` function. Also, this and `clearUrgents`
+      now clear the `_NET_WM_STATE_DEMANDS_ATTENTION` bit as well.
+
+    - Added a variant of `filterUrgencyHook` that takes a generic `Query Bool`
+      to select which windows should never be marked urgent.
+
 ## 0.16
 
 ### Breaking Changes

XMonad/Hooks/ManageHelpers.hs

@@ -30,6 +30,7 @@ module XMonad.Hooks.ManageHelpers (
     composeOne,
     (-?>), (/=?), (<==?), (</=?), (-->>), (-?>>),
     currentWs,
+    windowTag,
     isInProperty,
     isKDETrayWindow,
     isFullscreen,
@@ -134,6 +135,10 @@ p -?>> f = do
 currentWs :: Query WorkspaceId
 currentWs = liftX (withWindowSet $ return . W.currentTag)
 
+-- | Return the workspace tag of a window, if already managed
+windowTag :: Query (Maybe WorkspaceId)
+windowTag = ask >>= \w -> liftX $ withWindowSet $ return . W.findTag w
+
 -- | A predicate to check whether a window is a KDE system tray icon.
 isKDETrayWindow :: Query Bool
 isKDETrayWindow = ask >>= \w -> liftX $ do

XMonad/Hooks/UrgencyHook.hs

@@ -30,9 +30,6 @@ module XMonad.Hooks.UrgencyHook (
                                  -- ** Useful keybinding
                                  -- $keybinding
 
-                                 -- ** Note
-                                 -- $note
-
                                  -- * Troubleshooting
                                  -- $troubleshooting
 
@@ -61,10 +58,10 @@ module XMonad.Hooks.UrgencyHook (
                                  NoUrgencyHook(..),
                                  BorderUrgencyHook(..),
                                  FocusHook(..),
-                                 filterUrgencyHook,
+                                 filterUrgencyHook, filterUrgencyHook',
                                  minutes, seconds,
                                  -- * Stuff for developers:
-                                 readUrgents, withUrgents,
+                                 readUrgents, withUrgents, clearUrgents',
                                  StdoutUrgencyHook(..),
                                  SpawnUrgencyHook(..),
                                  UrgencyHook(urgencyHook),
@@ -75,6 +72,7 @@ module XMonad.Hooks.UrgencyHook (
 import XMonad
 import qualified XMonad.StackSet as W
 
+import XMonad.Hooks.ManageHelpers (windowTag)
 import XMonad.Util.Dzen (dzenWithArgs, seconds)
 import qualified XMonad.Util.ExtensibleState as XS
 import XMonad.Util.NamedWindows (getName)
@@ -130,11 +128,6 @@ import Foreign.C.Types (CLong)
 -- You can set up a keybinding to jump to the window that was recently marked
 -- urgent. See an example at 'focusUrgent'.
 
--- $note
--- Note: UrgencyHook installs itself as a LayoutModifier, so if you modify your
--- urgency hook and restart xmonad, you may need to rejigger your layout by
--- hitting mod-shift-space.
-
 -- $troubleshooting
 --
 -- There are three steps to get right:
@@ -216,7 +209,8 @@ withUrgencyHookC :: (LayoutClass l Window, UrgencyHook h) =>
                     h -> UrgencyConfig -> XConfig l -> XConfig l
 withUrgencyHookC hook urgConf conf = conf {
         handleEventHook = \e -> handleEvent (WithUrgencyHook hook urgConf) e >> handleEventHook conf e,
-        logHook = cleanupUrgents (suppressWhen urgConf) >> logHook conf
+        logHook = cleanupUrgents (suppressWhen urgConf) >> logHook conf,
+        startupHook = cleanupStaleUrgents >> startupHook conf
     }
 
 data Urgents = Urgents { fromUrgents :: [Window] } deriving (Read,Show,Typeable)
@@ -275,7 +269,7 @@ focusUrgent = withUrgents $ flip whenJust (windows . W.focusWindow) . listToMayb
 --
 -- > , ((modm .|. shiftMask, xK_BackSpace), clearUrgents)
 clearUrgents :: X ()
-clearUrgents = adjustUrgents (const []) >> adjustReminders (const [])
+clearUrgents = withUrgents clearUrgents'
 
 -- | 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
@@ -287,6 +281,12 @@ readUrgents = XS.gets fromUrgents
 withUrgents :: ([Window] -> X a) -> X a
 withUrgents f = readUrgents >>= f
 
+-- | Cleanup urgency and reminders for windows that no longer exist.
+cleanupStaleUrgents :: X ()
+cleanupStaleUrgents = withWindowSet $ \ws -> do
+    adjustUrgents (filter (`W.member` ws))
+    adjustReminders (filter $ ((`W.member` ws) . window))
+
 adjustUrgents :: ([Window] -> [Window]) -> X ()
 adjustUrgents = XS.modify . onUrgents
 
@@ -419,12 +419,15 @@ shouldSuppress :: SuppressWhen -> Window -> X Bool
 shouldSuppress sw w = elem w <$> suppressibleWindows sw
 
 cleanupUrgents :: SuppressWhen -> X ()
-cleanupUrgents sw = do
-    sw' <- suppressibleWindows sw
+cleanupUrgents sw = clearUrgents' =<< suppressibleWindows sw
+
+-- | Clear urgency status of selected windows.
+clearUrgents' :: [Window] -> X ()
+clearUrgents' ws = do
     a_da <- getAtom "_NET_WM_STATE_DEMANDS_ATTENTION"
     dpy <- withDisplay (\dpy -> return dpy)
-    mapM_ (\w -> removeNetWMState dpy w a_da) sw'
-    adjustUrgents (\\ sw') >> adjustReminders (filter $ ((`notElem` sw') . window))
+    mapM_ (\w -> removeNetWMState dpy w a_da) ws
+    adjustUrgents (\\ ws) >> adjustReminders (filter $ ((`notElem` ws) . window))
 
 suppressibleWindows :: SuppressWhen -> X [Window]
 suppressibleWindows Visible  = gets $ S.toList . mapped
@@ -535,9 +538,9 @@ instance UrgencyHook StdoutUrgencyHook where
 --
 -- > main = xmonad (withUrgencyHook (filterUrgencyHook ["NSP", "SP"]) def)
 filterUrgencyHook :: [WorkspaceId] -> Window -> X ()
-filterUrgencyHook skips w = do
-    ws <- gets windowset
-    case W.findTag w ws of
-        Just tag -> when (tag `elem` skips)
-                        $ adjustUrgents (delete w)
-        _ -> return ()
+filterUrgencyHook skips = filterUrgencyHook' $ maybe False (`elem` skips) <$> windowTag
+
+-- | 'filterUrgencyHook' that takes a generic 'Query' to select which windows
+-- should never be marked urgent.
+filterUrgencyHook' :: Query Bool -> Window -> X ()
+filterUrgencyHook' q w = whenX (runQuery q w) (clearUrgents' [w])