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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.KeyRemap
-- Copyright : (c) Christian Dietrich
-- License : BSD-style (as xmonad)
--
-- Maintainer : stettberger@dokucde.de
-- Stability : unstable
-- Portability : unportable
--
-- Remap Keybinding on the fly, e.g having Dvorak char, but everything with Control/Shift
-- is left us Layout
--
-----------------------------------------------------------------------------
module XMonad.Actions.KeyRemap (
-- * Usage
-- $usage
setKeyRemap,
buildKeyRemapBindings,
setDefaultKeyRemap,
KeymapTable (KeymapTable),
emptyKeyRemap,
dvorakProgrammerKeyRemap
) where
import XMonad
import XMonad.Util.Paste
import Data.List
import qualified XMonad.Util.ExtensibleState as XS
import Control.Monad
data KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Typeable, Show)
instance ExtensionClass KeymapTable where
initialValue = KeymapTable []
-- $usage
-- Provides the possibility to remap parts of the keymap to generate different keys
--
-- * E.g You want to type Programmers Dvorak, but your keybindings should be the normal us layout
-- after all
--
-- First, you must add all possible keybindings for all layout you want to use:
--
-- > keys = myKeys ++ buildKeyRemapBindings [dvorakProgrammerKeyRemap,emptyKeyRemap]
--
-- Then you must add setDefaultKeyRemap to your startup hook (e.g. you want to set the
-- empty keyremap (no remapping is done) as default after startup):
--
-- > myStartupHook :: X()
-- > myStartupHook = do
-- > setWMName "LG3D"
-- > setDefaultKeyRemap emptyKeyRemap [dvorakProgrammerKeyRemap, emptyKeyRemap]
--
-- Then you add keybindings for changing keyboard layouts;
--
-- > , ((0 , xK_F1 ), setKeyRemap emptyKeyRemap)
-- > , ((0 , xK_F2 ), setKeyRemap dvorakProgrammerKeyRemap)
--
-- When defining your own keymappings, please be aware of:
--
-- * If you want to emulate a key that is shifted on us you must emulate that keypress:
--
-- > KeymapTable [((0, xK_a), (shiftMask, xK_5))] -- would bind 'a' to '%'
-- > KeymapTable [((shiftMask, xK_a), (0, xK_5))] -- would bind 'A' to '5'
--
-- * the dvorakProgrammerKeyRemap uses the original us layout as lookuptable to generate
-- the KeymapTable
--
-- * KeySym and (ord Char) are incompatible, therefore the magic numbers in dvorakProgrammerKeyRemap
-- are nessesary
doKeyRemap :: KeyMask -> KeySym -> X()
doKeyRemap mask sym = do
table <- XS.get
let (insertMask, insertSym) = extractKeyMapping table mask sym
sendKey insertMask insertSym
-- | Using this in the keybindings to set the actual Key Translation table
setKeyRemap :: KeymapTable -> X()
setKeyRemap table = do
let KeymapTable newtable = table
KeymapTable oldtable <- XS.get
XConf { display = dpy, theRoot = rootw } <- ask
let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync
let ungrab kc m = io $ ungrabKey dpy kc m rootw
forM_ oldtable $ \((mask, sym), _) -> do
kc <- io $ keysymToKeycode dpy sym
-- "If the specified KeySym is not defined for any KeyCode,
-- XKeysymToKeycode() returns zero."
when (kc /= 0) $ ungrab kc mask
forM_ newtable $ \((mask, sym), _) -> do
kc <- io $ keysymToKeycode dpy sym
-- "If the specified KeySym is not defined for any KeyCode,
-- XKeysymToKeycode() returns zero."
when (kc /= 0) $ grab kc mask
XS.put table
-- | Adding this to your startupHook, to select your default Key Translation table.
-- You also must give it all the KeymapTables you are willing to use
setDefaultKeyRemap :: KeymapTable -> [KeymapTable] -> X()
setDefaultKeyRemap dflt keyremaps = do
XS.put (KeymapTable mappings)
setKeyRemap dflt
where
mappings = nub (keyremaps >>= \(KeymapTable table) -> table)
extractKeyMapping :: KeymapTable -> KeyMask -> KeySym -> (KeyMask, KeySym)
extractKeyMapping (KeymapTable table) mask sym =
insertKey filtered
where filtered = filter (\((m, s),_) -> m == mask && s == sym) table
insertKey [] = (mask, sym)
insertKey ((_, to):_) = to
-- | Append the output of this function to your keybindings with ++
buildKeyRemapBindings :: [KeymapTable] -> [((KeyMask, KeySym), X ())]
buildKeyRemapBindings keyremaps =
[((mask, sym), doKeyRemap mask sym) | (mask, sym) <- bindings]
where mappings = concat (map (\(KeymapTable table) -> table) keyremaps)
bindings = nub (map (\binding -> fst binding) mappings)
-- Here come the Keymappings
-- | The empty KeymapTable, does no translation
emptyKeyRemap :: KeymapTable
emptyKeyRemap = KeymapTable []
-- | The dvorak Programmers keymap, translates from us keybindings to dvorak programmers
dvorakProgrammerKeyRemap :: KeymapTable
dvorakProgrammerKeyRemap =
KeymapTable [((charToMask maskFrom, from), (charToMask maskTo, to)) |
(maskFrom, from, maskTo, to) <- (zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey)]
where
layoutUs = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./~!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:\"ZXCVBNM<>?" :: [KeySym]
layoutUsKey = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./" :: [KeySym]
layoutUsShift = "0000000000000000000000000000000000000000000000011111111111111111111111111111111111111111111111"
layoutDvorak = map (fromIntegral . fromEnum) "$&[{}(=*)+]!#;,.pyfgcrl/@\\aoeuidhtns-'qjkxbmwvz~%7531902468`:<>PYFGCRL?^|AOEUIDHTNS_\"QJKXBMWVZ" :: [KeySym]
layoutDvorakShift = map getShift layoutDvorak
layoutDvorakKey = map getKey layoutDvorak
getKey char = let Just index = elemIndex char layoutUs
in layoutUsKey !! index
getShift char = let Just index = elemIndex char layoutUs
in layoutUsShift !! index
charToMask char = if [char] == "0" then 0 else shiftMask
|
