From 5c38e151b889f65cac11f1cd19629d04d7e0849d Mon Sep 17 00:00:00 2001
From: Daniel Schoepe <asgaroth_@gmx.de>
Date: Tue, 3 Feb 2009 16:55:36 +0100
Subject: Support for custom event hooks

Ignore-this: f22f1a7ae2d958ba1b3625aa923b7efd

darcs-hash:20090203155536-cb1c6-834084657dbd5699030c7dd6dbb1ab153763b631
---
 XMonad/Config.hs | 17 +++++++++++++++--
 XMonad/Core.hs   |  3 +++
 XMonad/Main.hsc  | 10 +++++++++-
 3 files changed, 27 insertions(+), 3 deletions(-)

diff --git a/XMonad/Config.hs b/XMonad/Config.hs
index 6e90673..112ed17 100644
--- a/XMonad/Config.hs
+++ b/XMonad/Config.hs
@@ -26,19 +26,23 @@ module XMonad.Config (defaultConfig) where
 --
 import XMonad.Core as XMonad hiding
     (workspaces,manageHook,numlockMask,keys,logHook,startupHook,borderWidth,mouseBindings
-    ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse)
+    ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse
+    ,handleEventHook)
 import qualified XMonad.Core as XMonad
     (workspaces,manageHook,numlockMask,keys,logHook,startupHook,borderWidth,mouseBindings
-    ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse)
+    ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse
+    ,handleEventHook)
 
 import XMonad.Layout
 import XMonad.Operations
 import XMonad.ManageHook
 import qualified XMonad.StackSet as W
 import Data.Bits ((.|.))
+import Data.Monoid
 import qualified Data.Map as M
 import System.Exit
 import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
 
 -- | The default number of workspaces (virtual screens) and their names.
 -- By default we use numeric strings, but any string may be used as a
@@ -119,6 +123,14 @@ manageHook = composeAll
 logHook :: X ()
 logHook = return ()
 
+------------------------------------------------------------------------
+-- Event handling
+
+-- | Defines a custom handler function for X Events. The function should
+-- return True if the default handler is to be run afterwards.
+handleEventHook :: Event -> X All
+handleEventHook _ = return (All True)
+
 -- | Perform an arbitrary action at xmonad startup.
 startupHook :: X ()
 startupHook = return ()
@@ -250,4 +262,5 @@ defaultConfig = XConfig
     , XMonad.startupHook        = startupHook
     , XMonad.mouseBindings      = mouseBindings
     , XMonad.manageHook         = manageHook
+    , XMonad.handleEventHook    = handleEventHook
     , XMonad.focusFollowsMouse  = focusFollowsMouse }
diff --git a/XMonad/Core.hs b/XMonad/Core.hs
index c86a170..38048e5 100644
--- a/XMonad/Core.hs
+++ b/XMonad/Core.hs
@@ -87,6 +87,9 @@ data XConfig l = XConfig
     , terminal           :: !String              -- ^ The preferred terminal application. Default: \"xterm\"
     , layoutHook         :: !(l Window)          -- ^ The available layouts
     , manageHook         :: !ManageHook          -- ^ The action to run when a new window is opened
+    , handleEventHook    :: !(Event -> X All)    -- ^ Handle an X event, returns (All True) if the default handler
+                                                 -- should also be run afterwards. mappend should be used for combining
+                                                 -- event hooks in most cases.
     , workspaces         :: ![String]            -- ^ The list of workspaces' names
     , numlockMask        :: !KeyMask             -- ^ The numlock modifier
     , modMask            :: !KeyMask             -- ^ the mod modifier
diff --git a/XMonad/Main.hsc b/XMonad/Main.hsc
index 27295ba..499be54 100644
--- a/XMonad/Main.hsc
+++ b/XMonad/Main.hsc
@@ -22,6 +22,7 @@ import qualified Data.Set as S
 import Control.Monad.Reader
 import Control.Monad.State
 import Data.Maybe (fromMaybe)
+import Data.Monoid (getAll)
 
 import Foreign.C
 import Foreign.Ptr
@@ -152,11 +153,18 @@ xmonad initxmc = do
         prehandle e = let mouse = do guard (ev_event_type e `elem` evs)
                                      return (fromIntegral (ev_x_root e)
                                             ,fromIntegral (ev_y_root e))
-                      in local (\c -> c { mousePosition = mouse }) (handle e)
+                      in local (\c -> c { mousePosition = mouse }) (handleWithHook e)
         evs = [ keyPress, keyRelease, enterNotify, leaveNotify
               , buttonPress, buttonRelease]
 
 
+-- | Runs handleEventHook from the configuration and runs the default handler
+-- function if it returned True.
+handleWithHook :: Event -> X ()
+handleWithHook e = do
+  evHook <- asks (handleEventHook . config)
+  whenX (userCodeDef True $ getAll `fmap` evHook e) (handle e)
+
 -- ---------------------------------------------------------------------
 -- | Event handler. Map X events onto calls into Operations.hs, which
 -- modify our internal model of the window manager state.
-- 
cgit v1.2.3