[xmonad] Darcs patch to expose arbitrary events to event hooks

adam vogt vogt.adam at gmail.com
Thu Feb 21 21:38:22 CET 2013


Hi Marshall,

I've taken a look at the patch. I was hesitant because at least one of
the uses of it is outside of what I think a window manager is
responsible for, such as `map caps lock to a "repeat last key"'. Other
parts of contrib get by with grabKey/grabKeyboard
(XMonad.Actions.Submap, XMonad.Actions.GridSelect, XMonad.Prompt).

But the RootKey.hs and ShowDesktopKey.hs are useful options to have,
and it's a relatively small addition to core, so I just pushed it.

One suggestion for your proposed contrib modules: it might be worth to
change them to functions so that there's no chance that we have only
half of the extension enabled. That is,

addRootKey :: XPConfig -> XPConfig


Regards,
Adam


On Thu, Feb 21, 2013 at 2:56 PM, Marshall Lochbaum <mwlochbaum at gmail.com> wrote:
> 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
>
>
> _______________________________________________
> xmonad mailing list
> xmonad at haskell.org
> http://www.haskell.org/mailman/listinfo/xmonad



More information about the xmonad mailing list