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, 16 insertions, 9 deletions

diff --git a/src/Rahm/Desktop/RebindKeys.hs b/src/Rahm/Desktop/RebindKeys.hs
index 25162ba..fc75eb9 100644
--- a/src/Rahm/Desktop/RebindKeys.hs
+++ b/src/Rahm/Desktop/RebindKeys.hs
@@ -14,6 +14,7 @@ module Rahm.Desktop.RebindKeys
   )
 where
 
+import Control.Applicative ((<|>))
 import Control.Monad (forM, forM_)
 import Control.Monad.Trans.Class (lift)
 import Data.Default (def)
@@ -26,6 +27,7 @@ import qualified Data.Map as Map
     lookup,
   )
 import Data.Monoid (All (..))
+import Rahm.Desktop.Keys.Dsl2 (KeySymOrKeyCode (..))
 import XMonad
   ( Default (def),
     Display,
@@ -63,10 +65,10 @@ import qualified XMonad.Util.ExtensibleState as XS (get, modify)
 type WindowHook = Query ()
 
 newtype InterceptState
-  = InterceptState (Map (KeyMask, KeySym) (X ()))
+  = InterceptState (Map (KeyMask, KeySymOrKeyCode) (X ()))
 
 newtype RemapState
-  = RemapState (Map (Window, (KeyMask, KeySym)) (X ()))
+  = RemapState (Map (Window, (KeyMask, KeySymOrKeyCode)) (X ()))
 
 instance ExtensionClass InterceptState where
   initialValue = InterceptState def
@@ -84,7 +86,8 @@ remapHook event = do
         XConf {display = dpy, theRoot = rootw} <- ask
         keysym <- io $ keycodeToKeysym dpy code 0
 
-        case Map.lookup (win, (m, keysym)) map of
+        case Map.lookup (win, (m, Kc code)) map
+          <|> Map.lookup (win, (m, Ks keysym)) map of
           Just xdo -> do
             xdo
             return (All False)
@@ -106,19 +109,23 @@ getKeyCodesForKeysym dpy keysym = do
 
   return $ keysymToKeycodes keysym
 
-doGrab :: Display -> Window -> (KeyMask, KeySym) -> X ()
-doGrab dpy win (keyMask, keysym) = do
+doGrab :: Display -> Window -> (KeyMask, KeySymOrKeyCode) -> X ()
+doGrab dpy win (keyMask, keySymOrKeyCode) = do
   let grab kc m = io $ grabKey dpy kc m win True grabModeAsync grabModeAsync
 
-  codes <- io $ getKeyCodesForKeysym dpy keysym
+  codes <-
+    case keySymOrKeyCode of
+      Ks keysym ->
+        io $ getKeyCodesForKeysym dpy keysym
+      Kc keycode -> return [keycode]
 
   forM_ codes $ \kc ->
     mapM_ (grab kc . (keyMask .|.)) =<< extraModifiers
 
 disableKey :: (KeyMask, KeySym) -> WindowHook
-disableKey key = remapKey key (return ())
+disableKey key = remapKey (fmap Ks key) (return ())
 
-remapKey :: (KeyMask, KeySym) -> X () -> WindowHook
+remapKey :: (KeyMask, KeySymOrKeyCode) -> X () -> WindowHook
 remapKey keyFrom action = do
   window <- ask
   Query $
@@ -156,4 +163,4 @@ sendKey (keymask, keysym) w = do
 
 rebindKey :: (KeyMask, KeySym) -> (KeyMask, KeySym) -> WindowHook
 rebindKey keyFrom keyTo =
-  (remapKey keyFrom . sendKey keyTo) =<< ask
+  (remapKey (fmap Ks keyFrom) . sendKey keyTo) =<< ask