diff options
Diffstat (limited to '')
| -rw-r--r-- | UrgencyHook.hs | 70 |
1 files changed, 55 insertions, 15 deletions
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 |