Implement documentation for mouse bindings.

1 files changed, 189 insertions, 117 deletions

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 49fe1fb..8ed0b06 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -197,11 +197,26 @@ keymap = runKeys $ do
             "gxmessage"
             [ "-fn",
               "Source Code Pro",
-              documentation (keymap config)
+              "Key Bindings\n\n"
+                ++ documentation (keymap config)
+                ++ "\n\nButton Bindings\n\n"
+                ++ buttonDocumentation (mouseMap config)
             ] ::
             X ()
         )
 
+  bind xK_F7 $ do
+    justMod $
+      doc
+        "Print this documentation to stdout (at LogLevel Info)"
+        ( logs
+            Info
+            "KeyBindings\n\n%s\n\nButtonBindings\n\n%s"
+            (documentation (keymap config))
+            (buttonDocumentation (mouseMap config)) ::
+            X ()
+        )
+
   bind xK_F10 $ do
     justMod playPauseDoc
 
@@ -289,12 +304,12 @@ keymap = runKeys $ do
     shiftMod $
       doc
         "Switch to a different theater.\n\n\t\
-        \Theaters are like super-workspaces. They are used for different\n\
-        \'contexts'. Theaters share all the windows with eachother, but\n\
-        \but each theater has its own mappings for window -> workspace. i.e.\n\
-        \one theater can have window 'x' on workspace 'y', but another might\n\
-        \have 'x' on 'z' instead. If a theater does explicity place a window,\n\
-        \the window is placed in the hidden workspace (which is '*')"
+        \Theaters are like super-workspaces. They are used for different\n\t\
+        \'contexts'. Theaters share all the windows with eachother, but\n\t\
+        \but each theater has its own mappings for window -> workspace. i.e.\n\t\
+        \one theater can have window 'x' on workspace 'y', but another might\n\t\
+        \have 'x' on 'z' instead. If a theater does explicity place a window,\n\t\
+        \the window is placed in the hidden workspace (which is '*')\n"
         $ pushPendingBuffer "G " $
           runMaybeT_ $ do
             mapNextString $ \_ str -> lift $
@@ -311,13 +326,13 @@ keymap = runKeys $ do
             noMod $
               doc
                 "Record a windowset macro.\n\n\t\
-                \To record a 'windowset' macro, type <M-d>w<key> and then\n\
-                \type a character sequence followed by Enter. Now <key> can\n\
-                \be used anywhere a 'windowset' is required and that macro\n\
+                \To record a 'windowset' macro, type <M-d>w<key> and then\n\t\
+                \type a character sequence followed by Enter. Now <key> can\n\t\
+                \be used anywhere a 'windowset' is required and that macro\n\t\
                 \will be used.\n\n\t\
-                \For example, if one wants to define '+' as 'all windows \n\
+                \For example, if one wants to define '+' as 'all windows \n\t\
                 \not on the current workspace, one can type:\n\n\t\
-                \<M-d>w+\\%@.<Enter>"
+                \<M-d>w+\\%@.<Enter>\n"
                 $ pushPendingBuffer "Win Macro " $
                   runMaybeT_ readWindowsetMacro
 
@@ -325,14 +340,14 @@ keymap = runKeys $ do
             noMod $
               doc
                 "Record a workspace macro\n\n\t\
-                \To record a 'workspace' macro, type <M-d>t<key> and then\n\
-                \type a character sequence followed by Enter. Now <key> can\n\
-                \be used anywhere a 'workspace' is required and that macro\n\
+                \To record a 'workspace' macro, type <M-d>t<key> and then\n\t\
+                \type a character sequence followed by Enter. Now <key> can\n\t\
+                \be used anywhere a 'workspace' is required and that macro\n\t\
                 \will be used.\n\n\t\
-                \For example, if one wants to define '<c-s>' as 'the workspace with\n\
-                \the window 's' on it or the last workspace if already on that \n\
+                \For example, if one wants to define '<c-s>' as 'the workspace with\n\t\
+                \the window 's' on it or the last workspace if already on that \n\t\
                 \workspace (more useful that one would think):\n\n\t\
-                \<M-d>t<c-s>?&s@.'s<Enter>"
+                \<M-d>t<c-s>?&s@.'s<Enter>\n"
                 $ pushPendingBuffer "Wksp Macro " $
                   runMaybeT_ readWorkspaceMacro
 
@@ -387,8 +402,8 @@ keymap = runKeys $ do
   bind xK_minus $ do
     justMod $
       doc
-        "Decrease the number of windows in the  master region, or decrease\n\
-        \the size of the master region if the current layout cannot have more\n\
+        "Decrease the number of windows in the  master region, or decrease\n\t\
+        \the size of the master region if the current layout cannot have more\n\t\
         \than one window in the master region."
         $ sendMessage $ IncMasterN (-1)
 
@@ -399,9 +414,9 @@ keymap = runKeys $ do
   bind xK_m $ do
     justMod $
       doc
-        "Mark the windows described by the window set with a given character.\n\n\
-        \For example, to mark the current window use <M-m>.<character>. That window\n\n\
-        \can then be recalled anywhere that requires a WML window."
+        "Mark the windows described by the window set with a given character.\n\n\t\
+        \For example, to mark the current window use <M-m>.<character>. That window\n\n\t\
+        \can then be recalled anywhere that requires a WML window.\n"
         $ do
           pushPendingBuffer "m " $ do
             locs <- fromMaybe [] <$> runMaybeT readNextLocationSet
@@ -417,9 +432,9 @@ keymap = runKeys $ do
   bind xK_plus $ do
     justMod $
       doc
-        "Increase the number of windows in the  master region, or increase\n\
-        \the size of the master region if the current layout cannot have more\n\
-        \than one window in the master region."
+        "Increase the number of windows in the  master region, or increase\n\t\
+        \the size of the master region if the current layout cannot have more\n\t\
+        \than one window in the master region.\n"
         $ sendMessage $ IncMasterN 1
 
     shiftMod $
@@ -556,16 +571,10 @@ keymap = runKeys $ do
         \increase volume respectively"
         $ repeatable $ do
           bind xK_h $
-            justMod $
-              doc
-                "Decrease volume."
-                decreaseVolumeDoc
+            justMod decreaseVolumeDoc
 
           bind xK_l $
-            justMod $
-              doc
-                "Increase volume."
-                increaseVolumeDoc
+            justMod increaseVolumeDoc
 
           bind xK_v $
             justMod (return () :: X ())
@@ -695,13 +704,13 @@ keymap = runKeys $ do
 buttonBindingsToButtonMap :: (XConfig l -> ButtonBindings) -> ButtonsMap l
 buttonBindingsToButtonMap bindings config = Map.mapWithKey bindingToX (bindings config)
   where
-    bindingToX :: (ButtonMask, Button) -> ButtonBinding -> (Window -> X ())
+    bindingToX :: (ButtonMask, Button) -> Documented ButtonBinding -> (Window -> X ())
     bindingToX click@(mask, btn) = \case
-      (ButtonAction action) -> action
-      (ButtonSubmap sm) ->
+      Documented _ (ButtonAction action) -> action
+      Documented _ (ButtonSubmap sm) ->
         pushAddPendingBuffer (printf "b%d " btn)
           . submapButtonsWithKey (\_ _ -> return ()) (Map.mapWithKey bindingToX sm)
-      (ButtonContinuous sm) -> \window ->
+      Documented _ (ButtonContinuous sm) -> \window ->
         pushAddPendingBuffer (printf "b%d " btn) $ do
           mapM_ (flip (bindingToX click) window) (Map.lookup click sm)
           fix $ \recur -> do
@@ -735,113 +744,176 @@ mouseMap = runButtons $ do
                 rawMask m $
                   ButtonContinuous bindingMap
 
-      action :: X () -> (Window -> X ())
-      action = const
-
   bind button1 $ do
-    justMod $ \w -> focus w >> mouseMoveWindow w >> windows W.shiftMaster
+    justMod $
+      doc "Float and move a window" $
+        \w ->
+          pushPendingBuffer "Dragging" $
+            focus w >> mouseMoveWindow w >> windows W.shiftMaster
 
   bind button2 $ do
     justMod $ windows . (W.shiftMaster .) . W.focusWindow
 
   bind button3 $ do
-    justMod $ \w -> focus w >> mouseResizeWindow w >> windows W.shiftMaster
+    justMod $
+      doc "Float and resize a window" $
+        \w -> focus w >> mouseResizeWindow w >> windows W.shiftMaster
 
   bind button6 $
     justMod $
-      noWindow (viewAdjacent prev)
+      doc "Move to the workspace to the left" $
+        noWindow (viewAdjacent prev)
 
   bind button7 $
     justMod $
-      noWindow (viewAdjacent next)
+      doc "Move to the workspace to the right" $
+        noWindow (viewAdjacent next)
 
   bind button8 $
-    justMod $ noWindow mediaPrev
+    justMod $
+      doc "Media previous" $
+        noWindow mediaPrev
 
   bind button9 $
-    justMod $ noWindow mediaNext
+    justMod $
+      doc "Media next" $
+        noWindow mediaNext
 
   bind button14 $ do
     noMod $
-      subMouse $ do
-        bind button3 $
-          noMod $ noWindow (gotoWorkspace "s")
-
-        bind button13 $ do
-          noMod $ noWindow $ click >> CopyWindow.kill1
-
-        bind button14 $ do
-          noMod $ noWindow $ click >> sendMessage togglePop
+      doc "Additional Mouse Bindings" $
+        subMouse $ do
+          bind button3 $
+            noMod $
+              doc "Move to workspace 's' (Spotify)" $
+                noWindow (gotoWorkspace "s")
 
-        bind button15 $ do
-          noMod $ noWindow $ spawnX "pavucontrol"
+          bind button13 $ do
+            noMod $
+              doc "Kill the window under the cursor" $
+                noWindow $ click >> CopyWindow.kill1
 
-        let mediaButtons =
-              [ (button4, action increaseVolume),
-                (button5, action decreaseVolume),
-                (button2, action playPause),
-                (button9, action historyForward),
-                (button8, action historyBack),
-                (button6, action mediaPrev),
-                (button7, action mediaNext)
-              ]
+          bind button14 $ do
+            noMod $
+              doc "Pop the window under the cursor" $
+                noWindow $ click >> sendMessage togglePop
 
-        continuous $
-          forM_ mediaButtons $ \(b, a) ->
-            bind b $ noMod a
+          bind button15 $ do
+            noMod $
+              doc "Spawn 'pavucontrol'" $
+                noWindow $ spawnX "pavucontrol"
+
+          let mediaButtons =
+                [ (button4, "Increase volume", noWindow increaseVolume),
+                  (button5, "Decrease volume", noWindow decreaseVolume),
+                  (button2, "Play/Pause", noWindow playPause),
+                  (button9, "History Forward", noWindow historyForward),
+                  (button8, "History Back", noWindow historyBack),
+                  (button6, "Media Previous", noWindow mediaPrev),
+                  (button7, "Media Next", noWindow mediaNext)
+                ]
+
+          continuous $
+            forM_ mediaButtons $ \(b, d, a) ->
+              bind b $ noMod $ doc d a
 
   bind button13 $
     noMod $
-      subMouse $ do
-        bind button1 $ noMod mouseMoveWindow
-        bind button2 $ noMod $ windows . W.sink
-        bind button3 $ noMod mouseResizeWindow
-
-        let swapButtons =
-              [ (button6, action $ windows W.swapDown),
-                (button7, action $ windows W.swapUp)
-              ]
-
-        continuous $
-          forM_ swapButtons $ \(b, a) ->
-            bind b $ noMod a
-
-        bind button13 $
-          noMod $
-            subMouse $ do
-              bind button13 $
-                noMod $
-                  subMouse $ do
-                    bind button13 $ noMod $ noWindow $ spawnX "xsecurelock"
-                    bind button1 $
-                      noMod $
-                        noWindow $
-                          spawnX "sudo -A systemctl suspend && xsecurelock"
+      doc "General Window Management Extra Mouse Bindings" $
+        subMouse $ do
+          bind button1 $
+            noMod $
+              doc "Start moving the window under the cursor" mouseMoveWindow
+
+          bind button2 $
+            noMod $
+              doc "Sink the window under the cursor into the tiling" $
+                windows . W.sink
+
+          bind button3 $
+            noMod $
+              doc "Resize the window under the cursor" mouseResizeWindow
+
+          let swapButtons =
+                [ ( button6,
+                    "Swap the current window with the next one in the stack",
+                    noWindow $ windows W.swapDown
+                  ),
+                  ( button7,
+                    "Swap the current window with the last one in the stack",
+                    noWindow $ windows W.swapUp
+                  )
+                ]
+
+          continuous $
+            forM_ swapButtons $ \(b, d, a) ->
+              bind b $ noMod $ doc d a
+
+          bind button13 $
+            noMod $
+              subMouse $ do
+                bind button13 $
+                  noMod $
+                    subMouse $ do
+                      bind button13 $
+                        noMod $
+                          doc "Lock the screen" $
+                            noWindow $ spawnX "xsecurelock"
+                      bind button1 $
+                        noMod $
+                          doc "Suspend the system" $
+                            noWindow $
+                              spawnX "sudo -A systemctl suspend && xsecurelock"
 
   bind button15 $ do
     noMod $
-      subMouse $ do
-        bind button13 $
-          noMod $
-            noWindow $
-              gotoWorkspace . accompaningWorkspace =<< getCurrentWorkspace
-
-        bind button15 $ do
-          noMod $ noWindow jumpToLastLocation
-
-        let workspaceButtons =
-              [ (button2, action swapMaster),
-                (button9, action $ viewAdjacent next),
-                (button8, action $ viewAdjacent prev),
-                (button4, action $ windows W.focusUp),
-                (button5, action $ windows W.focusDown),
-                (button7, action $ windows W.screenRotateForward),
-                (button6, action $ windows W.screenRotateBackward)
-              ]
-
-        continuous $
-          forM_ workspaceButtons $ \(b, a) ->
-            bind b $ noMod a
+      doc "General navigation extra mouse bindings" $
+        subMouse $ do
+          bind button13 $
+            noMod $
+              doc "Goto the accompaning workspace to the current one." $
+                noWindow $
+                  gotoWorkspace . accompaningWorkspace =<< getCurrentWorkspace
+
+          bind button15 $ do
+            noMod $
+              doc "Jump to the last location." $
+                noWindow jumpToLastLocation
+
+          let workspaceButtons =
+                [ ( button2,
+                    "Swap the master window with the one under the cursor",
+                    noWindow swapMaster
+                  ),
+                  ( button9,
+                    "View the next workspace",
+                    noWindow $ viewAdjacent next
+                  ),
+                  ( button8,
+                    "View the previous workspace",
+                    noWindow $ viewAdjacent prev
+                  ),
+                  ( button4,
+                    "Focus the previous window in the stack",
+                    noWindow $ windows W.focusUp
+                  ),
+                  ( button5,
+                    "Focus the next window in the stack",
+                    noWindow $ windows W.focusDown
+                  ),
+                  ( button7,
+                    "Rotate the visible workspaces on the screens to the right",
+                    noWindow $ windows W.screenRotateForward
+                  ),
+                  ( button6,
+                    "Rotate the visible workspaces on the screens to the left",
+                    noWindow $ windows W.screenRotateBackward
+                  )
+                ]
+
+          continuous $
+            forM_ workspaceButtons $ \(b, d, a) ->
+              bind b $ noMod $ doc d a
 
 -- Bindings specific to a window. These are set similarly to th ekeymap above,
 -- but uses a Query monad to tell which windows the keys will apply to.