aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop/Keys.hs
diff options
context:
space:
mode:
authorJosh Rahm <joshuarahm@gmail.com>2022-04-10 13:26:16 -0600
committerJosh Rahm <joshuarahm@gmail.com>2022-10-09 12:19:46 -0600
commita652c330707e2e9bbe963e01af79ce730cf3452e (patch)
tree047655195f50efcbd51db8f825acf589dc6abead /src/Rahm/Desktop/Keys.hs
parent381a3e5a00813314249bb74b5460f5ff5a4006bb (diff)
downloadrde-a652c330707e2e9bbe963e01af79ce730cf3452e.tar.gz
rde-a652c330707e2e9bbe963e01af79ce730cf3452e.tar.bz2
rde-a652c330707e2e9bbe963e01af79ce730cf3452e.zip
Rename Internal to Rahm.Desktop
Diffstat (limited to 'src/Rahm/Desktop/Keys.hs')
-rw-r--r--src/Rahm/Desktop/Keys.hs820
1 files changed, 820 insertions, 0 deletions
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
new file mode 100644
index 0000000..9712f84
--- /dev/null
+++ b/src/Rahm/Desktop/Keys.hs
@@ -0,0 +1,820 @@
+{-# LANGUAGE RankNTypes, FlexibleContexts, ViewPatterns #-}
+module Rahm.Desktop.Keys (applyKeys) where
+
+import XMonad.Util.Run (safeSpawn)
+import Data.Monoid (Endo(..))
+import Control.Monad.Trans.Class
+import Control.Monad.Reader
+import Control.Monad.Writer
+import Control.Monad.Loops (iterateWhile)
+import Control.Monad.Fix (fix)
+import Graphics.X11.ExtraTypes.XF86;
+import Rahm.Desktop.KeysM
+import Rahm.Desktop.SwapMaster (swapMaster)
+import XMonad.Hooks.ManageDocks
+import XMonad.Layout.MosaicAlt
+import Graphics.X11.ExtraTypes.XorgDefault
+import System.Process
+import XMonad.Util.Ungrab
+import XMonad.Layout.Spacing
+import Data.Maybe (isJust, fromMaybe)
+import Debug.Trace
+import Control.Applicative
+import Prelude hiding ((!!))
+import Control.Monad
+import Data.Char
+import Data.List hiding ((!!))
+import Data.List.Safe ((!!))
+import Data.Map (Map)
+import Rahm.Desktop.Layout
+import Rahm.Desktop.Marking
+import Rahm.Desktop.PromptConfig
+import System.IO
+import Text.Printf
+import XMonad
+import Rahm.Desktop.Submap
+import XMonad.Actions.WindowNavigation
+import XMonad.Prompt
+import XMonad.Prompt.Input
+import XMonad.Prompt.Shell
+import XMonad.Util.CustomKeys
+import XMonad.Util.Scratchpad
+import XMonad.Actions.RotSlaves
+import XMonad.Actions.CopyWindow as CopyWindow
+import XMonad.Actions.SpawnOn as SpawnOn
+
+import qualified Data.Map as Map
+import qualified XMonad.StackSet as W
+
+import Rahm.Desktop.LayoutList
+import Rahm.Desktop.MouseMotion
+import Rahm.Desktop.Windows
+import Rahm.Desktop.Lib
+import Rahm.Desktop.DMenu
+import Rahm.Desktop.PassMenu
+import Rahm.Desktop.Logger
+import Rahm.Desktop.RebindKeys
+import Rahm.Desktop.Swallow
+import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward)
+
+type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
+type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ())
+
+
+spawnX :: String -> X ()
+spawnX = spawn
+
+noWindow :: b -> Window -> b
+noWindow = const
+
+decreaseVolume = spawnX "pactl set-sink-volume @DEFAULT_SINK@ -5%"
+increaseVolume = spawnX "pactl set-sink-volume @DEFAULT_SINK@ +5%"
+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
+
+button7 :: Button
+button7 = 7
+
+button8 :: Button
+button8 = 8
+
+button9 :: Button
+button9 = 9
+
+button10 :: Button
+button10 = 10
+
+button11 :: Button
+button11 = 11
+
+button12 :: Button
+button12 = 12
+
+button13 :: Button
+button13 = 13
+
+button14 :: Button
+button14 = 14
+
+button15 :: Button
+button15 = 15
+
+keyBindingToKeymap :: (XConfig l -> KeyBindings) -> KeyMap l
+keyBindingToKeymap bindings config = fmap bindingToX (bindings config)
+
+ where
+ bindingToX b =
+ case b of
+ Documented _ (Action x) -> x
+ Documented _ (Submap mapping) ->
+ submap (fmap bindingToX mapping)
+ Documented _ (Repeat mapping) ->
+ fix $ \recur ->
+ submap (fmap (\b -> bindingToX b >> recur) mapping)
+
+keymap :: XConfig l -> KeyBindings
+keymap = runKeys $ do
+ config <- getConfig
+
+ let subkeys keysM = Submap (runKeys keysM config)
+ repeatable keysM = Repeat (runKeys keysM config)
+
+ bind xK_apostrophe $ do
+ justMod $
+ doc "Jumps between marks." $
+ mapNextString $ \_ str ->
+ case str of
+ ['\''] -> jumpToLast
+ [ch] | isAlphaNum ch -> jumpToMark ch
+ "[" -> historyPrev
+ "]" -> historyNext
+ _ -> return ()
+
+ shiftMod $
+ doc "Swap the current window with a mark." $
+ mapNextString $ \_ str ->
+ case str of
+ ['\''] -> swapWithLastMark
+ [ch] | isAlphaNum ch -> swapWithMark ch
+ _ -> return ()
+
+ 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 $
+ doc "Spawns XTerm as a fallback if xkb is messed up." $
+ spawnX "xterm"
+
+ -- Moves xmobar to different monitors.
+ justMod $
+ doc "Move XMobar to another screen." $
+ spawnX "pkill -SIGUSR1 xmobar"
+
+ bind xK_F1 $ do
+ -- Experimental. Sends 'a' to all windows.
+ --
+ -- I've discovered that many clients ignore such synthetic events, including
+ -- Spotify, Chrome and Gedit. Some, like Chrome, seem to honor them if it's
+ -- focused. It's pretty annoying because it keeps me from doing some cool
+ -- things all for BS security theater, but I guess there might be some way
+ -- to do this via XTest?
+ shiftMod $ forAllWindows $ \w -> do
+ logs $ "Try send to " ++ show w
+ sendKey (0, xK_a) w
+
+ justMod $
+ doc "Print this documentation"
+ (safeSpawn "gxmessage" [
+ "-fn", "Source Code Pro",
+ documentation (keymap config)] :: X ())
+
+ bind xK_F7 $
+
+ justMod $
+ doc "Print this documentation." $
+ logs (documentation (keymap config))
+
+ bind xK_F10 $ do
+ justMod playPauseDoc
+
+ bind xK_F11 $ do
+ justMod mediaPrevDoc
+
+ bind xK_F12 $ do
+ justMod mediaNextDoc
+
+ bind xK_Return $ do
+ justMod swapMaster
+
+ bind xK_Tab $ do
+ justMod $ windows W.focusDown
+ shiftMod $ windows W.focusUp
+
+ -- Switch between different screens. These are the leftmost keys on the home
+ -- row in a Dvorak layout. One might want to switch these to ASD for QWERTY.
+ forM_ (zip [xK_a, xK_o, xK_e] [0..]) $ \(key, idx) ->
+ bind key $ do
+ -- Move focus to that screen.
+ justMod $
+ doc ("Switch focus to screen " ++ show idx) $
+ withScreen W.view idx
+ -- Swap the current screen with the one given
+ altMod $
+ doc ("Swap the current screen with screen " ++ show idx) $
+ withScreen W.greedyView idx
+ -- Move the current window to the select screen.
+ shiftMod $
+ doc ("Move the current window to screne " ++ show idx) $
+ withScreen W.shift idx
+
+ altgrMod $
+ logs "Test altgr"
+
+ bind xK_bracketright $ do
+ justMod $
+ doc "Increase the gaps between windows." $
+ sendMessage $ modifyWindowBorder 5
+
+ bind xK_bracketleft $ do
+ justMod $
+ doc "Decrease the gaps between windows." $
+ sendMessage $ modifyWindowBorder (-5)
+
+ bind xK_b $ do
+ justMod $ spawnX "bluetooth-select.sh"
+
+ bind xK_c $ do
+ justMod $
+ doc "Run PassMenu" runPassMenu
+
+ shiftMod $
+ doc "Kill the current window" CopyWindow.kill1
+
+ bind xK_f $ do
+ justMod $
+ doc "Flip the current layout vertically" $
+ sendMessage FlipLayout
+ shiftMod $
+ doc "Flip the current layout horizontally" $
+ sendMessage HFlipLayout
+
+ bind xK_g $ do
+ justMod $
+ doc "Goto a workspace\n\n\t\
+
+ \If the second character typed is alpha-numberic, jump to that\n\t\
+ \workspace. The workspace is created on-the-fly if such a workspace\n\t\
+ \does not exist.\n\n\t\
+
+ \If the second character typed is:\n\t\t\
+ \]: go to the next workspace\n\t\t\
+ \[: go to the previous workspace\n\t\t\
+ \}: cycle the workspaces on the screens to the right\n\t\t\
+ \{: cycle the workspaces on the screens to the left\n\t\t\
+ \<space>: Jump to the accompaning workspace.\n\t\t\
+ \F1: display this help.\n" $
+ mapNextStringWithKeysym $ \_ keysym str ->
+ case (keysym, str) of
+ (_, [ch]) | isAlphaNum ch -> gotoWorkspace ch
+ (_, "]") -> pushHistory $ withRelativeWorkspace next W.greedyView
+ (_, "[") -> pushHistory $ withRelativeWorkspace prev W.greedyView
+ (_, "}") -> windows screenRotateForward
+ (_, "{") -> windows screenRotateBackward
+ (_, " ") -> gotoAccompaningWorkspace
+
+ -- Test binding. Tests that I can still submap keysyms alone (keys
+ -- where XLookupString won't return anything helpful.)
+ (f, _) | f == xK_F1 ->
+ (safeSpawn "gxmessage" [
+ "-fn", "Source Code Pro",
+ documentation (keymap config)] :: X ())
+
+ _ -> return ()
+ shiftMod $
+ doc "Move the currently focused window to another workspace" $
+ mapNextString $ \_ str ->
+ case str of
+ [ch] | isAlphaNum ch -> shiftToWorkspace ch
+ "]" -> withRelativeWorkspace next W.shift
+ "[" -> withRelativeWorkspace prev W.shift
+ _ -> return ()
+ shiftAltMod $
+ doc "Swap this workspace with another workspace (rename)." $
+ mapNextString $ \_ str ->
+ case str of
+ [ch] | isAlphaNum ch -> swapWorkspace ch
+ _ -> return ()
+
+ bind xK_h $ do
+ justMod $
+ doc "Focus on the next window down in the stack" $
+ windows W.focusDown
+
+ shiftMod $
+ doc "Swap the current window with the next one down in the stack" $
+ windows W.swapDown
+
+ controlMod $
+ doc "Rotate all the windows down the stack"
+ rotAllDown
+
+ bind xK_j $ do
+ justMod $
+ doc "Shrink the size of the zoom region" $
+ sendMessage ShrinkZoom
+
+ shiftMod $
+ doc "Go to the previous window in history." historyPrev
+
+ bind xK_k $ do
+ justMod $
+ doc "Expand the size of the zoom region" $
+ sendMessage ExpandZoom
+
+ shiftMod $
+ doc "Go to the next window in history." historyNext
+
+ bind xK_l $ do
+ justMod $
+ doc "Focus the next window in the stack" $
+ windows W.focusUp
+
+ shiftMod $
+ doc "Swap the currently focused window with the next window in the stack." $
+ windows W.swapUp
+
+ controlMod $
+ doc "Rotate the windows up."
+ rotAllUp
+
+ altMod $
+ doc "Lock the screen" $
+ spawnX "xsecurelock"
+
+ bind xK_minus $ do
+ justMod $
+ doc "Decrease the number of windows in the master region." $
+ sendMessage (IncMasterN (-1))
+
+ shiftMod $
+ doc "For mosaic layout, shrink the size-share of the current window" $
+ withFocused $ sendMessage . shrinkWindowAlt
+
+ bind xK_m $ do
+ justMod $
+ doc "Mark the current window with the next typed character." $
+ mapNextString $ \_ str ->
+ case str of
+ [ch] | isAlphaNum ch -> markCurrentWindow ch
+ _ -> return ()
+
+ bind xK_n $ do
+ justMod $
+ doc "Shift to the next workspace." $
+ withRelativeWorkspace next W.greedyView
+
+ bind xK_p $ do
+ justMod $
+ doc "Shift to the previous workspace." $
+ withRelativeWorkspace prev W.greedyView
+
+ bind xK_plus $ do
+ justMod $
+ doc "Increase the number of windows in the master region." $
+ sendMessage (IncMasterN 1)
+
+ shiftMod $
+ doc "For mosaic layout, increase the size-share of the current window." $
+ withFocused $ sendMessage . expandWindowAlt
+
+ bind xK_q $ do
+ shiftMod $
+ doc "Recompile and restart XMonad" $
+ spawnX "xmonad --recompile && xmonad --restart"
+
+ justMod $
+ doc "Experimental Bindings" $
+ subkeys $ do
+
+ bind xK_q $
+ (justMod -|- noMod) $
+ doc "EXPERIMENTAL: Move mouse to control media." $
+ mouseRotateMotion (logs "CW") (logs "CCW")
+
+ bind xK_r $ do
+ 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"
+
+ bind xK_space $ do
+ justMod $
+ doc "Use the next layout in the layout list." $ sendMessage toNextLayout
+
+ altMod $
+ doc "Reset the layout to the default layout." $ sendMessage toFirstLayout
+
+ shiftMod $
+ doc "Use the previous layout in the layout list." $
+ sendMessage toPreviousLayout
+
+ bind xK_t $ do
+ justMod $
+ doc "Spawn a terminal." $ spawnX (terminal config)
+
+ shiftMod $
+ doc "Sink the current window into the tiling." $ withFocused $ windows . W.sink
+
+ altMod $
+ doc "Spawn a floating terminal" $ spawnX (terminal config ++ " -t Floating\\ Term")
+
+ bind xK_v $
+ -- Allows repeated strokes of M-h and M-l to reduce and increase volume
+ -- respectively.
+ justMod $
+ doc "Changes the volume." $
+ repeatable $ do
+ bind xK_h $
+ justMod $
+ doc "Decrease volume."
+ decreaseVolumeDoc
+
+ bind xK_l $
+ justMod $
+ doc "Increase volume."
+ increaseVolumeDoc
+
+ bind xK_v $
+ justMod (return () :: X ())
+
+ bind xK_w $ do
+ justMod $ doc "Jump to a window (via rofi)" windowJump
+
+ bind xK_x $ do
+ justMod $
+ doc "Toggles respect for struts." $
+ sendMessage ToggleStruts
+
+ bind xK_z $ do
+
+ justMod $
+ doc "Less often used keybindings." $
+ subkeys $ do
+
+ 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) $
+ doc "Go to the prior window in the history" historyPrev
+
+ 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_n $ do
+ (justMod -|- noMod) $
+ doc "Go to the next window in the history" historyNext
+
+ 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 $
+ 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 mediaPrevDoc
+
+ bind xF86XK_AudioRaiseVolume $ do
+ noMod $ spawnX "pactl set-sink-volume @DEFAULT_SINK@ +1%"
+ justMod mediaNextDoc
+
+ bind xF86XK_AudioMute $ do
+ noMod $ spawnX "pactl set-sink-mute @DEFAULT_SINK@ toggle"
+
+ bind xF86XK_AudioPlay $ do
+ noMod playPauseDoc
+
+ bind xF86XK_AudioNext $ do
+ noMod mediaNextDoc
+
+ bind xF86XK_AudioPrev $ do
+ noMod mediaPrevDoc
+
+ bind xF86XK_AudioPrev $ do
+ noMod mediaPrevDoc
+
+ bind xF86XK_MonBrightnessUp $ do
+ noMod $ spawnX "set-backlight.sh +0.05"
+ justMod $ spawnX "set-backlight.sh 1"
+
+ bind xF86XK_MonBrightnessDown $ do
+ noMod $ spawnX "set-backlight.sh -0.05"
+ justMod $ spawnX "set-backlight.sh 0.01"
+ rawMask shiftMask $ spawnX "set-backlight.sh 0"
+
+mouseMap :: ButtonsMap l
+mouseMap = runButtons $ do
+ config <- getConfig
+
+ let x button = Map.lookup button (mouseMap config)
+
+ let defaultButtons button = fromMaybe (\w -> return ()) $
+ Map.lookup button (mouseMap config)
+ subMouse = submapButtonsWithKey defaultButtons . flip runButtons config
+
+
+ let continuous :: [(Button, X ())] -> Button -> Window -> X ()
+ continuous actions button w = do
+ case find ((==button) . fst) actions of
+ Just (_, action) -> action
+ Nothing -> return ()
+
+ (subMouse $
+ forM_ (map fst actions) $ \b ->
+ bind b $ noMod $ \w -> continuous actions b w) w
+
+ bind button1 $ do
+ justMod $ \w -> 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
+
+ bind button6 $
+ justMod $ noWindow (withRelativeWorkspace prev W.greedyView)
+
+ bind button7 $
+ justMod $ noWindow (withRelativeWorkspace next W.greedyView)
+
+ bind button8 $
+ justMod $ noWindow mediaPrev
+
+ bind button9 $
+ justMod $ 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 ToggleZoom
+
+ bind button15 $ do
+ noMod $ noWindow $ spawnX "pavucontrol"
+
+ let mediaButtons = [
+ (button4, increaseVolume),
+ (button5, decreaseVolume),
+ (button2, playPause),
+ (button9, historyNext),
+ (button8, historyPrev),
+ (button6, mediaPrev),
+ (button7, mediaNext)
+ ]
+
+ forM_ (map fst mediaButtons) $ \b ->
+ bind b $ noMod $ continuous mediaButtons b
+
+ bind button13 $ noMod $ subMouse $ do
+ bind button1 $ noMod mouseMoveWindow
+ bind button2 $ noMod $ windows . W.sink
+ bind button3 $ noMod mouseResizeWindow
+
+ 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"
+
+ bind button15 $ do
+
+ noMod $ subMouse $ do
+ bind button13 $ noMod $ noWindow gotoAccompaningWorkspace
+
+ bind button15 $ do
+ noMod $ noWindow jumpToLast
+
+
+ let workspaceButtons = [
+ (button2, swapMaster),
+
+ (button9, withRelativeWorkspace next W.greedyView),
+ (button8, withRelativeWorkspace prev W.greedyView),
+
+ (button4, windows W.focusUp),
+ (button5, windows W.focusDown),
+
+ (button7, windows screenRotateForward),
+ (button6, windows screenRotateBackward)
+ ]
+
+ forM_ (map fst workspaceButtons) $ \b ->
+ bind b $ noMod $ continuous workspaceButtons b
+
+-- 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.
+--
+-- This is useful to create hotkeys in applications where hot keys are not
+-- configurable, or to remove keybindings that are irritating (looking at you,
+-- ctrl+w in Chrome!!).
+windowSpecificBindings ::
+ XConfig l -> WriterT (Map (KeyMask, KeySym) (X ())) Query ()
+windowSpecificBindings config = do
+
+ w <- lift ask
+
+ let configureIf b k = tell =<< lift (b --> return (keyBindingToKeymap (runKeys k) config))
+ emitKey = flip sendKey w
+
+ configureIf (flip elem browsers <$> className) $ do
+
+ -- if the window is a browser, configure these bindings. Lots of browsers
+ -- make up their own garbage bindings that are not standard across many
+ -- other applications. This alleviates the issue.
+ --
+ -- Consistency with terminal:
+ --
+ -- Ctrl+h is backspace
+ -- Ctrl+w is ctrl+backspace
+ -- Ctrl+u is ctrl+shift+backspace
+ --
+ -- Consistency with Vim/Emacs-ish:
+ --
+ -- Alt+{Shift,Ctrl,}+{h,j,k,l} -> {Shift,Ctrl,}+{Left,Down,Up,Right}
+ -- Ctrl+b -> Ctrl+Left
+ -- Ctrl+e -> Ctrl+Right
+ -- Ctrl+$ -> End
+ -- Ctrl+^ -> Home
+ --
+ -- Ctrl+d -> Delete current tab.
+
+
+ let mods = permuteMods [shiftMask, controlMask, 0]
+
+ bind xK_h $ do
+ rawMask controlMask $ emitKey (0, xK_BackSpace)
+ forM_ mods $ \mask ->
+ rawMask (altMask .|. mask) $ emitKey (mask, xK_Left)
+
+ bind xK_j $
+ forM_ mods $ \mask ->
+ rawMask (altMask .|. mask) $ emitKey (mask, xK_Down)
+
+ bind xK_k $
+ forM_ mods $ \mask ->
+ rawMask (altMask .|.mask) $ emitKey (mask, xK_Up)
+
+ bind xK_l $
+ forM_ mods $ \mask ->
+ rawMask (altMask .|. mask) $ emitKey (mask, xK_Right)
+
+ bind xK_u $
+ rawMask controlMask $ emitKey (controlMask .|. shiftMask, xK_BackSpace)
+
+ bind xK_w $
+ rawMask controlMask $ emitKey (controlMask, xK_BackSpace)
+
+ bind xK_b $ do
+ rawMask controlMask $ emitKey (controlMask, xK_Left)
+ rawMask (controlMask .|. shiftMask) $
+ emitKey (controlMask .|. shiftMask, xK_Left)
+
+ bind xK_e $ do
+ rawMask controlMask $ emitKey (controlMask, xK_Right)
+ rawMask (controlMask .|. shiftMask) $
+ emitKey (controlMask .|. shiftMask, xK_Right)
+
+ bind xK_dollar $
+ rawMask controlMask $ emitKey (0, xK_End)
+
+ bind xK_at $
+ rawMask (controlMask .|. shiftMask) $ emitKey (0, xK_Home)
+
+ bind xK_d $
+ rawMask controlMask $ emitKey (controlMask, xK_w)
+
+ bind xK_F2 $
+ -- Experimental.
+ noMod $ logs "This is a test"
+
+ -- Add a binding to xev as a test.
+ configureIf (title =? "Event Tester") $
+ bind xK_F2 $
+ noMod $ emitKey (controlMask, xK_F2)
+
+ where
+ browsers = ["Google-chrome", "Brave-browser", "firefox-default"]
+
+ -- Create a permutation from a list of modifiers.
+ --
+ -- i.e. permuteMods [C, S, M] will return
+ --
+ -- [C, S, M, C + M, C + S, M + S, C + S + M, 0]
+ permuteMods = map (foldl' (.|.) 0) . filterM (const [True, False])
+
+windowBindings :: XConfig l -> XConfig l
+windowBindings xconfig =
+ xconfig {
+ startupHook = do
+ forAllWindows (runQuery doQuery)
+ startupHook xconfig,
+
+ manageHook = (doQuery >> return (Endo id)) <> manageHook xconfig
+ }
+
+ where
+ doQuery :: Query ()
+ doQuery = do
+ map <- execWriterT $ windowSpecificBindings xconfig
+ w <- ask
+
+ liftX $ logs $ printf "For Window: %s" (show w)
+ forM_ (Map.toList map) $ \(key, action) -> do
+ liftX $ logs $ printf " -- remap: %s" (show key)
+ remapKey key action
+
+applyKeys :: XConfig l -> IO (XConfig l)
+applyKeys config =
+ return $ windowBindings $ config { keys = keyBindingToKeymap keymap, mouseBindings = mouseMap }
+
+click :: X ()
+click = do
+ (dpy, root) <- asks $ (,) <$> display <*> theRoot
+ (_, _, window, _, _, _, _, _) <- io $ queryPointer dpy root
+ focus window
+
+modifyWindowBorder :: Integer -> SpacingModifier
+modifyWindowBorder i = ModifyWindowBorder $ \(Border a b c d) ->
+ Border (clip $ a + i) (clip $ b + i) (clip $ c + i) (clip $ d + i)
+
+ where clip i | i < 0 = 0
+ clip i = i