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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
-- Module for intercepting key presses not explicity mapped in the key bindings.
-- This uses some deep magic with grabKey and windows and everything else, but
-- it makes window-specific key bindings awesome!
module Rahm.Desktop.RebindKeys where
import XMonad
import Text.Printf
import Control.Monad.Trans.Class (lift)
import Control.Monad (forM, forM_)
import Data.Default (Default, def)
import Data.Map (Map)
import qualified Data.Map as Map
import qualified XMonad.Util.ExtensibleState as XS
import Data.Monoid (All(..))
import Rahm.Desktop.Logger
import Rahm.Desktop.NoPersist
type WindowHook = Query ()
newtype InterceptState =
InterceptState (NoPersist (Map (KeyMask, KeySym) (X ())))
newtype RemapState =
RemapState (NoPersist (Map (Window, (KeyMask, KeySym)) (X ())))
instance ExtensionClass InterceptState where
initialValue = InterceptState def
instance ExtensionClass RemapState where
initialValue = RemapState def
remapHook :: Event -> X All
remapHook event = do
RemapState (NoPersist map) <- XS.get
case event of
KeyEvent { ev_window = win, ev_event_type = typ, ev_keycode = code, ev_state = m }
| typ == keyPress-> do
XConf {display = dpy, theRoot = rootw} <- ask
keysym <- io $ keycodeToKeysym dpy code 0
case Map.lookup (win, (m, keysym)) map of
Just xdo -> do
xdo
return (All False)
Nothing -> return (All True)
_ -> return (All True)
getKeyCodesForKeysym :: Display -> KeySym -> IO [KeyCode]
getKeyCodesForKeysym dpy keysym = do
let (minCode, maxCode) = displayKeycodes dpy
allCodes = [fromIntegral minCode .. fromIntegral maxCode]
syms <- forM allCodes $ \code -> keycodeToKeysym dpy code 0
let keysymMap' = Map.fromListWith (++) (zip syms [[code] | code <- allCodes])
-- keycodeToKeysym returns noSymbol for all unbound keycodes, and we don't
-- want to grab those whenever someone accidentally uses def :: KeySym
let keysymMap = Map.delete noSymbol keysymMap'
let keysymToKeycodes sym = Map.findWithDefault [] keysym keysymMap
return $ keysymToKeycodes keysym
doGrab :: Display -> Window -> (KeyMask, KeySym) -> X ()
doGrab dpy win (keyMask, keysym) = do
let grab kc m = io $ grabKey dpy kc m win True grabModeAsync grabModeAsync
codes <- io $ getKeyCodesForKeysym dpy keysym
forM_ codes $ \kc ->
mapM_ (grab kc . (keyMask .|.)) =<< extraModifiers
disableKey :: (KeyMask, KeySym) -> WindowHook
disableKey key = remapKey key (return ())
remapKey :: (KeyMask, KeySym) -> X () -> WindowHook
remapKey keyFrom action = do
window <- ask
Query $ lift $ do
XConf { display = disp, theRoot = rootw } <- ask
doGrab disp window keyFrom
XS.modify $ \(RemapState (NoPersist keyMap)) -> RemapState $ NoPersist $
Map.insert (window, keyFrom) action keyMap
-- sendKey, but as a query.
sendKeyQ :: (KeyMask, KeySym) -> Query ()
sendKeyQ key = do
win <- ask
liftX (sendKey key win)
sendKey :: (KeyMask, KeySym) -> Window -> X ()
sendKey (keymask, keysym) w = do
XConf { display = disp, theRoot = rootw } <- ask
codes <- io $ getKeyCodesForKeysym disp keysym
case codes of
(keycode:_) ->
io $ allocaXEvent $ \xEv -> do
setEventType xEv keyPress
setKeyEvent xEv w rootw none keymask keycode True
sendEvent disp w True keyPressMask xEv
setEventType xEv keyRelease
sendEvent disp w True keyReleaseMask xEv
_ -> return ()
rebindKey :: (KeyMask, KeySym) -> (KeyMask, KeySym) -> WindowHook
rebindKey keyFrom keyTo =
(remapKey keyFrom . sendKey keyTo) =<< ask
|
