From edd905971d9f0b7b7b09d65fe8ee9cc8337f4172 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Thu, 31 Mar 2022 17:28:23 -0600 Subject: Add a bunch more documentation and ability to see that documentation --- src/Internal/Keys.hs | 275 ++++++++++++++++++++++++++++++++++----------------- 1 file changed, 184 insertions(+), 91 deletions(-) (limited to 'src/Internal/Keys.hs') diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs index 88ec8cf..fcf233e 100644 --- a/src/Internal/Keys.hs +++ b/src/Internal/Keys.hs @@ -1,6 +1,7 @@ -{-# LANGUAGE RankNTypes, FlexibleContexts #-} +{-# LANGUAGE RankNTypes, FlexibleContexts, ViewPatterns #-} module Internal.Keys (applyKeys) where +import XMonad.Util.Run (safeSpawn) import Data.Monoid (Endo(..)) import Control.Monad.Trans.Class import Control.Monad.Reader @@ -70,6 +71,12 @@ playPause = spawnX "spotify-control play" mediaPrev = spawnX "spotify-control prev" mediaNext = spawnX "spotify-control next" +decreaseVolumeDoc = doc "Decrease volume" decreaseVolume +increaseVolumeDoc = doc "Increase volume" increaseVolume +playPauseDoc = doc "Play/Pause current media" playPause +mediaPrevDoc = doc "Previous media" mediaPrev +mediaNextDoc = doc "Next media" mediaNext + button6 :: Button button6 = 6 @@ -131,19 +138,28 @@ keymap = runKeys $ do jumpToLast mapAlpha 0 jumpToMark - shiftMod $ subkeys $ do + shiftMod $ + doc "Swap the current window with a mark." $ + subkeys $ do bind xK_apostrophe $ - (noMod -|- shiftMod -|- rawMask shiftMask) swapWithLastMark + (noMod -|- shiftMod -|- rawMask shiftMask) $ + doc "Swap the current window with the last mark." + swapWithLastMark + mapAlpha shiftMask swapWithMark bind xK_BackSpace $ do -- The only raw keybinding. Meant to get a terminal to unbrick XMonad if -- something goes wrong with the keyboard layout and for first-time boots -- where dmenu/alacritty may not be installed. - rawMask mod4Mask $ spawnX "xterm" + rawMask mod4Mask $ + doc "Spawns XTerm as a fallback if xkb is messed up." $ + spawnX "xterm" -- Moves xmobar to different monitors. - justMod $ spawnX "pkill -SIGUSR1 xmobar" + justMod $ + doc "Move XMobar to another screen." $ + spawnX "pkill -SIGUSR1 xmobar" bind xK_F1 $ do -- Experimental. Sends 'a' to all windows. @@ -157,9 +173,11 @@ keymap = runKeys $ do logs $ "Try send to " ++ show w sendKey (0, xK_a) w - -- Experimental. Sends 'A' 10 times to the focused window. justMod $ - replicateM_ 10 $ withFocused (sendKey (shiftMask, xK_a)) + doc "Print this documentation" $ + (safeSpawn "gxmessage" [ + "-fn", "Source Code Pro", + documentation (keymap config)] :: X ()) bind xK_F7 $ @@ -168,13 +186,13 @@ keymap = runKeys $ do logs (documentation (keymap config)) bind xK_F10 $ do - justMod playPause + justMod playPauseDoc bind xK_F11 $ do - justMod mediaPrev + justMod mediaPrevDoc bind xK_F12 $ do - justMod mediaNext + justMod mediaNextDoc bind xK_Return $ do justMod swapMaster @@ -188,28 +206,48 @@ keymap = runKeys $ do forM_ (zip [xK_a, xK_o, xK_e] [0..]) $ \(key, idx) -> bind key $ do -- Move focus to that screen. - justMod $ withScreen W.view idx + justMod $ + doc ("Switch focus to screen " ++ show idx) $ + withScreen W.view idx -- Swap the current screen with the one given - altMod $ withScreen W.greedyView idx + altMod $ + doc ("Swap the current screen with screen " ++ show idx) $ + withScreen W.greedyView idx -- Move the current window to the select screen. - shiftMod $ withScreen W.shift idx + shiftMod $ + doc ("Move the current window to screne " ++ show idx) $ + withScreen W.shift idx - bind xK_bracketright $ do - justMod $ sendMessage $ modifyWindowBorder 5 + altgrMod $ + logs "Test altgr" + bind xK_bracketright $ do + justMod $ + doc "Increase the gaps between windows." $ + sendMessage $ modifyWindowBorder 5 + bind xK_bracketleft $ do - justMod $ sendMessage $ modifyWindowBorder (-5) + justMod $ + doc "Decrease the gaps between windows." $ + sendMessage $ modifyWindowBorder (-5) bind xK_b $ do justMod $ spawnX "bluetooth-select.sh" bind xK_c $ do - justMod runPassMenu - shiftMod CopyWindow.kill1 + justMod $ + doc "Run PassMenu" runPassMenu + + shiftMod $ + doc "Kill the current window" CopyWindow.kill1 bind xK_f $ do - justMod $ sendMessage FlipLayout - shiftMod $ sendMessage HFlipLayout + justMod $ + doc "Flip the current layout vertically" $ + sendMessage FlipLayout + shiftMod $ + doc "Flip the current layout horizontally" $ + sendMessage HFlipLayout bind xK_g $ do justMod $ @@ -312,22 +350,46 @@ keymap = runKeys $ do doc "Recompile and restart XMonad" $ spawnX "xmonad --recompile && xmonad --restart" - justMod $ subkeys $ do + justMod $ + doc "Experimental Bindings" $ + subkeys $ do bind xK_q $ - (justMod -|- noMod) $ do + (justMod -|- noMod) $ + let fi = fromIntegral + mag (fi -> x₁, fi -> y₁) (fi -> x₂, fi -> y₂) = + sqrt ((x₂ - x₁) ^ 2 + (y₂ - y₁) ^ 2) in + + doc "EXPERIMENTAL: Move mouse to control media." $ fix $ \recur -> do + + -- Moving the mouse 100+ pixels to the right will go to the next song + -- Moving the mouse 100+ pixel to the left will go to the prior song + -- Moving the mouse vertically 100+ pixels will stop the loop + -- + -- May mess up the mouse, requiring an XMonad reboot, which is why + -- this is experimental. It's not the most practical bindings in the + -- world, but it shows that it's theoretically possible to program + -- some neat mouse moptions to do cool things. firstMotion@(x, y) <- nextMotion - (x', y') <- iterateWhile (==firstMotion) nextMotion + (x', y') <- iterateWhile ((<100) . mag firstMotion) nextMotion - logs $ printf "Motion: (%d, %d) (%d, %d)" x y x' y' - if (x' - x) < 0 - then mediaPrev - else mediaNext + if abs (y' - y) > abs (x' - x) + then + if (y' - y) < 0 + then logs "up" + else logs "down" + else do + if (x' - x) < 0 + then mediaPrev + else mediaNext + recur bind xK_r $ do - justMod runDMenu - shiftMod $ sendMessage DoRotate + justMod $ doc "Run a command via Rofi" runDMenu + shiftMod $ + doc "Rotate the current layout. (flips x, y coordinates)" $ + sendMessage DoRotate bind xK_s $ do altMod $ spawnX "sudo -A systemctl suspend && xsecurelock" @@ -350,106 +412,137 @@ keymap = runKeys $ do bind xK_h $ justMod $ doc "Decrease volume." $ - decreaseVolume + decreaseVolumeDoc bind xK_l $ justMod $ doc "Increase volume." $ - increaseVolume + increaseVolumeDoc bind xK_v $ justMod $ (return () :: X ()) bind xK_w $ do - justMod windowJump + justMod $ doc "Jump to a window (via rofi)" windowJump bind xK_x $ do - justMod $ sendMessage ToggleStruts + justMod $ + doc "Toggles respect for struts." $ + sendMessage ToggleStruts bind xK_z $ do - justMod $ subkeys $ do - - bind xK_g $ do - (justMod -|- noMod) $ mapNextString $ \_ s -> - case s of - [ch] | isAlphaNum ch -> windows (CopyWindow.copy s) - _ -> return () - - bind xK_p $ do - (justMod -|- noMod) $ mapNextString $ \_ str -> - spawnX $ printf "gxmessage 'typed: \"%s\"\ncodes: \"%s\"\nunicode: á\n'" - str - (show (map ord str)) - - bind xK_t $ do - (justMod -|- noMod) $ logs "Test Log" - - bind xK_n $ do - (justMod -|- noMod) $ spawnX (terminal config ++ " -t Notes -e notes new") - - bind xK_c $ do - shiftMod CopyWindow.killAllOtherCopies - - bind xK_e $ do - (justMod -|- noMod) $ spawnX "emoji-select.sh" - (shiftMod -|- rawMask shiftMask) $ spawnX "emoticon-select.sh" - - bind xK_a $ - (justMod -|- noMod) $ spawnX "set-sink.sh" - - bind xK_w $ - (justMod -|- noMod) $ spawnX "networkmanager_dmenu" - - bind xK_o $ - (justMod -|- noMod) $ spawnX "library-view.sh" - - bind xK_s $ - (justMod -|- noMod) toggleSwallowEnabled - - bind xK_v $ do - (justMod -|- noMod) $ spawnX "set-volume.sh" - (shiftMod -|- rawMask shiftMask) $ spawnX "set-volume.sh -a" - - -- Double-tap Z to toggle zoom. - bind xK_z $ do - noMod -|- justMod $ sendMessage ToggleZoom + justMod $ + doc "Less often used keybindings." $ + subkeys $ do - -- Z is reserved to create sub keybindings to do various things. - -- I don't really use these at the moment. - bind xK_h $ noMod mediaPrev - bind xK_j $ noMod playPause - bind xK_l $ noMod mediaNext + bind xK_g $ do + (justMod -|- noMod) $ + doc "Copy a window to the given workspace" $ + mapNextString $ \_ s -> + case s of + [ch] | isAlphaNum ch -> windows (CopyWindow.copy s) + _ -> return () + + bind xK_p $ do + (justMod -|- noMod) $ mapNextString $ \_ str -> + spawnX $ printf "gxmessage 'typed: \"%s\"\ncodes: \"%s\"\nunicode: á\n'" + str + (show (map ord str)) + + bind xK_t $ do + (justMod -|- noMod) $ logs "Test Log" + + bind xK_n $ do + (justMod -|- noMod) $ + doc "Take a note" $ + spawnX (terminal config ++ " -t Notes -e notes new") + + bind xK_c $ do + shiftMod $ + doc "Kill all other copies of a window." + CopyWindow.killAllOtherCopies + + bind xK_e $ do + (justMod -|- noMod) $ + doc "Select an emoji" $ + spawnX "emoji-select.sh" + + (shiftMod -|- rawMask shiftMask) $ + doc "Select an emoticon" $ + spawnX "emoticon-select.sh" + + bind xK_a $ + (justMod -|- noMod) $ + doc "Move the audio sink for an application." $ + spawnX "set-sink.sh" + + bind xK_w $ + (justMod -|- noMod) $ + doc "Select a network to connect to." $ + spawnX "networkmanager_dmenu" + + bind xK_o $ + (justMod -|- noMod) $ + doc "Open a file from the library" $ + spawnX "library-view.sh" + + bind xK_s $ + (justMod -|- noMod) $ + doc "Toggle the ability for terminals to swallow child windows." $ + toggleSwallowEnabled + + bind xK_v $ do + (justMod -|- noMod) $ + doc "Set the volume via rofi." $ + spawnX "set-volume.sh" + (shiftMod -|- rawMask shiftMask) $ + doc "Set the volume of an application via rofi." $ + spawnX "set-volume.sh -a" + + -- Double-tap Z to toggle zoom. + bind xK_z $ do + noMod -|- justMod $ + doc "Toggle zoom on the current window." $ + sendMessage ToggleZoom + + -- Z is reserved to create sub keybindings to do various things. + -- I don't really use these at the moment. + bind xK_h $ noMod mediaPrevDoc + bind xK_j $ noMod playPauseDoc + bind xK_l $ noMod mediaNextDoc -- Centers the current focused window. i.e. toggles the Zoom layout -- modifier. - shiftMod $ sendMessage ToggleZoom + shiftMod $ + doc "Toggle zoom on the current window." $ + sendMessage ToggleZoom bind xF86XK_Calculator $ do noMod $ spawnX $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3" bind xF86XK_AudioLowerVolume $ do noMod $ spawnX "pactl set-sink-volume @DEFAULT_SINK@ -1%" - justMod mediaPrev + justMod mediaPrevDoc bind xF86XK_AudioRaiseVolume $ do noMod $ spawnX "pactl set-sink-volume @DEFAULT_SINK@ +1%" - justMod mediaNext + justMod mediaNextDoc bind xF86XK_AudioMute $ do noMod $ spawnX "pactl set-sink-mute @DEFAULT_SINK@ toggle" bind xF86XK_AudioPlay $ do - noMod playPause + noMod playPauseDoc bind xF86XK_AudioNext $ do - noMod mediaNext + noMod mediaNextDoc bind xF86XK_AudioPrev $ do - noMod mediaPrev + noMod mediaPrevDoc bind xF86XK_AudioPrev $ do - noMod mediaPrev + noMod mediaPrevDoc bind xF86XK_MonBrightnessUp $ do noMod $ spawnX "set-backlight.sh +0.05" -- cgit