module Rahm.Desktop.Keys (applyKeys) where import Control.Monad ( filterM, forM_, unless, when, ) import Control.Monad.Identity (Identity (Identity, runIdentity)) import Control.Monad.Trans.Maybe ( MaybeT (..), runMaybeT, ) import Control.Monad.Writer ( WriterT, execWriterT, fix, lift, tell, ) import Data.Char (isAlpha, toLower) import Data.IORef import Data.List (foldl', isInfixOf) import Data.List.Safe ((!!)) import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe ( fromMaybe, mapMaybe, ) import Data.Monoid (Endo (..)) import GHC.IO.Handle (hClose, hFlush) import Graphics.X11.ExtraTypes.XF86 ( xF86XK_AudioLowerVolume, xF86XK_AudioMute, xF86XK_AudioNext, xF86XK_AudioPlay, xF86XK_AudioPrev, xF86XK_AudioRaiseVolume, xF86XK_Calculator, xF86XK_MonBrightnessDown, xF86XK_MonBrightnessUp, ) import Graphics.X11.XScreenSaver (XScreenSaverState (ScreenSaverCycle)) import Rahm.Desktop.BorderColors (BorderColor (BorderColor), withBorderColor, withBorderColorM) import Rahm.Desktop.Common ( Location (..), click, duplWindow, focusLocation, getCurrentWorkspace, gotoWorkspace, locationWindow, locationWorkspace, pointerScreen, pointerWindow, pointerWorkspace, runMaybeT_, setBorderWidth, ) import Rahm.Desktop.DMenu (runDMenu) import qualified Rahm.Desktop.Dragging as D import Rahm.Desktop.History ( historyBack, historyForward, jumpToLastLocation, ) import Rahm.Desktop.Keys.Dsl2 import Rahm.Desktop.Keys.Local import Rahm.Desktop.Keys.Grab (KeySymOrKeyCode (..)) import Rahm.Desktop.Keys.KeyFeed (execKeyFeed, liftXToFeed, pushKey, runKeyFeed, runKeyFeedX) import Rahm.Desktop.Keys.Wml import Rahm.Desktop.Layout (nLayouts) import Rahm.Desktop.Layout.ConsistentMosaic ( expandPositionAlt, shrinkPositionAlt, ) import Rahm.Desktop.Layout.Explode (toggleExplode, toggleExplodeM) 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.PopupTerminal (movePopupToCurrentWorkspace, movePopupToHiddenWorkspace) import Rahm.Desktop.RebindKeys ( remapKey, sendKey, ) import Rahm.Desktop.StackSet (screens) 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.WorkspaceWheel (displayWorkspaceWheel, displayWorkspaceWheelAtPoint, displayWorkspaceWheelInCenter) import Rahm.Desktop.Workspaces ( accompanyingWorkspace, next, prev, viewAdjacent, viewAdjacentTo, withScreen, ) import Rahm.Desktop.XMobarLog.PendingBuffer ( addStringToPendingBuffer, pushAddPendingBuffer, pushPendingBuffer, ) import System.Exit (exitFailure, exitSuccess) 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.Hooks.ScreenCorners import XMonad.Layout.Spacing ( Border (..), SpacingModifier (..), ) import XMonad.Util.Run (hPutStrLn, safeSpawn, spawnPipe) 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 selectedWindowsColor = BorderColor "#00ffff" "#00ffff" decreaseVolume = spawnX "set-app-volume.sh --down" increaseVolume = spawnX "set-app-volume.sh --up" 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 kcQ :: KeyCode kcQ = 24 kcW :: KeyCode kcW = 25 kcE :: KeyCode kcE = 26 kcI :: KeyCode kcI = 31 kcJ :: KeyCode kcJ = 44 kcK :: KeyCode kcK = 45 kcL :: KeyCode kcL = 46 kcU :: KeyCode kcU = 30 kcO :: KeyCode kcO = 32 kcSpace :: KeyCode kcSpace = 65 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 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 bindings :: Binder () bindings = do let mod3 = rawMask mod3Mask bind xK_apostrophe $ do justMod $ doc "Jump to a window/tile currently dragging window" $ do ifM D.isDragging (D.finishDrag >> withFocused D.sinkByWindowUnderCursor) $ pushPendingBuffer "' " $ do runMaybeT_ $ do l <- runKeyFeed readNextLocationSet' case l of (h : _) -> lift (focusLocation h) _ -> return () shiftMod $ doc "Drag workspace to another." D.dragWindow 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) <$> runKeyFeed readNextLocationSet withBorderColorM selectedWindowsColor l1 $ do lift $ addStringToPendingBuffer " " l2 <- mapMaybe (\(Location _ w) -> w) <$> runKeyFeed 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 runMaybeT_ $ do w1 <- runKeyFeed readNextWorkspaceName wins <- lift $ W.windowsOnWorkspace w1 <$> gets windowset withBorderColorM selectedWindowsColor wins $ do lift $ addStringToPendingBuffer " " w2 <- runKeyFeed readNextWorkspaceName lift $ windows $ W.swapWorkspaces w1 w2 bind xK_BackSpace $ do -- Moves xmobar to different monitors. justMod $ doc "Move XMobar to another screen." $ spawnX "pkill -SIGUSR1 xmobar" -- Ways to kill XMonad with (hopefully) consistent keys in case xkb gets -- really messed up. withMod (shiftMask .|. mod1Mask) $ doc "Kills xmonad, exiting successfully" (io exitSuccess :: X ()) withMod (shiftMask .|. mod1Mask .|. controlMask) $ doc "Kills xmonad, exiting unsuccessfully" (io exitFailure :: X ()) let getDoc :: X String getDoc = do config <- asks config return $ "Key and Mouse Bindings:\n\n" ++ documentation config bindings bind xK_F1 $ do justMod $ doc "Print this documentation" $ do doc <- getDoc safeSpawn "gxmessage" ["-fn", "Source Code Pro", doc] bind xK_F7 $ do justMod $ doc "Print this documentation to stdout (at LogLevel Info)" (logs Info "%s" =<< getDoc) 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 -- The only raw keybinding. It's a consistent way to launch xterm to unbrick -- XMonad in case rofi and alacritty are broken or the keyboard is messed -- up. rawMask (shiftMask .|. mod4Mask .|. mod1Mask) $ doc "Spawns XTerm as a fallback if xkb is messed up." $ spawnX "xterm" 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_i $ do justMod $ spawnX "notes-select.sh" bind xK_c $ do justMod $ doc "Run PassMenu" runPassMenu shiftMod $ doc "Kill the current window" CopyWindow.kill1 bind xK_slash $ justMod $ doc "Discover the workspaces on each screen" screenDiscovery bind xK_f $ do justMod $ doc "Focus (non-greedily) a workspace. Useful for focusing between \ \screens with ',.', '$', '^', etc." $ pushPendingBuffer "f " $ do runMaybeT_ $ do ws <- runKeyFeed readNextWorkspaceName lift $ windows $ W.view ws bind xK_a $ do justMod $ doc "Cycle focus forward through the screens. (Synonymous with f,.)" $ do runMaybeT_ $ do ws' <- workspaceForStringT ",." ws <- MaybeT . return $ workspaceName ws' lift $ windows $ W.view ws shiftMod $ doc "Cycle focus backward through the screens. (Synonymous with f;.)" $ do runMaybeT_ $ do ws' <- workspaceForStringT ";." ws <- MaybeT . return $ workspaceName ws' lift $ windows $ W.view ws 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 accompanyingWorkspace (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" $ subbind $ do bind xK_F1 $ (noMod -|- justMod) $ do doc <- getDoc safeSpawn "gxmessage" ["-fn", "Source Code Pro", doc] bind xK_F5 $ (noMod -|- justMod) $ spawnX "xmonad --recompile && xmonad --restart" bindOtherKeys $ \key -> execKeyFeed $ do pushKey key ws <- readNextWorkspace liftXToFeed $ gotoWorkspaceFn ws 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 <- runKeyFeed readNextWorkspaceName lift $ addStringToPendingBuffer " " w2 <- runKeyFeed readNextWorkspaceName lift $ windows $ W.switchWorkspaces w1 w2 bind xK_d $ justMod $ doc "Record (define) macros." $ subbind $ 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" $ withFocused $ \w -> withWindowsUnpinned [w] $ windows W.swapDownOrMirror 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." $ withFocused $ \w -> withWindowsUnpinned [w] $ windows W.swapUpOrMirror 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 <$> runKeyFeed readNextLocationSet lift $ mapM_ pinWindow windows shiftMod $ doc "Unpin a windowset" $ pushPendingBuffer "P " $ runMaybeT_ $ do windows <- mapMaybe locationWindow <$> runKeyFeed 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 <- runKeyFeed 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 [] <$> runKeyFeedX readNextLocationSet let wins = mapMaybe locationWindow locs unless (null wins) $ do withBorderColor selectedWindowsColor 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 <$> runKeyFeed readNextLocationSet (allMovements, finalSwap) <- withBorderColorM selectedWindowsColor selection $ do lift $ addStringToPendingBuffer " " ws <- runKeyFeed readNextWorkspace finalSwap <- case shiftType of ShiftAndSwap -> do lift $ addStringToPendingBuffer " " wsName <- MaybeT . return $ workspaceName ws W.switchWorkspaces wsName <$> runKeyFeed readNextWorkspaceName _ -> return id lift $ do allMovements <- moveWindowsToWorkspaceFn 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) return (allMovements, finalSwap) lift $ 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_x $ do justMod $ doc "Toggles respect for struts." $ sendMessage ToggleStruts shiftMod $ doc "Remove the border from the focused window" $ withFocused $ setBorderWidth 0 . (: []) bind xK_space $ do justMod $ doc "Layout-related bindings" $ subbind $ 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_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 () bind xK_x $ do shiftMod $ doc "Reset the holes" $ do sendMessage resetHole justMod $ doc "Add hole next to the current window" $ do withFocused $ \foc -> withWindowSet $ \ws -> do whenJust (W.windowTilePosition foc ws) $ \tp -> do (X.broadcastMessage . addHole) tp refresh 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 =<< asks (terminal . config) shiftMod $ doc "Sink the current window into the tiling." $ withFocused $ \w -> do unpinWindow w (windows . W.sink) w altMod $ doc "Spawn a floating terminal" $ spawnX =<< asks ((++ " --class floating-terminal") . terminal . config) bind xK_z $ do justMod $ doc "Less often used keybindings." $ subbind $ 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_t $ do (justMod -|- noMod) $ spawnX "tabs-search.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 -- Explode bind xK_c $ do noMod -|- justMod $ doc "Run Quick-clip" $ spawnX "quick-clip.sh" bindOtherKeys $ \(_, _, s) -> logs Info "Unhandled key pressed: %s" s bindOtherButtons $ \(_, b) -> logs Info "Unhandled button press: %s" (show b) -- 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 =<< asks ((++ " --class floating-terminal -e /usr/bin/env python3") . terminal . config) 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" -- Button bindings. These are bindings to buttons on my mouse. -- -- I usre a G502 SE HERO Gaming Mouse. This mouse has 13 buttons on it. The -- standard right, left, middle, scroll up/down, wheel tilt left/right, -- forward/back, plus four additional buttons. -- -- This allows me to make some pretty complex and powerful mappings with just -- the mouse by using button press sequences to mean different things. bind button1 $ do justMod $ doc "Float and move a window" $ \win -> do winSels <- getAndResetWindowSelection if null winSels then myMouseMoveWindow win else myMouseMoveWindows winSels 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 let button14Binder = do bind button3 $ noMod $ doc "Drag a workspace to a different screen" $ noWindow D.dragWorkspace bind button1 $ noMod $ doc "Swap a window with another window by dragging." $ noWindow D.dragWindow 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 (viewAdjacentTo pointerWorkspace next)), (button8, "History Back", noWindow (viewAdjacentTo pointerWorkspace prev)), (button6, "Media Previous", noWindow mediaPrev), (button7, "Media Next", noWindow mediaNext) ] continuous $ do forM_ mediaButtons $ \(b, d, a) -> bind b $ noMod $ doc d a bind xK_h $ justMod decreaseVolumeDoc bind xK_l $ justMod increaseVolumeDoc bind xK_o $ do justMod $ doc "Select a workspace using dzen" displayWorkspaceWheelInCenter bind button10 $ do noMod $ doc "Select a workspace using dzen" $ do noWindow displayWorkspaceWheel bind button14 $ do noMod $ doc "Additional Mouse Bindings" $ subbind button14Binder bind xK_v $ do justMod $ doc "Same as button14" $ subbind button14Binder bind button13 $ noMod $ doc "General Window Management Extra Mouse Bindings" $ subbind $ 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 $ subbind $ do bind button13 $ noMod $ subbind $ 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" $ subbind $ do bind button13 $ noMod $ doc "Goto the accompanying workspace to the current one." $ noWindow $ gotoWorkspace . accompanyingWorkspace =<< 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 button15 $ noMod $ doc "Clear the window selection" $ noWindow (clearWindowSelection >> escape) bind button13 $ noMod $ doc "Kill the windows in the selection" $ noWindow $ do mapM_ X.killWindow =<< getAndResetWindowSelection escape bind button10 $ noMod $ doc "Show dzen selection" $ noWindow $ do displayWorkspaceWheel escape bind button14 $ noMod $ subbind $ do bind button1 $ noMod $ doc "Pin the selected windows" $ noWindow $ do wins <- getAndResetWindowSelection mapM_ pinWindow wins escape bind button3 $ noMod $ doc "Unpin the selected windows" $ noWindow $ do wins <- getAndResetWindowSelection mapM_ unpinWindow wins escape bind button3 $ noMod $ doc "Move all the windows to the workspace the pointer is on" $ noWindow $ do wins <- getAndResetWindowSelection D.mouseMoveWindowsAndThen (mapM_ X.focus) ( mconcat [ D.ifReleased button1 D.sinkOnRelease, D.ifReleased' button2 $ \w _ -> pinWindow w ] ) wins escape 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 -- Keycode Bindings. -- -- These bindings bind directly to KeyCodes rather than keysyms. By -- convention, these keys should map to mod3 to avoid collisions with bindings -- above. -- -- Keycode bindings are good for non-mnemonic keys, where the position on the -- keyboard, rather than their character, are the reason for the binding. -- These bindings are consistent across keyboard layouts. -- -- In my configuration, the tab key sets mod3 while held down. bind kcQ $ mod3 mediaPrevDoc bind kcW $ mod3 playPauseDoc bind kcE $ mod3 mediaNextDoc bind kcQ $ shiftMod $ doc "Restarts xmonad. Always binds to the 'Q' key." $ spawnX "xmonad --recompile && xmonad --restart" bind kcQ $ controlMod $ doc "Kills xmonad. Always binds to the 'Q' key." (io exitSuccess :: X ()) localKeys cornersConfig :: Map ScreenCorner (X ()) cornersConfig = Map.fromList [ ( SCUpperLeft, displayWorkspaceWheel ) ] -- where -- -- permuteMods = map (foldl' (.|.) 0) . filterM (const [True, False]) myMouseMoveWindow = myMouseMoveWindows . Identity myMouseMoveWindows :: (Foldable f) => f Window -> X () myMouseMoveWindows = D.mouseMoveWindowsAndThen (mapM_ X.focus) ( mconcat [ D.ifReleased button3 D.sinkOnRelease, D.ifReleased' button2 $ \w _ -> pinWindow w ] ) myMouseResizeAction = D.mouseResizeWindowAndThen X.focus $ mconcat [ D.ifReleased button1 D.sinkOnRelease ] applyKeys :: XConfig l -> IO (XConfig l) applyKeys c = let conf' = withBindings bindings c in return $ windowBindings $ conf' { keys = Map.insert (modMask c .|. shiftMask, xK_q) (spawnX "xmonad --recompile && xmonad --restart") . keys conf', startupHook = do startupHook c -- forM_ (Map.toList cornersConfig) (uncurry addScreenCorner) } windowSpecificBindings :: XConfig l -> WriterT (Map (KeyMask, KeySym) (X ()), Map (KeyMask, KeyCode) (X ())) Query () windowSpecificBindings config = do w <- lift ask let altMask = mod1Mask let mods = permuteMods [shiftMask, controlMask, 0] let configureIf b k = let (Bindings keymap keycodemap _) = resolveBindings (runBinder config k) in tell =<< lift (b --> return (keymap config, keycodemap config)) emitKey = flip sendKey w configureIf (return True) $ do -- The following are bindings that send keystrokes to the focused window. This -- makes navigating with arrow keys and whatnot much easier. forM_ (permuteMods [0, controlMask, shiftMask]) $ \mods -> do bind kcI $ rawMask (mod3Mask .|. mods) $ emitKey (mods, xK_Up) bind kcK $ rawMask (mod3Mask .|. mods) $ emitKey (mods, xK_Down) bind kcJ $ rawMask (mod3Mask .|. mods) $ emitKey (mods, xK_Left) bind kcL $ rawMask (mod3Mask .|. mods) $ emitKey (mods, xK_Right) bind kcU $ rawMask mod3Mask $ emitKey (controlMask .|. shiftMask, xK_Tab) bind kcO $ rawMask mod3Mask $ emitKey (controlMask, xK_Tab) forM_ [0, shiftMask] $ \m -> do bind xK_braceleft $ rawMask (m .|. mod3Mask) $ emitKey (m .|. controlMask, xK_Up) bind xK_braceright $ rawMask (m .|. mod3Mask) $ emitKey (m .|. controlMask, xK_Down) bind xK_dollar $ rawMask (m .|. mod3Mask) $ emitKey (m .|. 0, xK_End) bind xK_at $ rawMask (m .|. mod3Mask) $ emitKey (m .|. 0, xK_Home) bind xK_w $ rawMask (m .|. mod3Mask) $ emitKey (m .|. shiftMask, xK_BackSpace) bind xK_b $ rawMask (m .|. mod3Mask) $ emitKey (m .|. controlMask, xK_Left) bind xK_e $ rawMask (m .|. mod3Mask) $ emitKey (m .|. controlMask, xK_Right) bind xK_u $ rawMask (m .|. mod3Mask) $ emitKey (m .|. controlMask, xK_Page_Up) bind xK_d $ rawMask (m .|. mod3Mask) $ emitKey (m .|. controlMask, xK_Page_Down) configureIf ((\c -> any ($ c) 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. -- The following are bindings that send keystrokes to the focused window. This -- makes navigating with arrow keys and whatnot much easier. 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_Escape $ rawMask controlMask $ emitKey (controlMask, xK_w) -- 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" `isInfixOf`) . map toLower] -- 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 Debug "For Window: %s" (show w) forM_ (Map.toList (snd map)) $ \(kc, action) -> do liftX $ logs Debug " -- remap: %s" (show kc) remapKey (fmap Kc kc) action forM_ (Map.toList (fst map)) $ \(key, action) -> do liftX $ logs Debug " -- remap: %s" (show key) remapKey (fmap Ks key) action 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 screenDiscovery :: X () screenDiscovery = do ss <- gets windowset forM_ (zip (True : repeat False) (screens ss)) $ \( foc, W.Screen { W.workspace = (W.Workspace tag _ _), W.screenDetail = SD rect } ) -> do liftIO (launchDzen foc tag rect) where launchDzen foc tag (Rectangle x y w h) = do pipe <- spawnPipe ( printf "dzen2 -fn \"Monofur Nerd Font:size=150:style=bold\" -p 1 -x %d -y %d -w 350 -h 350 -bg '%s' -fg '#000000'" (x + (fromIntegral w `div` 2) - 175) (y + (fromIntegral h `div` 2) - 175) (if foc then "#ff8888" else "#8888ff") ) hPutStrLn pipe tag hFlush pipe hClose pipe