brand new UrgencyHook contrib, depends on X11-extras WMHints binding

It's a LayoutModifier which lets you define an urgencyHook function -- the
action gets performed wheneveran X client sends an XUrgencyHint message (i.e.
tries to "flash" the "taskbar").

This statically points to Config.urgencyHook, which requires that the user add
a line to Config.hs-boot, in addition to defining the urgencyHook.

Documentation forthcoming.

darcs-hash:20071011051641-78224-a045fe35cff3729cdd8f23e0ab90c43b351dae6b.gz

1 files changed, 31 insertions, 0 deletions

diff --git a/UrgencyHook.hs b/UrgencyHook.hs
new file mode 100644
index 0000000..ab89bd7
--- /dev/null
+++ b/UrgencyHook.hs
@@ -0,0 +1,31 @@
+module XMonadContrib.UrgencyHook where
+
+import {-# SOURCE #-} Config (urgencyHook)
+import XMonad
+import XMonadContrib.LayoutModifier
+
+import Control.Monad (when)
+import Data.Bits (testBit, clearBit)
+import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
+
+-- Oooh, spooky.
+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
+
+withUrgencyHook :: LayoutClass l Window => l Window -> ModifiedLayout WithUrgencyHook l Window
+withUrgencyHook = ModifiedLayout WithUrgencyHook