Add limited ability to bind directly to keycodes.

Binding to keycodes is good for nonmnemonic key bindings -- where the
choice of key is due to its position on the keyboard rather than the
character associated with it.

Right now only window bindings and subbindings can use keycode bindings.
Root bindings can still only be keysyms and buttons.

I've been using this feature to map some movement keys to Hyper. This
emulates the function key on my M770 keyboard where fn+ijkl are used as
arrow keys. I use the tab key as my hyper key. With xcape it can operate
as a Tab key when release, or a modifier key when held down, which is
awesome.

1 files changed, 47 insertions, 9 deletions

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 0bf3ba0..3368a4f 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -198,6 +198,27 @@ mediaSeekBDoc = doc "Seek back 3 seconds" mediaSeekB
 
 mediaSeekFDoc = doc "Seek forward 12 seconds" mediaSeekF
 
+kcQ :: KeyCode
+kcQ = 24
+
+kcW :: KeyCode
+kcW = 25
+
+kcE :: KeyCode
+kcE = 26
+
+kcI :: KeyCode
+kcI = 31
+
+kcJ :: KeyCode
+kcJ = 44
+
+kcK :: KeyCode
+kcK = 45
+
+kcL :: KeyCode
+kcL = 46
+
 button6 :: Button
 button6 = 6
 
@@ -881,6 +902,10 @@ bindings = do
             noMod mediaNextDoc
             rawMask shiftMask mediaSeekFDoc
 
+          bind kcW $ do
+            (justMod -|- noMod) $
+              (logs Info "Testing keycode press!" :: X ())
+
           bindOtherKeys $ \(_, _, s) ->
             logs Info "Unhandled key pressed: %s" s
 
@@ -1223,34 +1248,35 @@ applyKeys c =
             }
 
 windowSpecificBindings ::
-  XConfig l -> WriterT (Map (KeyMask, KeySym) (X ())) Query ()
+  XConfig l -> WriterT (Map (KeyMask, KeySym) (X ()), Map (KeyMask, KeyCode) (X ())) Query ()
 windowSpecificBindings config = do
   w <- lift ask
 
   let altMask = mod1Mask
   let mods = permuteMods [shiftMask, controlMask, 0]
   let configureIf b k =
-        let (keymap, _) = resolveBindings (runBinder config k)
-         in tell =<< lift (b --> return (keymap config))
+        let (keymap, keycodemap, _) = resolveBindings (runBinder config k)
+         in tell =<< lift (b --> return (keymap config, keycodemap config))
       emitKey = flip sendKey w
+      mod3 = rawMask mod3Mask
 
   configureIf (return True) $ do
     -- The following are bindings that send keystrokes to the focused window. This
     -- makes navigating with arrow keys and whatnot much easier.
     forM_ (permuteMods [0, controlMask, shiftMask]) $ \mods -> do
-      bind xK_c $
+      bind kcI $
         rawMask (mod3Mask .|. mods) $
           emitKey (mods, xK_Up)
 
-      bind xK_t $
+      bind kcK $
         rawMask (mod3Mask .|. mods) $
           emitKey (mods, xK_Down)
 
-      bind xK_h $
+      bind kcJ $
         rawMask (mod3Mask .|. mods) $
           emitKey (mods, xK_Left)
 
-      bind xK_n $
+      bind kcL $
         rawMask (mod3Mask .|. mods) $
           emitKey (mods, xK_Right)
 
@@ -1291,6 +1317,15 @@ windowSpecificBindings config = do
         rawMask (m .|. mod3Mask) $
           emitKey (m .|. controlMask, xK_Page_Down)
 
+    bind kcQ $
+      mod3 mediaPrev
+
+    bind kcW $
+      mod3 playPause
+
+    bind kcE $
+      mod3 mediaNext
+
   configureIf (flip elem (browsers ++ spotify) <$> className) $ do
     bind xK_h $ do
       rawMask controlMask $ emitKey (0, xK_BackSpace)
@@ -1402,9 +1437,12 @@ windowBindings xconfig =
       w <- ask
 
       liftX $ logs Debug "For Window: %s" (show w)
-      forM_ (Map.toList map) $ \(key, action) -> do
+      forM_ (Map.toList (snd map)) $ \(kc, action) -> do
+        liftX $ logs Debug "   -- remap: %s" (show kc)
+        remapKey (fmap Kc kc) action
+      forM_ (Map.toList (fst map)) $ \(key, action) -> do
         liftX $ logs Debug "   -- remap: %s" (show key)
-        remapKey key action
+        remapKey (fmap Ks key) action
 
 modifyWindowBorder :: Integer -> SpacingModifier
 modifyWindowBorder i = ModifyWindowBorder $ \(Border a b c d) ->