diff options
author | Daniel Schoepe <asgaroth_@gmx.de> | 2009-02-03 16:55:36 +0100 |
---|---|---|
committer | Daniel Schoepe <asgaroth_@gmx.de> | 2009-02-03 16:55:36 +0100 |
commit | 5c38e151b889f65cac11f1cd19629d04d7e0849d (patch) | |
tree | 6d8131a58a6e1f7a71e63c8ff36e8c96427516b7 | |
parent | 21943d95090614acde26969dc9f5ef8513a06799 (diff) | |
download | metatile-5c38e151b889f65cac11f1cd19629d04d7e0849d.tar metatile-5c38e151b889f65cac11f1cd19629d04d7e0849d.zip |
Support for custom event hooks
Ignore-this: f22f1a7ae2d958ba1b3625aa923b7efd
darcs-hash:20090203155536-cb1c6-834084657dbd5699030c7dd6dbb1ab153763b631
-rw-r--r-- | XMonad/Config.hs | 17 | ||||
-rw-r--r-- | XMonad/Core.hs | 3 | ||||
-rw-r--r-- | 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. |