summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDaniel Schoepe <asgaroth_@gmx.de>2009-02-03 16:55:36 +0100
committerDaniel Schoepe <asgaroth_@gmx.de>2009-02-03 16:55:36 +0100
commit5c38e151b889f65cac11f1cd19629d04d7e0849d (patch)
tree6d8131a58a6e1f7a71e63c8ff36e8c96427516b7
parent21943d95090614acde26969dc9f5ef8513a06799 (diff)
downloadmetatile-5c38e151b889f65cac11f1cd19629d04d7e0849d.tar
metatile-5c38e151b889f65cac11f1cd19629d04d7e0849d.zip
Support for custom event hooks
Ignore-this: f22f1a7ae2d958ba1b3625aa923b7efd darcs-hash:20090203155536-cb1c6-834084657dbd5699030c7dd6dbb1ab153763b631
-rw-r--r--XMonad/Config.hs17
-rw-r--r--XMonad/Core.hs3
-rw-r--r--XMonad/Main.hsc10
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.