Add support for root-level keycode mappings.

The code is a bit of a mess, and should probably be moved out of Dsl2
and into a dedicated place, but it works.

I had to do a bit of a hack to get around XMonad's ungrabbing the
keyboard after a Mapping event, which is not the best, but I don't have
a better way of doing it.

1 files changed, 80 insertions, 62 deletions

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 3368a4f..8c78571 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -219,6 +219,9 @@ kcK = 45
 kcL :: KeyCode
 kcL = 46
 
+kcSpace :: KeyCode
+kcSpace = 65
+
 button6 :: Button
 button6 = 6
 
@@ -658,68 +661,73 @@ bindings = do
         sendMessage rotateLayout
 
   bind xK_s $ do
-    forM_ [(JustShift, justMod), (ShiftAndSwap, shiftMod), (ShiftAndFollow, controlMod)] $ \(shiftType, f) ->
-      f $
-        doc
-          ( case shiftType of
-              ShiftAndFollow ->
-                "Shift-and-follow: Like shift-and-swap with the implicit \
-                \third parameter being the current workspace (.)"
-              ShiftAndSwap ->
-                "Shift-and-swap: Shift a windowset to a workspace then swap \
-                \that workspace with another. Primary use case is to move a \
-                \that workspace to a different screen than the current screen. \
-                \Note that this command will only work with normal workspaces."
-              JustShift -> "Shift a windowset to a workspace"
-          )
-          $ pushPendingBuffer
+    forM_
+      [ (JustShift, justMod),
+        (ShiftAndSwap, shiftMod),
+        (ShiftAndFollow, controlMod)
+      ]
+      $ \(shiftType, f) ->
+        f $
+          doc
             ( case shiftType of
-                ShiftAndSwap -> "S "
-                JustShift -> "s "
-                ShiftAndFollow -> "^s "
+                ShiftAndFollow ->
+                  "Shift-and-follow: Like shift-and-swap with the implicit \
+                  \third parameter being the current workspace (.)"
+                ShiftAndSwap ->
+                  "Shift-and-swap: Shift a windowset to a workspace then swap \
+                  \that workspace with another. Primary use case is to move a \
+                  \that workspace to a different screen than the current screen. \
+                  \Note that this command will only work with normal workspaces."
+                JustShift -> "Shift a windowset to a workspace"
             )
-            $ runMaybeT_ $
-              do
-                stackset <- lift $ X.windowset <$> X.get
-                selection <- mapMaybe locationWindow <$> readNextLocationSet
-                withBorderColorM selectedWindowsColor selection $ do
-                  lift $ addStringToPendingBuffer " "
-                  ws <- readNextWorkspace
-                  finalSwap <-
-                    case shiftType of
-                      ShiftAndSwap -> do
-                        lift $ addStringToPendingBuffer " "
-                        wsName <- MaybeT . return $ workspaceName ws
-                        W.switchWorkspaces wsName <$> readNextWorkspaceName
-                      _ -> return id
-
-                  lift $ do
-                    (Endo allMovements) <-
-                      mconcat
-                        <$> mapM (fmap Endo . moveWindowToWorkspaceFn ws) selection
-
-                    setAlternateWindows selection
-
-                    forM_ selection $ \win -> do
-                      mapM_
-                        ( \t -> do
-                            logs Debug "Set alternate workspace %s -> %s" (show win) t
-                            setAlternateWorkspace win t
-                        )
-                        (W.findTag win stackset)
-
-                    withWindowsUnpinned selection $
-                      windows $
-                        finalSwap
-                          . ( \ss ->
-                                case shiftType of
-                                  ShiftAndFollow
-                                    | (w : _) <- selection,
-                                      Just ws <- W.findTag w ss ->
-                                      W.greedyView ws ss
-                                  _ -> ss
-                            )
-                          . allMovements
+            $ pushPendingBuffer
+              ( case shiftType of
+                  ShiftAndSwap -> "S "
+                  JustShift -> "s "
+                  ShiftAndFollow -> "^s "
+              )
+              $ runMaybeT_ $
+                do
+                  stackset <- lift $ X.windowset <$> X.get
+                  selection <- mapMaybe locationWindow <$> readNextLocationSet
+                  withBorderColorM selectedWindowsColor selection $ do
+                    lift $ addStringToPendingBuffer " "
+                    ws <- readNextWorkspace
+                    finalSwap <-
+                      case shiftType of
+                        ShiftAndSwap -> do
+                          lift $ addStringToPendingBuffer " "
+                          wsName <- MaybeT . return $ workspaceName ws
+                          W.switchWorkspaces wsName <$> readNextWorkspaceName
+                        _ -> return id
+
+                    lift $ do
+                      (Endo allMovements) <-
+                        mconcat
+                          <$> mapM (fmap Endo . moveWindowToWorkspaceFn ws) selection
+
+                      setAlternateWindows selection
+
+                      forM_ selection $ \win -> do
+                        mapM_
+                          ( \t -> do
+                              logs Debug "Set alternate workspace %s -> %s" (show win) t
+                              setAlternateWorkspace win t
+                          )
+                          (W.findTag win stackset)
+
+                      withWindowsUnpinned selection $
+                        windows $
+                          finalSwap
+                            . ( \ss ->
+                                  case shiftType of
+                                    ShiftAndFollow
+                                      | (w : _) <- selection,
+                                        Just ws <- W.findTag w ss ->
+                                        W.greedyView ws ss
+                                    _ -> ss
+                              )
+                            . allMovements
 
     altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
 
@@ -830,6 +838,10 @@ bindings = do
           bind xK_bracketleft $ noMod spaceResize
           bind xK_bracketright $ noMod spaceResize
 
+  bind kcSpace $ do
+    rawMask mod3Mask
+      playPauseDoc
+
   bind xK_t $ do
     justMod $
       doc "Spawn a terminal." $
@@ -845,6 +857,12 @@ bindings = do
       doc "Spawn a floating terminal" $
         spawnX =<< asks ((++ " -t Floating\\ Term") . terminal . config)
 
+  bind xK_i $ do
+    justMod $ do
+      XConf {display = dpy, theRoot = rootw} <- ask
+      io $ grabKey dpy 65 32 rootw True grabModeAsync grabModeAsync
+      (return () :: X ())
+
   bind xK_z $ do
     justMod $
       doc "Less often used keybindings." $
@@ -1218,7 +1236,7 @@ bindings = do
                                in windows f >> escape
 
 --   where
--- 
+--
 --   permuteMods = map (foldl' (.|.) 0) . filterM (const [True, False])
 
 myMouseMoveWindow =
@@ -1255,7 +1273,7 @@ windowSpecificBindings config = do
   let altMask = mod1Mask
   let mods = permuteMods [shiftMask, controlMask, 0]
   let configureIf b k =
-        let (keymap, keycodemap, _) = resolveBindings (runBinder config k)
+        let (Bindings keymap keycodemap _) = resolveBindings (runBinder config k)
          in tell =<< lift (b --> return (keymap config, keycodemap config))
       emitKey = flip sendKey w
       mod3 = rawMask mod3Mask