aboutsummaryrefslogtreecommitdiff
path: root/src/Internal/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/Internal/Keys.hs
parent381a3e5a00813314249bb74b5460f5ff5a4006bb (diff)
downloadrde-a652c330707e2e9bbe963e01af79ce730cf3452e.tar.gz
rde-a652c330707e2e9bbe963e01af79ce730cf3452e.tar.bz2
rde-a652c330707e2e9bbe963e01af79ce730cf3452e.zip
Rename Internal to Rahm.Desktop
Diffstat (limited to 'src/Internal/Keys.hs')
-rw-r--r--src/Internal/Keys.hs820
1 files changed, 0 insertions, 820 deletions
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
deleted file mode 100644
index ad9d719..0000000
--- a/src/Internal/Keys.hs
+++ /dev/null
@@ -1,820 +0,0 @@
-{-# 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
-import Control.Monad.Writer
-import Control.Monad.Loops (iterateWhile)
-import Control.Monad.Fix (fix)
-import Graphics.X11.ExtraTypes.XF86;
-import Internal.KeysM
-import Internal.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 Internal.Layout
-import Internal.Marking
-import Internal.PromptConfig
-import System.IO
-import Text.Printf
-import XMonad
-import Internal.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 Internal.LayoutList
-import Internal.MouseMotion
-import Internal.Windows
-import Internal.Lib
-import Internal.DMenu
-import Internal.PassMenu
-import Internal.Logger
-import Internal.RebindKeys
-import Internal.Swallow
-import Internal.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