{-# LANGUAGE LambdaCase #-}
--------------------------------------------------------------------------------
-- |
-- Module : XMonad.Util.Grab
-- Description : Utilities for grabbing/ungrabbing keys.
-- Copyright : (c) 2018 L. S. Leary
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : L. S. Leary
-- Stability : unstable
-- Portability : unportable
--
-- This module should not be directly used by users. Its purpose is to
-- facilitate grabbing and ungrabbing keys.
--------------------------------------------------------------------------------
-- --< Imports & Exports >-- {{{
module XMonad.Util.Grab
(
-- * Usage
-- $Usage
grabKP
, ungrabKP
, grabUngrab
, grab
, customRegrabEvHook
) where
-- core
import XMonad
import Control.Monad ( when )
import Data.Foldable ( traverse_ )
-- base
import Data.Semigroup ( All(..) )
-- }}}
-- --< Usage >-- {{{
-- $Usage
--
-- This module should not be directly used by users. Its purpose is to
-- facilitate grabbing and ungrabbing keys.
-- }}}
-- --< Public Utils >-- {{{
-- | A more convenient version of 'grabKey'.
grabKP :: KeyMask -> KeyCode -> X ()
grabKP mdfr kc = do
XConf { display = dpy, theRoot = rootw } <- ask
io (grabKey dpy kc mdfr rootw True grabModeAsync grabModeAsync)
-- | A more convenient version of 'ungrabKey'.
ungrabKP :: KeyMask -> KeyCode -> X ()
ungrabKP mdfr kc = do
XConf { display = dpy, theRoot = rootw } <- ask
io (ungrabKey dpy kc mdfr rootw)
-- | A convenience function to grab and ungrab keys
grabUngrab
:: [(KeyMask, KeySym)] -- ^ Keys to grab
-> [(KeyMask, KeySym)] -- ^ Keys to ungrab
-> X ()
grabUngrab gr ugr = do
traverse_ (uncurry ungrabKP) =<< mkGrabs ugr
traverse_ (uncurry grabKP) =<< mkGrabs gr
-- | A convenience function to grab keys. This also ungrabs all
-- previously grabbed keys.
grab :: [(KeyMask, KeySym)] -> X ()
grab ks = do
XConf { display = dpy, theRoot = rootw } <- ask
io (ungrabKey dpy anyKey anyModifier rootw)
grabUngrab ks []
-- | An event hook that runs a custom action to regrab the necessary keys.
customRegrabEvHook :: X () -> Event -> X All
customRegrabEvHook regr = \case
e@MappingNotifyEvent{} -> do
io (refreshKeyboardMapping e)
when (ev_request e `elem` [mappingKeyboard, mappingModifier])
$ cacheNumlockMask
>> regr
pure (All False)
_ -> pure (All True)
-- }}}