1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
module Rahm.Desktop.Keys.KeyCodeMapping where
import Rahm.Desktop.Keys.Grab
import Data.Map (Map)
import qualified Data.Map as Map
import XMonad
import qualified XMonad.Util.ExtensibleConf as XC
import Control.Monad (forM_)
import Control.Monad.RWS (All(All))
type KeyCodeActionMap = Map (KeyMask, KeyCode) (X ())
getKeycodeMap :: X (Maybe KeyCodeActionMap)
getKeycodeMap = XC.ask
setupKeycodeMapping ::
(forall l. XConfig l -> KeyCodeActionMap) -> XConfig l -> XConfig l
setupKeycodeMapping actionMap config =
XC.once
( \c ->
c
{ handleEventHook = handleEventHook c <> eventHandler,
startupHook = startupHook c >> startupHandler
}
)
(actionMap config)
config
where
startupHandler = grabKeycodes
eventHandler
e@( KeyEvent
{ ev_event_type = t,
ev_keycode = kc,
ev_state = m
}
)
| t == keyPress = do
mapM_ (sequence_ . Map.lookup (m, kc))
=<< getKeycodeMap
return (All True)
eventHandler e@MappingNotifyEvent {} = do
-- Ideally, we'd like to grab the keys here, but XMonad regrabs its keys
-- after the user event handlers run and in the process ungrab any keys
-- we just grabbed.
--
-- So, we'll emit an X11 ClientMessage to tell us to regrab the keys
-- instead. This will then run after xmonad ungrabs the keys.
XConf {display = dpy, theRoot = rootw} <- ask
io $ do
at <- internAtom dpy "REGRAB_KEYCODES" False
m <- internAtom dpy "" False
allocaXEvent $ \ev -> do
setEventType ev clientMessage
setClientMessageEvent ev rootw at 32 m currentTime
sendEvent dpy rootw False structureNotifyMask ev
sync dpy False
return (All True)
eventHandler e@ClientMessageEvent {ev_message_type = atom} = do
-- We are asked to regrab the keycodes, so we'll do that.
dpy <- asks display
name <- io $ getAtomName dpy atom
if name == Just "REGRAB_KEYCODES"
then grabKeycodes >> return (All False)
else return (All True)
eventHandler _ = return (All True)
grabKeycodes :: X ()
grabKeycodes = do
XConf {display = dpy, theRoot = rootw} <- ask
mKeycodeBinds <- getKeycodeMap
forM_ mKeycodeBinds $ \keycodeBinds -> do
forM_ (Map.toList keycodeBinds) $ \((m, kc), _) -> do
doGrab dpy rootw (m, Kc kc)
|
