X.H.UrgencyHook: Add askUrgent and doAskUrgent

These are useful when one blocks some _NET_ACTIVE_WINDOW requests but
still wants to somehow show that a window requested focus.

TODO: changelog
TODO: xmonad/X11#71
TODO: maybe bump X11 dependency instead?

CHANGES.md

@@ -32,6 +32,7 @@
       additional combinators.
 
       TODO: refactor and update and make it not a breaking change
+      TODO: mention doAskUrgent
 
   * `XMonad.Prompt.Directory`
 

XMonad/Hooks/UrgencyHook.hs

@@ -1,5 +1,8 @@
 {-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards, DeriveDataTypeable,
   FlexibleInstances #-}
+{-# LANGUAGE CPP #-}
+
+#define X11_has_setClientMessageEvent MIN_VERSION_X11(1, 10, 0)
 
 -----------------------------------------------------------------------------
 -- |
@@ -63,6 +66,9 @@ module XMonad.Hooks.UrgencyHook (
                                  FocusHook(..),
                                  filterUrgencyHook,
                                  minutes, seconds,
+#if X11_has_setClientMessageEvent
+                                 askUrgent, doAskUrgent,
+#endif
                                  -- * Stuff for developers:
                                  readUrgents, withUrgents,
                                  StdoutUrgencyHook(..),
@@ -80,6 +86,7 @@ import qualified XMonad.Util.ExtensibleState as XS
 import XMonad.Util.NamedWindows (getName)
 import XMonad.Util.Timer (TimerId, startTimer, handleTimer)
 import XMonad.Util.WindowProperties (getProp32)
+import XMonad.Util.XUtils (fi)
 
 import Control.Monad (when)
 import Data.Bits (testBit)
@@ -541,3 +548,33 @@ filterUrgencyHook skips w = do
         Just tag -> when (tag `elem` skips)
                         $ adjustUrgents (delete w)
         _ -> return ()
+
+#if X11_has_setClientMessageEvent
+
+-- | Mark the given window urgent.
+--
+-- (The implementation is a bit hacky: send a _NET_WM_STATE ClientMessage to
+-- ourselves. This is so that we respect the 'SuppressWhen' of the configured
+-- urgency hooks.)
+--
+-- TODO: https://github.com/quchen/articles/blob/master/haskell-cpp-compatibility.md
+askUrgent :: Window -> X ()
+askUrgent w = withDisplay $ \dpy -> do
+    rw <- asks theRoot
+    a_wmstate <- getAtom "_NET_WM_STATE"
+    a_da      <- getAtom "_NET_WM_STATE_DEMANDS_ATTENTION"
+    let state_add = 1
+    let source_pager = 2
+    io $ allocaXEvent $ \e -> do
+        setEventType e clientMessage
+        setClientMessageEvent' e w a_wmstate 32 [state_add, fi a_da, 0, source_pager]
+        sendEvent dpy rw False (substructureRedirectMask .|. substructureNotifyMask) e
+
+-- | Helper for 'ManageHook' that marks the window as urgent (unless
+-- suppressed, see 'SuppressWhen'). Useful in
+-- 'XMonad.Hooks.EwmhDesktops.activateHook' and also in combination with
+-- "XMonad.Hooks.InsertPosition", "XMonad.Hooks.Focus".
+doAskUrgent :: ManageHook
+doAskUrgent = ask >>= \w -> liftX (askUrgent w) >> return mempty
+
+#endif

xmonad-contrib.cabal

@@ -58,7 +58,7 @@ library
                    random,
                    mtl >= 1 && < 3,
                    unix,
-                   X11>=1.6.1 && < 1.10,
+                   X11>=1.6.1 && < 1.11,
                    xmonad >= 0.15 && < 0.16,
                    utf8-string
 
@@ -399,7 +399,7 @@ test-suite tests
   hs-source-dirs: tests, .
   build-depends: base
                , QuickCheck >= 2
-               , X11>=1.6.1 && < 1.10
+               , X11>=1.6.1 && < 1.11
                , containers
                , directory
                , hspec >= 2.4.0 && < 3