diff options
author | Devin Mullins <me@twifkak.com> | 2007-11-10 23:43:03 +0100 |
---|---|---|
committer | Devin Mullins <me@twifkak.com> | 2007-11-10 23:43:03 +0100 |
commit | e187864be806c0aa733e99d661fa41e953dd3525 (patch) | |
tree | e095d9e0f7aff9166da88c02834407658e8bba7f | |
parent | 90ea76341c7f0309445e93c061dff91cea2df4f8 (diff) | |
download | XMonadContrib-e187864be806c0aa733e99d661fa41e953dd3525.tar.gz XMonadContrib-e187864be806c0aa733e99d661fa41e953dd3525.tar.xz XMonadContrib-e187864be806c0aa733e99d661fa41e953dd3525.zip |
get UrgencyHook to compile
(The boilerplate, it burns!) Still isn't useful (to me) yet, as I haven't
ported dzenUrgencyHook to the new UrgencyHook class.
darcs-hash:20071110224303-78224-54e4049d4a3fcb1d97b87fe29bb3fc08697aadd0.gz
Diffstat (limited to '')
-rw-r--r-- | XMonad/Hooks/UrgencyHook.hs | 27 | ||||
-rw-r--r-- | XMonadContrib.cabal | 2 |
2 files changed, 18 insertions, 11 deletions
diff --git a/XMonad/Hooks/UrgencyHook.hs b/XMonad/Hooks/UrgencyHook.hs index 9163b69..8d54c48 100644 --- a/XMonad/Hooks/UrgencyHook.hs +++ b/XMonad/Hooks/UrgencyHook.hs @@ -25,13 +25,13 @@ module XMonad.Hooks.UrgencyHook ( withUrgents ) where -import {-# SOURCE #-} Config (urgencyHook, logHook) -import Operations (windows) -import qualified StackSet as W +import XMonad.Operations (windows) +import qualified XMonad.StackSet as W import XMonad import XMonad.Layout.LayoutModifier import Control.Monad (when) +import Control.Monad.Reader (asks) import Control.Monad.State (gets) import Data.Bits (testBit, clearBit) import Data.IORef @@ -86,6 +86,7 @@ focusUrgent = withUrgents $ flip whenJust (windows . W.focusWindow) . listToMayb {-# NOINLINE urgents #-} urgents :: IORef [Window] urgents = unsafePerformIO (newIORef []) +-- (Hey, I don't like it any more than you do.) readUrgents :: X [Window] readUrgents = io $ readIORef urgents @@ -93,15 +94,15 @@ readUrgents = io $ readIORef urgents withUrgents :: ([Window] -> X a) -> X a withUrgents f = readUrgents >>= f -data WithUrgencyHook a = WithUrgencyHook deriving (Read, Show) +data WithUrgencyHook h a = WithUrgencyHook h deriving (Read, Show) -instance LayoutModifier WithUrgencyHook Window where - handleMess _ mess +instance UrgencyHook h Window => LayoutModifier (WithUrgencyHook h) Window where + handleMess (WithUrgencyHook theHook) 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 + urgencyHook theHook 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 @@ -109,7 +110,9 @@ instance LayoutModifier WithUrgencyHook Window where -- not a typical WM, so we're just breaking one more rule, here. io $ setWMHints dpy w wmh { wmh_flags = clearBit flags urgencyHintBit } adjustUrgents (\ws -> if elem w ws then ws else w : ws) - logHook -- call logHook after IORef has been modified + -- Call logHook after IORef has been modified. + theLogHook <- asks (logHook . config) + theLogHook -- 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 @@ -130,5 +133,9 @@ instance LayoutModifier WithUrgencyHook Window where adjustUrgents :: ([Window] -> [Window]) -> X () adjustUrgents f = io $ modifyIORef urgents f -withUrgencyHook :: LayoutClass l Window => l Window -> ModifiedLayout WithUrgencyHook l Window -withUrgencyHook = ModifiedLayout WithUrgencyHook +withUrgencyHook :: (UrgencyHook h Window, LayoutClass l Window) => + h -> l Window -> ModifiedLayout (WithUrgencyHook h) l Window +withUrgencyHook theHook = ModifiedLayout $ WithUrgencyHook theHook + +class (Read h, Show h) => UrgencyHook h a where + urgencyHook :: h -> a -> X () diff --git a/XMonadContrib.cabal b/XMonadContrib.cabal index b3a28c5..0a05e99 100644 --- a/XMonadContrib.cabal +++ b/XMonadContrib.cabal @@ -57,7 +57,7 @@ library XMonad.Hooks.EwmhDesktops XMonad.Hooks.ManageDocks XMonad.Hooks.SetWMName - -- XMonad.Hooks.UrgencyHook + XMonad.Hooks.UrgencyHook XMonad.Hooks.XPropManage XMonad.Layout.Accordion XMonad.Layout.Circle |