diff options
| author | Josh Rahm <joshuarahm@gmail.com> | 2022-04-10 13:26:16 -0600 |
|---|---|---|
| committer | Josh Rahm <joshuarahm@gmail.com> | 2022-10-09 12:19:46 -0600 |
| commit | a652c330707e2e9bbe963e01af79ce730cf3452e (patch) | |
| tree | 047655195f50efcbd51db8f825acf589dc6abead /src/Internal/Keys.hs | |
| parent | 381a3e5a00813314249bb74b5460f5ff5a4006bb (diff) | |
| download | rde-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.hs | 820 |
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 |