From 17ea034ad39ef4896eeefe11e9d687c0a87ae2ef Mon Sep 17 00:00:00 2001
From: Devin Mullins <me@twifkak.com>
Date: Sat, 27 Oct 2007 08:48:10 +0200
Subject: use a global IORef to keep list of urgent windows

darcs-hash:20071027064810-78224-0ce0d902f9d8c5988bbd5f0d4d8e354acf478943.gz
---
 UrgencyHook.hs | 70 +++++++++++++++++++++++++++++++++++++++++++++-------------
 1 file changed, 55 insertions(+), 15 deletions(-)

(limited to 'UrgencyHook.hs')

diff --git a/UrgencyHook.hs b/UrgencyHook.hs
index 48fa42d..de05282 100644
--- a/UrgencyHook.hs
+++ b/UrgencyHook.hs
@@ -19,17 +19,24 @@
 module XMonadContrib.UrgencyHook (
                                  -- * Usage
                                  -- $usage
-                                 withUrgencyHook
+                                 withUrgencyHook,
+                                 readUrgents,
+                                 withUrgents
                                  ) where
 
-import {-# SOURCE #-} Config (urgencyHook)
+import {-# SOURCE #-} Config (urgencyHook, logHook)
 import XMonad
 import XMonadContrib.LayoutModifier
 
 import Control.Monad (when)
+import Control.Monad.State (gets)
 import Data.Bits (testBit, clearBit)
+import Data.IORef
+import Data.Set (Set)
+import qualified Data.Set as S
 import Graphics.X11.Xlib
 import Graphics.X11.Xlib.Extras
+import Foreign (unsafePerformIO)
 
 -- $usage
 -- To wire this up, add:
@@ -59,23 +66,56 @@ import Graphics.X11.Xlib.Extras
 -- > urgencyHook :: Window -> X ()
 --
 -- Compile!
+--
+-- You can also 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.
+
+-- | Stores the global set of all urgent windows, across workspaces. Not exported -- use
+-- @readUrgents@ or @withUrgents@ instead.
+{-# NOINLINE urgents #-}
+urgents :: IORef (Set Window)
+urgents = unsafePerformIO (newIORef S.empty)
+
+readUrgents :: X (Set Window)
+readUrgents = io $ readIORef urgents
+
+withUrgents :: (Set Window -> X a) -> X a
+withUrgents f = readUrgents >>= f
 
 data WithUrgencyHook a = WithUrgencyHook deriving (Read, Show)
 
 instance LayoutModifier WithUrgencyHook Window where
-    handleMess _ mess =
-      let event = fromMessage mess :: Maybe Event in do
-      case event of
-          Just (PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w }) ->
-              when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do
-                  wmh@WMHints { wmh_flags = flags } <- io $ getWMHints dpy w
-                  when (testBit flags urgencyHintBit) $ do
-                      urgencyHook w
-                      -- Is clearing the bit really necessary? Xlib manual advises it.
-                      io $ setWMHints dpy w wmh { wmh_flags = clearBit flags urgencyHintBit }
-                      return ()
-          _ -> return ()
-      return Nothing
+    handleMess _ 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
+                  urgencyHook w
+                  -- Clear the urgency bit in the WMHints flags field. According to the
+                  -- Xlib manual, the *client* is supposed to clear this flag when the urgency
+                  -- has been resolved, but, Xchat2, for example, sets the WMHints several
+                  -- times (e.g. causing the dzen to blink) unless it's cleared. XMonad is
+                  -- not a typical WM, so we're just breaking one more rule, here.
+                  io $ setWMHints dpy w wmh { wmh_flags = clearBit flags urgencyHintBit }
+                  adjustUrgents (S.insert w)
+                  logHook -- call logHook after IORef has been modified
+              -- Doing the setWMHints triggers another propertyNotify with the bit
+              -- cleared, so we ignore that message. This has the potentially wrong
+              -- effect of ignoring *all* urgency-clearing messages, some of which might
+              -- be legitimate. Let's wait for bug reports on that, though.
+          return Nothing
+      | otherwise =
+          return Nothing
+
+    -- Clear the urgency bit and remove from the urgent list when the window becomes visible.
+    redoLayout _ _ _ windowRects = do
+      visibles <- gets mapped
+      adjustUrgents (S.\\ visibles)
+      return (windowRects, Nothing)
+
+adjustUrgents :: (Set Window -> Set Window) -> X ()
+adjustUrgents f = io $ modifyIORef urgents f
 
 withUrgencyHook :: LayoutClass l Window => l Window -> ModifiedLayout WithUrgencyHook l Window
 withUrgencyHook = ModifiedLayout WithUrgencyHook
-- 
cgit v1.2.3