From adb5b1d2d4c42ffd0765ae7b2a523df9ac9bbffb Mon Sep 17 00:00:00 2001
From: Maarten de Vries <maarten@de-vri.es>
Date: Tue, 12 Feb 2013 19:12:29 +0100
Subject: Add EWMH DEMANDS_ATTENTION support to UrgencyHook.

Ignore-this: 5a4b314d137676758fad9ec8f85ce422

Add support for the _NET_WM_STATE_DEMANDS_ATTENTION atom
by treating it the same way as the WM_HINTS urgency flag.

darcs-hash:20130212181229-e67f5-0b4ac099df444e38cb3025b21076d49674aa4e4a.gz
---
 XMonad/Hooks/UrgencyHook.hs | 67 ++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 57 insertions(+), 10 deletions(-)

(limited to 'XMonad/Hooks/UrgencyHook.hs')

diff --git a/XMonad/Hooks/UrgencyHook.hs b/XMonad/Hooks/UrgencyHook.hs
index 82c20fe..7ef09b5 100644
--- a/XMonad/Hooks/UrgencyHook.hs
+++ b/XMonad/Hooks/UrgencyHook.hs
@@ -78,14 +78,16 @@ import XMonad.Util.Dzen (dzenWithArgs, seconds)
 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 Control.Applicative ((<$>))
 import Control.Monad (when)
 import Data.Bits (testBit)
 import Data.List (delete, (\\))
-import Data.Maybe (listToMaybe, maybeToList)
+import Data.Maybe (listToMaybe, maybeToList, fromMaybe)
 import qualified Data.Set as S
 import System.IO (hPutStrLn, stderr)
+import Foreign.C.Types (CLong)
 
 -- $usage
 --
@@ -310,12 +312,34 @@ readReminders = XS.get
 adjustReminders :: ([Reminder] -> [Reminder]) -> X ()
 adjustReminders = XS.modify
 
-clearUrgency :: Window -> X ()
-clearUrgency w = adjustUrgents (delete w) >> adjustReminders (filter $ (w /=) . window)
 
 data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig
     deriving (Read, Show)
 
+-- | Change the _NET_WM_STATE property by applying a function to the list of atoms.
+changeNetWMState :: Display -> Window -> ([CLong] -> [CLong]) -> X ()
+changeNetWMState dpy w f = do
+   wmstate <- getAtom "_NET_WM_STATE"
+   wstate  <- fromMaybe [] `fmap` getProp32 wmstate w
+   let ptype = 4 -- atom property type for changeProperty
+   io $ changeProperty32 dpy w wmstate ptype propModeReplace (f wstate)
+   return ()
+
+-- | Add an atom to the _NET_WM_STATE property.
+addNetWMState :: Display -> Window -> Atom -> X ()
+addNetWMState dpy w atom = changeNetWMState dpy w $ ((fromIntegral atom):)
+
+-- | Remove an atom from the _NET_WM_STATE property.
+removeNetWMState :: Display -> Window -> Atom -> X ()
+removeNetWMState dpy w atom = changeNetWMState dpy w $ delete (fromIntegral atom)
+
+-- | Get the _NET_WM_STATE propertly as a [CLong]
+getNetWMState :: Window -> X [CLong]
+getNetWMState w = do
+    a_wmstate <- getAtom "_NET_WM_STATE"
+    fromMaybe [] `fmap` getProp32 a_wmstate w
+   
+
 -- 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:
@@ -331,20 +355,40 @@ data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig
 handleEvent :: UrgencyHook h => WithUrgencyHook h -> Event -> X ()
 handleEvent wuh event =
     case event of
+     -- WM_HINTS urgency flag
       PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> do
           when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do
               WMHints { wmh_flags = flags } <- io $ getWMHints dpy w
-              if (testBit flags urgencyHintBit) then do
-                  adjustUrgents (\ws -> if elem w ws then ws else w : ws)
-                  callUrgencyHook wuh w
-                else
-                  clearUrgency w
-              userCodeDef () =<< asks (logHook . config)
+              if (testBit flags urgencyHintBit) then markUrgent w else markNotUrgent w
+      -- Window destroyed
       DestroyWindowEvent {ev_window = w} ->
-          clearUrgency w
+          markNotUrgent w
+      -- _NET_WM_STATE_DEMANDS_ATTENTION requested by client
+      ClientMessageEvent {ev_event_display = dpy, ev_window = w, ev_message_type = t, ev_data = action:atoms} -> do
+          a_wmstate <- getAtom "_NET_WM_STATE"
+          a_da      <- getAtom "_NET_WM_STATE_DEMANDS_ATTENTION"
+          wstate    <- getNetWMState w
+          let demandsAttention = fromIntegral a_da `elem` wstate
+              remove = 0
+              add    = 1
+              toggle = 2
+          when (t == a_wmstate && fromIntegral a_da `elem` atoms) $ do
+            when (action == add || (action == toggle && not demandsAttention)) $ do
+              markUrgent w
+              addNetWMState dpy w a_da
+            when (action == remove || (action == toggle && demandsAttention)) $ do
+              markNotUrgent w
+              removeNetWMState dpy w a_da
       _ ->
           mapM_ handleReminder =<< readReminders
       where handleReminder reminder = handleTimer (timer reminder) event $ reminderHook wuh reminder
+            markUrgent w = do
+                adjustUrgents (\ws -> if elem w ws then ws else w : ws)
+                callUrgencyHook wuh w
+                userCodeDef () =<< asks (logHook . config)
+            markNotUrgent w = do
+                adjustUrgents (delete w) >> adjustReminders (filter $ (w /=) . window)
+                userCodeDef () =<< asks (logHook . config)
 
 callUrgencyHook :: UrgencyHook h => WithUrgencyHook h -> Window -> X ()
 callUrgencyHook (WithUrgencyHook hook UrgencyConfig { suppressWhen = sw, remindWhen = rw }) w =
@@ -378,6 +422,9 @@ shouldSuppress sw w = elem w <$> suppressibleWindows sw
 cleanupUrgents :: SuppressWhen -> X ()
 cleanupUrgents sw = do
     sw' <- suppressibleWindows sw
+    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))
 
 suppressibleWindows :: SuppressWhen -> X [Window]
-- 
cgit v1.2.3