[xmonad] Darcs patch to expose arbitrary events to event hooks
Marshall Lochbaum
mwlochbaum at gmail.com
Thu Feb 21 20:56:31 CET 2013
I haven't gotten a response from this yet. Is there another place I
should go with this patch? Any reason it shouldn't be included?
Marshall
On Tue, Feb 05, 2013 at 01:55:40PM -0500, Marshall Lochbaum wrote:
> Last year this set of patches was submitted to the xmonad mailing list.
> It allows the user to set which types of events will be passed to event
> hooks by moving the two variables rootMask and clientMask from being
> hard-coded constants to configurable parameters.
>
> http://www.haskell.org/pipermail/xmonad/2012-January/012297.html
>
> This message got no replies when it was sent, but I have found it very
> useful. I have attached a few scripts that I have used with the patch:
> these allow me to spawn things in the root window using a single
> keypress without modifiers, to map caps lock to a "repeat last key" key
> that makes typing words with double letters a bit easier, and to
> implement a "show desktop" key that hides all windows when pressed and
> returns them when released.
>
> Since rootMask and clientMask are not modified by default, this won't
> break any current xmonad behavior. It also only impacts event hooks, so
> there is no chance of damaging other parts of xmonad with incorrect
> configuration--the affected event hooks simply won't receive some
> events.
>
> Can someone apply these changes to xmonad? I have attached a patch which
> merges the two from the original message (there's really no reason to
> apply one and not the other) and works with the latest darcs source. If
> these are added I will also clean up and formally submit the other
> scripts.
>
> Marshall
> 1 patch for repository http://code.haskell.org/xmonad:
>
> Tue Feb 5 13:28:58 EST 2013 mwlochbaum at gmail.com
> * configurableEventMasks
>
> New patches:
>
> [configurableEventMasks
> mwlochbaum at gmail.com**20130205182858
> Ignore-this: 3848de0f8f5ad5995e87a2a01e7752f
> ] {
> hunk ./XMonad/Config.hs 30
> import XMonad.Core as XMonad hiding
> (workspaces,manageHook,keys,logHook,startupHook,borderWidth,mouseBindings
> ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse
> - ,handleEventHook,clickJustFocuses)
> + ,handleEventHook,clickJustFocuses,rootMask,clientMask)
> import qualified XMonad.Core as XMonad
> (workspaces,manageHook,keys,logHook,startupHook,borderWidth,mouseBindings
> ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse
> hunk ./XMonad/Config.hs 34
> - ,handleEventHook,clickJustFocuses)
> + ,handleEventHook,clickJustFocuses,rootMask,clientMask)
>
> import XMonad.Layout
> import XMonad.Operations
> hunk ./XMonad/Config.hs 148
> -- Percent of screen to increment by when resizing panes
> delta = 3/100
>
> +------------------------------------------------------------------------
> +-- Event Masks:
> +
> +-- | The client events that xmonad is interested in
> +clientMask :: EventMask
> +clientMask = structureNotifyMask .|. enterWindowMask .|. propertyChangeMask
> +
> +-- | The root events that xmonad is interested in
> +rootMask :: EventMask
> +rootMask = substructureRedirectMask .|. substructureNotifyMask
> + .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask
> + .|. buttonPressMask
> +
> ------------------------------------------------------------------------
> -- Key bindings:
>
> hunk ./XMonad/Config.hs 270
> , XMonad.handleEventHook = handleEventHook
> , XMonad.focusFollowsMouse = focusFollowsMouse
> , XMonad.clickJustFocuses = clickJustFocuses
> + , XMonad.clientMask = clientMask
> + , XMonad.rootMask = rootMask
> }
>
> -- | Finally, a copy of the default bindings in simple textual tabular format.
> hunk ./XMonad/Core.hs 114
> , startupHook :: !(X ()) -- ^ The action to perform on startup
> , focusFollowsMouse :: !Bool -- ^ Whether window entry events can change focus
> , clickJustFocuses :: !Bool -- ^ False to make a click which changes focus to be additionally passed to the window
> + , clientMask :: !EventMask -- ^ The client events that xmonad is interested in
> + , rootMask :: !EventMask -- ^ The root events that xmonad is interested in
> }
>
>
> hunk ./XMonad/Main.hsc 78
> -- If another WM is running, a BadAccess error will be returned. The
> -- default error handler will write the exception to stderr and exit with
> -- an error.
> - selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask
> - .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask
> - .|. buttonPressMask
> + selectInput dpy rootw $ rootMask initxmc
> +
> sync dpy False -- sync to ensure all outstanding errors are delivered
>
> -- turn off the default handler in favor of one that ignores all errors
> hunk ./XMonad/Operations.hs 187
> -- | hide. Hide a window by unmapping it, and setting Iconified.
> hide :: Window -> X ()
> hide w = whenX (gets (S.member w . mapped)) $ withDisplay $ \d -> do
> - io $ do selectInput d w (clientMask .&. complement structureNotifyMask)
> + cMask <- asks $ clientMask . config
> + io $ do selectInput d w (cMask .&. complement structureNotifyMask)
> unmapWindow d w
> hunk ./XMonad/Operations.hs 190
> - selectInput d w clientMask
> + selectInput d w cMask
> setWMState w iconicState
> -- this part is key: we increment the waitingUnmap counter to distinguish
> -- between client and xmonad initiated unmaps.
> hunk ./XMonad/Operations.hs 205
> io $ mapWindow d w
> whenX (isClient w) $ modify (\s -> s { mapped = S.insert w (mapped s) })
>
> --- | The client events that xmonad is interested in
> -clientMask :: EventMask
> -clientMask = structureNotifyMask .|. enterWindowMask .|. propertyChangeMask
> -
> -- | Set some properties when we initially gain control of a window
> setInitialProperties :: Window -> X ()
> setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do
> hunk ./XMonad/Operations.hs 209
> setWMState w iconicState
> - io $ selectInput d w clientMask
> + asks (clientMask . config) >>= io . selectInput d w
> bw <- asks (borderWidth . config)
> io $ setWindowBorderWidth d w bw
> -- we must initially set the color of new windows, to maintain invariants
> }
>
> Context:
>
> [Issue 135 use wa_border_width for floating windows (neoraider)
> Adam Vogt <vogt.adam at gmail.com>**20130115170715
> Ignore-this: c8ed6ceaf9483e31771ac25d86532f6c
> ]
> [Add flags for call to ghc closing issue 240
> Adam Vogt <vogt.adam at gmail.com>**20130101035034
> Ignore-this: 42a6a8599b615884c95626f74e3ba4a
>
> The -main-is flag goes back to at least ghc 6.10, and maybe the warning that
> this otherwise redundant flag enables (when xmonad.hs isn't a module Main)
> also dates back that far.
> ]
> [TAG 0.11 actual upload
> Adam Vogt <vogt.adam at gmail.com>**20130101014128
> Ignore-this: 2c2a85caeed30cd23f02a7caf229fe7d
> ]
> Patch bundle hash:
> cac8378d4a540119d25b5b221666babeee7cabe3
> {-# LANGUAGE ScopedTypeVariables, DoAndIfThenElse #-}
> ----------------------------------------------------------------------------
> -- |
> -- Module : XMonad.Hooks.RootKeyEvent
> --
> -- Maintainer : Marshall Lochbaum <mlochbaum at gmail.com>
> -- Stability : unstable
> -- Portability : unportable
> --
> -- Allows special handling of keypresses in the root window.
> --
> -----------------------------------------------------------------------------
>
> module XMonad.Hooks.RootKey (
> -- * Usage
> -- $usage
> rootKeyEvent
> ) where
>
> import XMonad
> import Data.Monoid
> import qualified Data.Map as M
>
> -- $usage
> -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
> --
> -- > import XMonad.Hooks.RootKey
> -- >
> -- > main = xmonad $ defaultConfig {
> -- > ...
> -- > rootMask = ... .|. keyPressMask
> -- > handleEventHook = rootKeyEvent
> -- > ...
> -- > }
> --
>
> -- | If we are in the root window, replace a simple keypress with the
> -- corresponding C-M action.
> rootKeyEvent :: Event -> X All
> rootKeyEvent (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code
> ,ev_window = w })
> | t==keyPress = do
> root <- isRoot w
> mClean <- cleanMask m
> if root && (mClean==0) then do
> ks <- asks keyActions
> mm <- asks (modMask . config)
> s <- withDisplay $ \dpy -> io $ keycodeToKeysym dpy code 0
> case (M.lookup (mm.|.controlMask, s) ks) of
> Just x -> userCodeDef () x >> return (All False)
> Nothing -> return (All True)
> else return (All True)
> rootKeyEvent _ = return (All True)
> {-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}
> ----------------------------------------------------------------------------
> -- |
> -- Module : XMonad.Hooks.RepeatKey
> --
> -- Maintainer : Marshall Lochbaum <mlochbaum at gmail.com>
> -- Stability : unstable
> -- Portability : unportable
> --
> -- Binds a keysym to a "repeat last key" key.
> --
> -----------------------------------------------------------------------------
>
> module XMonad.Hooks.RepeatKey (
> -- * Usage
> -- $usage
> repeatKey
> ) where
>
> import XMonad
> import Data.Monoid
> import qualified XMonad.Util.ExtensibleState as XS
>
> -- $usage
> -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
> --
> -- > import XMonad.Hooks.RepeatKey.hs
> -- >
> -- > main = xmonad $ defaultConfig {
> -- > ...
> -- > clientMask = ... .|. keyPressMask
> -- > rootMask = ... .|. keyPressMask
> -- > handleEventHook = repeatKey xK_F13
> -- > ...
> -- > }
> --
> -- xK_F13 can be replaced with any keysym.
>
> -- Stores the last key pressed
> data Keylog = Keylog (KeyMask, KeyCode) | NoKey deriving Typeable
> instance ExtensionClass Keylog where
> initialValue = NoKey
>
> -- | Creates the key repeat hook from a KeySym input
> repeatKey :: KeySym -> Event -> X All
> repeatKey r (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
> | t==keyPress = do
> s <- withDisplay $ \dpy -> io $ keycodeToKeysym dpy code 0
> if s==r then lastKey else XS.put $ Keylog (m, code)
> return (All (s/=r))
> repeatKey _ _ = return (All True)
>
> lastKey :: X ()
> lastKey = do
> k <- XS.get :: X Keylog
> case k of NoKey -> return ()
> Keylog key -> doKeyPress key
> doKeyPress :: (KeyMask, KeyCode) -> X()
> doKeyPress (m,c) = do
> ce <- asks currentEvent
> whenJust ce $ \e -> sendKeyEvent e{ev_state=m, ev_keycode=c}
>
> sendKeyEvent :: Event -> X ()
> sendKeyEvent (KeyEvent
> { ev_event_type = _
> , ev_event_display = d
> , ev_window = w
> , ev_root = r
> , ev_subwindow = sw
> , ev_state = m
> , ev_keycode = c
> , ev_same_screen = ss
> }) =
> io $ allocaXEvent $ \ev -> do
> setEventType ev keyPress
> setKeyEvent ev w r sw m c ss
> sendEvent d w True keyPressMask ev
> setEventType ev keyRelease
> sendEvent d w True keyReleaseMask ev
> sendKeyEvent _ = return ()
> {-# LANGUAGE ScopedTypeVariables, DoAndIfThenElse #-}
> ----------------------------------------------------------------------------
> -- |
> -- Module : XMonad.Hooks.ShowDesktopKey
> --
> -- Maintainer : Marshall Lochbaum <mlochbaum at gmail.com>
> -- Stability : unstable
> -- Portability : unportable
> --
> -- Binds a keysym to a "show desktop" key, which hides all windows when
> -- pressed and restores them when released.
> --
> -----------------------------------------------------------------------------
>
> module XMonad.Hooks.ShowDesktopKey (
> -- * Usage
> -- $usage
> showDesktopKey
> ) where
>
> import XMonad
> import XMonad.StackSet
> import Data.Monoid
>
> -- $usage
> -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
> --
> -- > import XMonad.Hooks.ShowDesktopKey
> -- >
> -- > main = xmonad $ defaultConfig {
> -- > ...
> -- > clientMask = ... .|. keyPressMask .|. keyReleaseMask
> -- > rootMask = ... .|. keyPressMask .|. keyReleaseMask
> -- > handleEventHook = showDesktopKey xK_F14
> -- > ...
> -- > }
> --
> -- xK_F14 can be replaced with any keysym. Note that this key should not
> -- repeat; this can be set using the command @xset -r@ on the keycode at
> -- initialization.
>
> -- | If we are in the root window, replace a simple keypress with the
> -- corresponding C-M action.
> showDesktopKey :: KeySym -> Event -> X All
> showDesktopKey r (KeyEvent {ev_event_type = t, ev_keycode = code}) = do
> s <- withDisplay $ \dpy -> io $ keycodeToKeysym dpy code 0
> if s==r && (t `elem` [keyPress,keyRelease]) then do
> if t==keyPress then hideCurrentWorkspace else revealCurrentWorkspace
> return (All False)
> else return (All True)
> showDesktopKey _ _ = return (All True)
>
> onCurrentWorkspace :: (Window -> X ()) -> X ()
> onCurrentWorkspace f = withWindowSet $ \ws ->
> whenJust (stack . workspace . current $ ws) $ \s -> do
> f $ XMonad.StackSet.focus s
> mapM_ f $ up s
> mapM_ f $ down s
> hideCurrentWorkspace :: X ()
> hideCurrentWorkspace = onCurrentWorkspace hide
> revealCurrentWorkspace :: X ()
> revealCurrentWorkspace = onCurrentWorkspace reveal >> setTopFocus
More information about the xmonad
mailing list