Adjustments to use the new event hook feature instead of Hooks.EventHook

Ignore-this: f8c239bc8e301cbd6fa509ef748af542

darcs-hash:20090203160046-cb1c6-d66821c5b8a5a60e3b76148654c6e28806b37749.gz

6 files changed, 30 insertions, 40 deletions

diff --git a/XMonad/Config/Arossato.hs b/XMonad/Config/Arossato.hs
index f705a23..4aa0087 100644
--- a/XMonad/Config/Arossato.hs
+++ b/XMonad/Config/Arossato.hs
@@ -90,8 +90,7 @@ arossatoConfig = do
                                 map show [7 .. 9 :: Int]
          , logHook            = myDynLog xmobar -- REMOVE this line if you do not have xmobar installed!
          , manageHook         = newManageHook
-         , layoutHook         = eventHook ServerMode $
-                                avoidStruts $
+         , layoutHook         = avoidStruts $
                                 decorated        |||
                                 noBorders mytabs |||
                                 otherLays
@@ -99,6 +98,7 @@ arossatoConfig = do
          , normalBorderColor  = "white"
          , focusedBorderColor = "black"
          , keys               = newKeys
+         , handleEventHook    = serverModeEventHook
          , focusFollowsMouse  = False
          }
     where
diff --git a/XMonad/Config/Desktop.hs b/XMonad/Config/Desktop.hs
index c68ae44..1959aa8 100644
--- a/XMonad/Config/Desktop.hs
+++ b/XMonad/Config/Desktop.hs
@@ -27,9 +27,10 @@ desktopConfig = defaultConfig
     { logHook    = ewmhDesktopsLogHook
     , layoutHook = desktopLayoutModifiers $ layoutHook defaultConfig
     , manageHook = manageHook defaultConfig <+> manageDocks
+    , handleEventHook = ewmhDesktopsEventHook
     , keys       = \c -> desktopKeys c `M.union` keys defaultConfig c }
 
 desktopKeys (XConfig {modMask = modm}) = M.fromList $
     [ ((modm, xK_b), sendMessage ToggleStruts) ]
 
-desktopLayoutModifiers layout = avoidStruts $ ewmhDesktopsLayout layout
+desktopLayoutModifiers layout = avoidStruts layout
diff --git a/XMonad/Config/Droundy.hs b/XMonad/Config/Droundy.hs
index a78947b..6f63688 100644
--- a/XMonad/Config/Droundy.hs
+++ b/XMonad/Config/Droundy.hs
@@ -44,7 +44,7 @@ import XMonad.Actions.CycleWS ( moveTo, WSType( HiddenNonEmptyWS ),
 
 import XMonad.Hooks.ManageDocks ( avoidStruts, manageDocks )
 import XMonad.Hooks.EwmhDesktops ( ewmhDesktopsLogHook,
-                                   ewmhDesktopsLayout )
+                                   ewmhDesktopsEventHook )
 
 myXPConfig :: XPConfig
 myXPConfig = defaultXPConfig {font="-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*"
@@ -121,7 +121,7 @@ keys x = M.fromList $
 config = defaultConfig
          { borderWidth = 1 -- Width of the window border in pixels.
          , XMonad.workspaces = ["mutt","iceweasel"]
-         , layoutHook = ewmhDesktopsLayout $ showWName $ workspaceDir "~" $
+         , layoutHook = showWName $ workspaceDir "~" $
                         boringWindows $ smartBorders $ windowNavigation $
                         maximizeVertical $ toggleLayouts Full $ avoidStruts $
                         named "tabbed" mytab |||
@@ -135,6 +135,7 @@ config = defaultConfig
          , terminal = "xterm" -- The preferred terminal program.
          , normalBorderColor = "#222222" -- Border color for unfocused windows.
          , focusedBorderColor = "#00ff00" -- Border color for focused windows.
+         , handleEventHook = ewmhDesktopsEventHook
          , XMonad.modMask = mod1Mask
          , XMonad.keys = keys
          }
diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs
index 2340efd..bcf870d 100644
--- a/XMonad/Hooks/EwmhDesktops.hs
+++ b/XMonad/Hooks/EwmhDesktops.hs
@@ -15,14 +15,14 @@
 module XMonad.Hooks.EwmhDesktops (
     -- * Usage
     -- $usage
-    EwmhDesktopsHook,
     ewmhDesktopsLogHook,
     ewmhDesktopsLogHookCustom,
-    ewmhDesktopsLayout
+    ewmhDesktopsEventHook
     ) where
 
 import Data.List
 import Data.Maybe
+import Data.Monoid
 
 import XMonad
 import Control.Monad
@@ -30,7 +30,6 @@ import qualified XMonad.StackSet as W
 
 import XMonad.Hooks.SetWMName
 import XMonad.Util.WorkspaceCompare
-import XMonad.Hooks.EventHook
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -41,9 +40,9 @@ import XMonad.Hooks.EventHook
 -- > myLogHook :: X ()
 -- > myLogHook = ewmhDesktopsLogHook
 -- >
--- > myLayoutHook = ewmhDesktopsLayout $ avoidStruts $ layoutHook defaultConfig
+-- > myHandleEventHook = ewmhDesktopsEventHook
 -- >
--- > main = xmonad defaultConfig { layoutHook = myLayouts, logHook = myLogHook }
+-- > main = xmonad defaultConfig { handleEventHook = myHandleEventHook, logHook = myLogHook }
 --
 -- 'avoidStruts' is used to automatically leave space for dock programs, and
 -- can be found in 'XMonad.Hooks.ManageDocks'.
@@ -119,13 +118,8 @@ ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
 --
 --  * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed)
 --
-ewmhDesktopsLayout :: layout a -> HandleEvent EwmhDesktopsHook layout a
-ewmhDesktopsLayout = eventHook EwmhDesktopsHook
-
-data EwmhDesktopsHook = EwmhDesktopsHook deriving ( Show, Read )
-instance EventHook EwmhDesktopsHook where
-	handleEvent _ e@ClientMessageEvent {} = do handle e
-	handleEvent _ _ = return ()
+ewmhDesktopsEventHook :: Event -> X All
+ewmhDesktopsEventHook e = handle e >> return (All True)
 
 handle :: Event -> X ()
 handle ClientMessageEvent {
diff --git a/XMonad/Hooks/ServerMode.hs b/XMonad/Hooks/ServerMode.hs
index 4ff9c95..66e3943 100644
--- a/XMonad/Hooks/ServerMode.hs
+++ b/XMonad/Hooks/ServerMode.hs
@@ -59,16 +59,16 @@ module XMonad.Hooks.ServerMode
     ( -- * Usage
       -- $usage
       ServerMode (..)
-    , eventHook
+    , serverModeEventHook
     ) where
 
 import Control.Monad (when)
 import Data.List
+import Data.Monoid
 import System.IO
 
 import XMonad
 import XMonad.Actions.Commands
-import XMonad.Hooks.EventHook
 
 -- $usage
 -- You can use this module with the following in your
@@ -76,22 +76,15 @@ import XMonad.Hooks.EventHook
 --
 -- > import XMonad.Hooks.ServerMode
 --
--- Then edit your @layoutHook@ by adding the 'eventHook':
+-- Then edit your @handleEventHook@ by adding the 'serverModeEventHook':
 --
--- > layoutHook = eventHook ServerMode $ avoidStruts $ simpleTabbed ||| Full ||| etc..
+-- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook }
 --
--- and then:
---
--- > main = xmonad defaultConfig { layoutHook = myLayouts }
---
--- For more detailed instructions on editing the layoutHook see:
---
--- "XMonad.Doc.Extending#Editing_the_layout_hook"
 
 data ServerMode = ServerMode deriving ( Show, Read )
 
-instance EventHook ServerMode where
-    handleEvent _ (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do
+serverModeEventHook :: Event -> X All
+serverModeEventHook (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do
         d <- asks display
         a <- io $ internAtom d "XMONAD_COMMAND" False
         when (mt == a && dt /= []) $ do
@@ -100,4 +93,5 @@ instance EventHook ServerMode where
              case lookup (fromIntegral (head dt) :: Int) (zip [1..] cl) of
                   Just (c,_) -> runCommand' c
                   Nothing    -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl
-    handleEvent _ _ = return ()
+        return (All True)
+serverModeEventHook _ = return (All True)
diff --git a/XMonad/Hooks/UrgencyHook.hs b/XMonad/Hooks/UrgencyHook.hs
index b41285e..79b171c 100644
--- a/XMonad/Hooks/UrgencyHook.hs
+++ b/XMonad/Hooks/UrgencyHook.hs
@@ -70,7 +70,6 @@ module XMonad.Hooks.UrgencyHook (
 import XMonad
 import qualified XMonad.StackSet as W
 
-import XMonad.Hooks.EventHook
 import XMonad.Util.Dzen (dzenWithArgs, seconds)
 import XMonad.Util.NamedWindows (getName)
 import XMonad.Util.Timer (TimerId, startTimer, handleTimer)
@@ -199,7 +198,7 @@ import Foreign (unsafePerformIO)
 -- 'urgencyConfig' to control behavior. To change this, use 'withUrgencyHook'
 -- instead.
 withUrgencyHook :: (LayoutClass l Window, UrgencyHook h) =>
-                   h -> XConfig l -> XConfig (HandleEvent (WithUrgencyHook h) l)
+                   h -> XConfig l -> XConfig l
 withUrgencyHook hook conf = withUrgencyHookC hook urgencyConfig conf
 
 -- | This lets you modify the defaults set in 'urgencyConfig'. An example:
@@ -208,9 +207,9 @@ withUrgencyHook hook conf = withUrgencyHookC hook urgencyConfig conf
 --
 -- (Don't type the @...@, you dolt.) See 'UrgencyConfig' for details on configuration.
 withUrgencyHookC :: (LayoutClass l Window, UrgencyHook h) =>
-                    h -> UrgencyConfig -> XConfig l -> XConfig (HandleEvent (WithUrgencyHook h) l)
+                    h -> UrgencyConfig -> XConfig l -> XConfig l
 withUrgencyHookC hook urgConf conf = conf {
-        layoutHook = eventHook (WithUrgencyHook hook urgConf) $ layoutHook conf,
+        handleEventHook = \e -> handleEvent (WithUrgencyHook hook urgConf) e >> handleEventHook conf e,
         logHook = cleanupUrgents (suppressWhen urgConf) >> logHook conf
     }
 
@@ -322,9 +321,10 @@ data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig
 -- ourselves, allowing us to clear urgency when a window is visible, and not to
 -- set urgency if a window is visible. If you have a better idea, please, let us
 -- know!
-instance UrgencyHook h => EventHook (WithUrgencyHook h) where
-    handleEvent wuh event = case event of
-        PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> do
+handleEvent :: UrgencyHook h => WithUrgencyHook h -> Event -> X ()
+handleEvent wuh event =
+    case event of
+      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
@@ -333,9 +333,9 @@ instance UrgencyHook h => EventHook (WithUrgencyHook h) where
                 else
                   clearUrgency w
               userCodeDef () =<< asks (logHook . config) -- call *after* IORef has been modified
-        DestroyWindowEvent {ev_window = w} ->
+      DestroyWindowEvent {ev_window = w} ->
           clearUrgency w
-        _ ->
+      _ ->
           mapM_ handleReminder =<< readReminders
       where handleReminder reminder = handleTimer (timer reminder) event $ reminderHook wuh reminder