module Rahm.Desktop.Keys (applyKeys) where import Control.Monad ( filterM, forM_, unless, when, ) import Control.Monad.Trans.Maybe ( MaybeT (..), runMaybeT, ) import Control.Monad.Writer ( WriterT, execWriterT, fix, lift, tell, ) import Data.Char (isAlpha) import Data.IORef import Data.List (foldl') import Data.List.Safe ((!!)) import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe ( fromMaybe, mapMaybe, ) import Data.Monoid (Endo (..)) import Graphics.X11.ExtraTypes.XF86 ( xF86XK_AudioLowerVolume, xF86XK_AudioMute, xF86XK_AudioNext, xF86XK_AudioPlay, xF86XK_AudioPrev, xF86XK_AudioRaiseVolume, xF86XK_Calculator, xF86XK_MonBrightnessDown, xF86XK_MonBrightnessUp, ) import Rahm.Desktop.Common ( Location (..), click, duplWindow, focusLocation, getCurrentWorkspace, gotoWorkspace, locationWindow, locationWorkspace, pointerWorkspace, runMaybeT_, setBorderColor, withBorderColor, withBorderColorM, ) import Rahm.Desktop.DMenu (runDMenu) import qualified Rahm.Desktop.Dragging as D import Rahm.Desktop.History ( historyBack, historyForward, jumpToLastLocation, ) import Rahm.Desktop.Keys.Dsl ( ButtonBinding (..), ButtonBindings, Documented (..), KeyBinding (..), KeyBindings, altMask, altMod, altgrMod, bind, buttonDocumentation, controlMod, doc, documentation, getConfig, justMod, noMod, rawMask, runButtons, runKeys, shiftMod, (-|-), ) import Rahm.Desktop.Keys.Wml ( addWindowToSelection, clearWindowSelection, getAndResetWindowSelection, gotoWorkspaceFn, moveWindowToWorkspaceFn, readNextLocationSet, readNextLocationSet', readNextWorkspace, readNextWorkspaceName, readWindowsetMacro, readWorkspaceMacro, removeWindowFromSelection, toggleWindowInSelection, workspaceForString, workspaceForStringT, workspaceName, ) import Rahm.Desktop.Layout (nLayouts) import Rahm.Desktop.Layout.ConsistentMosaic ( expandPositionAlt, shrinkPositionAlt, ) import Rahm.Desktop.Layout.Flip ( flipHorizontally, flipVertically, ) import Rahm.Desktop.Layout.Hole import Rahm.Desktop.Layout.List ( toFirstLayout, toIndexedLayout, toNextLayout, toPreviousLayout, ) import Rahm.Desktop.Layout.PinWindow (pinWindow, toggleWindowPin, unpinWindow, withWindowsUnpinned) import Rahm.Desktop.Layout.Pop (togglePop) import Rahm.Desktop.Layout.Rotate (rotateLayout) import Rahm.Desktop.Logger ( LogLevel (..), getLogLevel, logs, setLogLevel, ) import Rahm.Desktop.Marking ( markAllLocations, setAlternateWindows, setAlternateWorkspace, ) import Rahm.Desktop.PassMenu (runPassMenu) import Rahm.Desktop.RebindKeys ( remapKey, sendKey, ) import qualified Rahm.Desktop.StackSet as W import Rahm.Desktop.Submap ( escape, mapNextString, submap, submapButtonsWithKey, ) import Rahm.Desktop.SwapMaster (swapMaster) import Rahm.Desktop.Theater ( restoreTheater, ) import Rahm.Desktop.Workspaces ( accompaningWorkspace, next, prev, viewAdjacent, withScreen, ) import Rahm.Desktop.XMobarLog.PendingBuffer ( addStringToPendingBuffer, pushAddPendingBuffer, pushPendingBuffer, ) import Text.Printf (printf) import XMonad as X import XMonad.Actions.CopyWindow as CopyWindow import XMonad.Actions.RotSlaves ( rotAllDown, rotAllUp, ) import XMonad.Hooks.ManageDocks (ToggleStruts (..)) import XMonad.Layout.Spacing ( Border (..), SpacingModifier (..), ) import XMonad.Util.Run (safeSpawn) import XMonad.Util.WindowProperties import Prelude hiding ((!!)) type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ()) type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ()) spawnX :: String -> X () spawnX = spawn safeSpawnX :: String -> [String] -> X () safeSpawnX = safeSpawn 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 "media-control play" mediaPrev = spawnX "media-control prev" mediaNext = spawnX "media-control next" mediaSeekB = spawnX "media-control seekb" mediaSeekF = spawnX "media-control seekf" 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 mediaSeekBDoc = doc "Seek back 3 seconds" mediaSeekB mediaSeekFDoc = doc "Seek forward 12 seconds" mediaSeekF 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 = Map.mapWithKey bindingToX (bindings config) where bindingToX :: (KeyMask, KeySym) -> Documented KeyBinding -> X () bindingToX key b = case b of Documented _ (Action x) -> x Documented _ (Submap mapping) -> -- This is a submap, add it to the pending buffer. -- -- This could potentially use the current event in the XState and -- lookupString to potentially recover the real string typed, but -- for now, this will do. pushAddPendingBuffer (keysymToString $ snd key) $ do submap (Map.mapWithKey bindingToX mapping) Documented _ (Repeat mapping) -> do pushAddPendingBuffer (keysymToString $ snd key) $ do mapM_ (bindingToX key) (Map.lookup key mapping) fix $ \recur -> do submap ( Map.mapWithKey ( \k b -> do pushAddPendingBuffer (keysymToString $ snd k) $ bindingToX k b >> recur ) mapping ) mapWindows :: (Ord b) => (a -> b) -> W.StackSet i l a s sd -> W.StackSet i l b s sd mapWindows fn (W.StackSet cur vis hidden float) = W.StackSet (mapScreen fn cur) (map (mapScreen fn) vis) (map (mapWorkspace fn) hidden) (Map.mapKeys fn float) where mapScreen fn (W.Screen ws s sd) = W.Screen (mapWorkspace fn ws) s sd mapWorkspace fn (W.Workspace t l s) = W.Workspace t l (fmap (fmap fn) s) data ShiftType = JustShift | ShiftAndFollow | ShiftAndSwap 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 $ justMod $ doc "Jump to a window" $ pushPendingBuffer "' " $ do runMaybeT_ $ do l <- readNextLocationSet' case l of (h : _) -> lift (focusLocation h) _ -> return () bind xK_semicolon $ justMod $ doc "Run the command which opened this window again." $ X.withFocused duplWindow bind xK_w $ do justMod $ doc "Swap windows with other windows" $ pushPendingBuffer "w " $ do runMaybeT_ $ do l1 <- mapMaybe (\(Location _ w) -> w) <$> readNextLocationSet withBorderColorM "#00ffff" l1 $ do lift $ addStringToPendingBuffer " " l2 <- mapMaybe (\(Location _ w) -> w) <$> readNextLocationSet let (l1', l2') = if length l1 > length l2 then (l1, l2) else (l2, l1) l1'' = filter (not . (`elem` l2')) l1' lift $ do setAlternateWindows (l1'' ++ l2') windows $ W.swapWindows $ zip l1'' l2' ++ zip l2' l1'' shiftMod $ doc "Swap two workspaces (or rename the current one). \ \(only works on normal workspaces)." $ pushPendingBuffer "W " $ do logs Debug "%s" . W.dbgStackSet =<< gets windowset runMaybeT_ $ do w1 <- readNextWorkspaceName wins <- lift $ W.windowsOnWorkspace w1 <$> gets windowset withBorderColorM "#00ffff" wins $ do lift $ addStringToPendingBuffer " " w2 <- readNextWorkspaceName lift $ windows $ W.swapWorkspaces w1 w2 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 justMod $ doc "Print this documentation" ( safeSpawn "gxmessage" [ "-fn", "Source Code Pro", "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 bind xK_F11 $ do justMod mediaPrevDoc shiftMod mediaSeekBDoc bind xK_F12 $ do justMod mediaNextDoc shiftMod mediaSeekFDoc bind xK_Return $ do justMod swapMaster -- 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 screen " ++ show idx) $ withScreen W.shift idx altgrMod (logs Info "Test altgr" :: X ()) 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 flipVertically shiftMod $ doc "Flip the current layout horizontally" $ sendMessage flipHorizontally bind xK_g $ do justMod $ doc "Goto To a workspace\n\n\t\ \Workspacs are alphanumeric characters. So if the next key typed is an\n\t\ \alphanumeric character, that's the workspace to operate on\n\n\ \\tThe following special characters can also reference workspaces:\n\t\t\ \]: The next workspace, skipping those already visible.\n\t\t\ \[: The previous workspace, skipping those already visible.\n\t\t\ \): The next workspace.\n\t\t\ \(: The previous workspace.\n\t\t\ \}: The workspace on the screen to the right\n\t\t\ \{: The workspace on the screen to the left\n\t\t\ \: The accompaningWorkspace (toggled case)\n\t\t\ \/: Prompt to select a window, and reference that workspace\n\t\t\ \^: The first populated workspace\n\t\t\ \$: The last populated workspace\n\t\t\ \*: The hidden workspace.\n\t\t\ \_: Black hole. Sending a window here closes it.\n\n\t\ \Other keybindings starting with H-g\n\t\t\ \F1: display this help.\n\n\t" $ pushPendingBuffer "g " $ runMaybeT_ $ (lift . gotoWorkspaceFn) =<< readNextWorkspace shiftMod $ doc "Switch a workspace with another workspace. \ \This is a more powerful version of the 'g' command, which does not\ \assume the current workspace.\ \which takes two workspaces as arguments and switches them whereas\ \the 'g' command operates only on the current workspace (.).\ \thereby G. is the same as g" $ do pushPendingBuffer "G " $ do runMaybeT_ $ do w1 <- readNextWorkspaceName lift $ addStringToPendingBuffer " " w2 <- readNextWorkspaceName lift $ windows $ W.switchWorkspaces w1 w2 bind xK_d $ justMod $ doc "Record (define) macros." $ subkeys $ do bind xK_w $ noMod $ doc "Record a windowset macro.\n\n\t\ \To record a 'windowset' macro, type w and then\n\t\ \type a character sequence followed by Enter. Now 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\t\ \not on the current workspace, one can type:\n\n\t\ \w+\\%@.\n" $ pushPendingBuffer "Win Macro " $ runMaybeT_ readWindowsetMacro bind xK_t $ noMod $ doc "Record a workspace macro\n\n\t\ \To record a 'workspace' macro, type t and then\n\t\ \type a character sequence followed by Enter. Now 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 '' 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\ \t?&s@.'s\n" $ pushPendingBuffer "Wksp Macro " $ runMaybeT_ readWorkspaceMacro 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 master region" $ sendMessage Shrink shiftMod $ doc "Go to the previous window in history." historyBack bind xK_k $ do justMod $ doc "Expand the size of the master region" $ sendMessage Expand shiftMod $ doc "Go to the next window in history." historyForward 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_p $ do justMod $ doc "Pin a windowset" $ pushPendingBuffer "p " $ runMaybeT_ $ do windows <- mapMaybe locationWindow <$> readNextLocationSet lift $ mapM_ pinWindow windows shiftMod $ doc "Unpin a windowset" $ pushPendingBuffer "P " $ runMaybeT_ $ do windows <- mapMaybe locationWindow <$> readNextLocationSet lift $ mapM_ unpinWindow windows bind xK_minus $ do justMod $ doc "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) shiftMod $ doc "For mosaic layout, shrink the size-share of the current window" $ sendMessage =<< shrinkPositionAlt bind xK_n $ do forM_ [ ( justMod, addWindowToSelection, "Add a window set to the selection set", "n " ), ( shiftMod, removeWindowFromSelection, "Remove a window set from the selection set", "N " ) ] $ \(m, fn, d, ch) -> do m $ doc d $ pushPendingBuffer ch $ do runMaybeT_ $ do locset <- readNextLocationSet' lift $ forM_ locset $ \(Location _ mWin) -> mapM_ fn mWin bind xK_period $ do justMod $ doc "Toggle the currently focused window in the selection set; (kinda) shorthand for Mod+n . ." $ flip whenJust toggleWindowInSelection =<< withWindowSet (return . W.peek) bind xK_m $ do justMod $ doc "Mark the windows described by the window set with a given character.\n\n\t\ \For example, to mark the current window use .. That window\n\n\t\ \can then be recalled anywhere that requires a WML window.\n" $ do pushPendingBuffer "m " $ do locs <- fromMaybe [] <$> runMaybeT readNextLocationSet let wins = mapMaybe locationWindow locs unless (null wins) $ do withBorderColor "#00ffff" wins $ do runMaybeT_ $ do mapNextString $ \_ str -> lift $ case str of [ch] | isAlpha ch -> markAllLocations str locs _ -> return () bind xK_plus $ do justMod $ doc "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 $ doc "For mosaic layout, increase the size-share of the current window." $ sendMessage =<< expandPositionAlt bind xK_q $ do shiftMod $ doc "Recompile and restart XMonad" $ spawnX "xmonad --recompile && xmonad --restart" bind xK_r $ do justMod $ doc "Run a command via Rofi" runDMenu shiftMod $ doc "Rotate the current layout. (flips x, y coordinates)" $ 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 ( case shiftType of ShiftAndSwap -> "S " JustShift -> "s " ShiftAndFollow -> "^s " ) $ runMaybeT_ $ do stackset <- lift $ X.windowset <$> X.get selection <- mapMaybe locationWindow <$> readNextLocationSet withBorderColorM "#00ffff" 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" bind xK_space $ do justMod $ doc "Layout-related bindings" $ subkeys $ do bind xK_n $ (noMod -|- justMod) $ doc "Use the next layout in the layout list." $ do sendMessage toNextLayout bind xK_p $ (noMod -|- justMod) $ doc "Use the previous layout in the layout list." $ sendMessage toPreviousLayout bind xK_b $ (noMod -|- justMod) $ doc "Go back to the first layout in the layout list." $ sendMessage toFirstLayout bind xK_h $ (noMod -|- justMod) $ doc "Flip the layout across the horizontal axis" $ sendMessage flipVertically bind xK_v $ (noMod -|- justMod) $ doc "Flip the layout across the vertical axis" $ sendMessage flipHorizontally bind xK_r $ (noMod -|- justMod) $ doc "Rotate the layout 90 degrees" $ sendMessage rotateLayout bind xK_c $ (noMod -|- justMod) $ doc "Toggle the pop window" $ sendMessage togglePop bind xK_t $ (noMod -|- justMod) $ doc "Jump to the middle layout." $ sendMessage (toIndexedLayout (nLayouts `div` 2)) bind xK_x $ (noMod -|- justMod) $ doc "Toggle the hole" $ do logs Debug "reset hole" sendMessage resetHole logs Debug "/reset hole" bind xK_g $ (noMod -|- justMod) $ doc "Switch to a different theater.\n\n\t\ \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" $ do addStringToPendingBuffer " g " runMaybeT_ $ do mapNextString $ \_ str -> lift $ case str of [ch] | isAlpha ch -> restoreTheater (Just [ch]) [' '] -> restoreTheater Nothing _ -> return () let spaceResize = repeatable $ do bind xK_bracketright $ do noMod $ doc "Increase the gaps between windows." $ sendMessage $ modifyWindowBorder 5 bind xK_bracketleft $ do noMod $ doc "Decrease the gaps between windows." $ sendMessage $ modifyWindowBorder (-5) bind xK_bracketleft $ noMod spaceResize bind xK_bracketright $ noMod spaceResize 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 "Allows repeated strokes of M-h and M-l to decrease and\n\ \increase volume respectively" $ repeatable $ do bind xK_h $ justMod decreaseVolumeDoc bind xK_l $ justMod increaseVolumeDoc bind xK_v $ justMod (return () :: X ()) 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_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_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" bind xK_m $ do (justMod -|- noMod) $ doc "Set the media source to control" $ spawnX "media-select.sh" -- Double-tap Z to toggle zoom. bind xK_z $ do noMod -|- justMod $ doc "Toggle zoom on the current window." $ sendMessage togglePop -- Z is reserved to create sub keybindings to do various things. -- I don't really use these at the moment. bind xK_h $ do noMod mediaPrevDoc rawMask shiftMask mediaSeekBDoc bind xK_j $ noMod playPauseDoc bind xK_l $ do noMod mediaNextDoc rawMask shiftMask mediaSeekFDoc -- Centers the current focused window. i.e. toggles the Zoom layout -- modifier. shiftMod $ doc "Toggle zoom on the current window." $ sendMessage togglePop bind xK_F8 $ do justMod $ doc "Set the log level.\n\ \Log levels are, in order\n\n\t\ \Trace\n\t\ \Debug\n\t\ \Info (default)\n\t\ \Warn\n\t\ \Error\n\t\ \Fatal\n\n\ \Log is sent to stdout." $ do ll <- getLogLevel let next = if minBound == ll then maxBound else pred ll safeSpawnX "notify-send" ["-t", "2000", printf "LogLevel set to %s" (show next)] setLogLevel next logs next "LogLevel set to %s." (show next) 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 rawMask shiftMask mediaSeekFDoc bind xF86XK_AudioPrev $ do noMod mediaPrevDoc rawMask shiftMask mediaSeekBDoc 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" buttonBindingsToButtonMap :: (XConfig l -> ButtonBindings) -> ButtonsMap l buttonBindingsToButtonMap bindings config = Map.mapWithKey bindingToX (bindings config) where bindingToX :: (ButtonMask, Button) -> Documented ButtonBinding -> (Window -> X ()) bindingToX click@(mask, btn) = \case Documented _ (ButtonAction action) -> action Documented _ (ButtonSubmap sm) -> pushAddPendingBuffer (printf "b%d " btn) . submapButtonsWithKey (\_ _ -> return ()) (Map.mapWithKey bindingToX sm) Documented _ (ButtonContinuous sm) -> \window -> pushAddPendingBuffer (printf "b%d " btn) $ do mapM_ (flip (bindingToX click) window) (Map.lookup click sm) fix $ \recur -> do submapButtonsWithKey ( \_ _ -> return () ) ( Map.mapWithKey ( \k b w -> pushAddPendingBuffer (printf "b%d " (snd k)) $ bindingToX k b w >> recur ) sm ) window myMouseMoveWindow = D.mouseMoveWindowAndThen X.focus $ mconcat [ D.ifReleased button3 D.sinkOnRelease, D.ifReleased' button2 $ \w _ -> X.killWindow w ] myMouseResizeAction = D.mouseResizeWindowAndThen X.focus $ mconcat [ D.ifReleased button1 D.sinkOnRelease ] mouseMap :: forall l. XConfig l -> ButtonBindings mouseMap = runButtons $ do config <- getConfig -- let x button = Map.lookup button (mouseMap config) -- let defaultButtons button = -- fromMaybe (\w -> return ()) $ -- Map.lookup button (mouseMap config) let subMouse = ButtonSubmap . flip runButtons config continuous buttons = do let bindingMap = runButtons buttons config in forM_ (Map.toList bindingMap) $ \((m, b), _) -> do bind b $ rawMask m $ ButtonContinuous bindingMap bind button1 $ do justMod $ doc "Float and move a window" myMouseMoveWindow shiftMod $ doc "Add the currently focused window to the selection set." toggleWindowInSelection bind button2 $ do justMod $ windows . (W.shiftMaster .) . W.focusWindow bind button3 $ do justMod $ doc "Float and resize a window" myMouseResizeAction bind button6 $ justMod $ doc "Move to the workspace to the left" $ noWindow (viewAdjacent prev) bind button7 $ justMod $ doc "Move to the workspace to the right" $ noWindow (viewAdjacent next) bind button8 $ justMod $ doc "Media previous" $ noWindow mediaPrev bind button9 $ justMod $ doc "Media next" $ noWindow mediaNext bind button14 $ do noMod $ doc "Additional Mouse Bindings" $ subMouse $ do bind button3 $ noMod $ doc "Move to workspace 's' (Spotify)" $ noWindow (gotoWorkspace "s") bind button1 $ noMod $ doc "Swap a window with another window by dragging." $ noWindow D.dragWindow bind button13 $ do noMod $ doc "Kill the window under the cursor" $ noWindow $ click >> CopyWindow.kill1 bind button14 $ do noMod $ doc "Pop the window under the cursor" $ noWindow $ click >> sendMessage togglePop 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 $ doc "General Window Management Extra Mouse Bindings" $ subMouse $ do bind button1 $ noMod $ doc "Move the mouse under the cursor (like how Mod+leftMouse works)" $ myMouseMoveWindow bind button2 $ noMod $ doc "Run the command that started a window." $ duplWindow bind button3 $ noMod $ doc "Resize the window under the cursor" myMouseResizeAction let resizeButtons = [ ( button4, "Increase the size of the master region", noWindow $ sendMessage Expand ), ( button5, "Shrink the size of the master region", noWindow $ sendMessage Shrink ) ] continuous $ forM_ resizeButtons $ \(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 $ 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 (click >> jumpToLastLocation) -- bind button1 $ -- noMod $ -- doc "'drag' a workspace to another screen" $ -- noWindow D.dragWorkspace continuous $ do bind button1 $ noMod $ doc "add the window under the cursor to the window selection" toggleWindowInSelection bind button2 $ noMod $ doc "Clear the window selection" $ noWindow (clearWindowSelection >> escape) bind button13 $ noMod $ doc "Kill the windows in the selection" $ noWindow $ do windows <- getAndResetWindowSelection forM_ windows X.killWindow escape bind button3 $ noMod $ doc "Move all the windows to the workspace the pointer is on" $ noWindow $ do wins <- getAndResetWindowSelection runMaybeT_ $ do ws <- MaybeT pointerWorkspace lift $ let f = appEndo ( mconcat (map (Endo . W.shiftWin ws) wins) ) in windows f >> escape bind button15 $ noMod $ doc "" $ noWindow (return () :: X ()) forM_ [(button7, ",.", "right"), (button6, ";.", "left")] $ \(b, mot, d) -> do bind b $ noMod $ doc ( "Move the selected windows to the workspace on the \ \screen to the " ++ d ) $ noWindow $ do wins <- getAndResetWindowSelection runMaybeT_ $ do ws' <- workspaceForStringT mot ws <- MaybeT . return $ workspaceName ws' lift $ let f = appEndo ( mconcat (map (Endo . W.shiftWin ws) wins) ) in windows f >> escape 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, "Swap the current screen with the one to the right", noWindow $ do click runMaybeT_ $ (lift . gotoWorkspaceFn) =<< workspaceForStringT ",." ), ( button6, "Swap the current screen with the one to the left", noWindow $ do click runMaybeT_ $ (lift . gotoWorkspaceFn) =<< workspaceForStringT ";." ) ] 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. -- -- 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 mods = permuteMods [shiftMask, controlMask, 0] let configureIf b k = tell =<< lift (b --> return (keyBindingToKeymap (runKeys k) config)) emitKey = flip sendKey w configureIf (flip elem (browsers ++ spotify) <$> className) $ do bind xK_h $ do rawMask controlMask $ emitKey (0, xK_BackSpace) forM_ mods $ \mask -> rawMask (altMask .|. mask) $ emitKey (mask, xK_Left) bind xK_t $ forM_ mods $ \mask -> rawMask (altMask .|. mask) $ emitKey (mask, xK_Down) bind xK_c $ forM_ mods $ \mask -> rawMask (altMask .|. mask) $ emitKey (mask, xK_Up) bind xK_n $ forM_ mods $ \mask -> rawMask (altMask .|. mask) $ emitKey (mask, xK_Right) 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. bind xK_u $ rawMask controlMask $ emitKey (controlMask .|. shiftMask, xK_BackSpace) bind xK_w $ rawMask controlMask $ emitKey (controlMask, xK_BackSpace) bind xK_b $ do rawMask altMask $ emitKey (controlMask, xK_Left) rawMask (altMask .|. shiftMask) $ emitKey (controlMask .|. shiftMask, xK_Left) bind xK_e $ do rawMask altMask $ emitKey (controlMask, xK_Right) rawMask (altMask .|. shiftMask) $ emitKey (controlMask .|. shiftMask, xK_Right) bind xK_dollar $ rawMask altMask $ emitKey (0, xK_End) bind xK_at $ do rawMask (altMask .|. shiftMask) $ emitKey (shiftMask, xK_Home) rawMask altMask $ emitKey (0, xK_Home) bind xK_d $ rawMask controlMask $ emitKey (controlMask, xK_Tab) bind xK_Escape $ rawMask controlMask $ emitKey (controlMask, xK_w) bind xK_i $ do rawMask controlMask $ emitKey (controlMask .|. shiftMask, xK_Tab) bind xK_F2 $ -- Experimental. noMod (logs Info "This is a test" :: X ()) -- 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"] spotify = ["Spotify"] -- 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 withWindowSet $ mapM_ (runQuery doQuery) . W.allWindows startupHook xconfig, manageHook = (doQuery >> return (Endo id)) <> manageHook xconfig } where doQuery :: Query () doQuery = do map <- execWriterT $ windowSpecificBindings xconfig w <- ask liftX $ logs Info "For Window: %s" (show w) forM_ (Map.toList map) $ \(key, action) -> do liftX $ logs Info " -- remap: %s" (show key) remapKey key action applyKeys :: XConfig l -> IO (XConfig l) applyKeys config = return $ windowBindings $ config { keys = keyBindingToKeymap keymap, mouseBindings = buttonBindingsToButtonMap mouseMap } 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