From fada61902291aeb29914fff288301a8c487c4ecd Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Sun, 10 Apr 2022 13:26:16 -0600 Subject: Rename Internal to Rahm.Desktop --- src/Rahm/Desktop/Keys.hs | 820 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 820 insertions(+) create mode 100644 src/Rahm/Desktop/Keys.hs (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs new file mode 100644 index 0000000..9712f84 --- /dev/null +++ b/src/Rahm/Desktop/Keys.hs @@ -0,0 +1,820 @@ +{-# LANGUAGE RankNTypes, FlexibleContexts, ViewPatterns #-} +module Rahm.Desktop.Keys (applyKeys) where + +import XMonad.Util.Run (safeSpawn) +import Data.Monoid (Endo(..)) +import Control.Monad.Trans.Class +import Control.Monad.Reader +import Control.Monad.Writer +import Control.Monad.Loops (iterateWhile) +import Control.Monad.Fix (fix) +import Graphics.X11.ExtraTypes.XF86; +import Rahm.Desktop.KeysM +import Rahm.Desktop.SwapMaster (swapMaster) +import XMonad.Hooks.ManageDocks +import XMonad.Layout.MosaicAlt +import Graphics.X11.ExtraTypes.XorgDefault +import System.Process +import XMonad.Util.Ungrab +import XMonad.Layout.Spacing +import Data.Maybe (isJust, fromMaybe) +import Debug.Trace +import Control.Applicative +import Prelude hiding ((!!)) +import Control.Monad +import Data.Char +import Data.List hiding ((!!)) +import Data.List.Safe ((!!)) +import Data.Map (Map) +import Rahm.Desktop.Layout +import Rahm.Desktop.Marking +import Rahm.Desktop.PromptConfig +import System.IO +import Text.Printf +import XMonad +import Rahm.Desktop.Submap +import XMonad.Actions.WindowNavigation +import XMonad.Prompt +import XMonad.Prompt.Input +import XMonad.Prompt.Shell +import XMonad.Util.CustomKeys +import XMonad.Util.Scratchpad +import XMonad.Actions.RotSlaves +import XMonad.Actions.CopyWindow as CopyWindow +import XMonad.Actions.SpawnOn as SpawnOn + +import qualified Data.Map as Map +import qualified XMonad.StackSet as W + +import Rahm.Desktop.LayoutList +import Rahm.Desktop.MouseMotion +import Rahm.Desktop.Windows +import Rahm.Desktop.Lib +import Rahm.Desktop.DMenu +import Rahm.Desktop.PassMenu +import Rahm.Desktop.Logger +import Rahm.Desktop.RebindKeys +import Rahm.Desktop.Swallow +import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward) + +type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ()) +type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ()) + + +spawnX :: String -> X () +spawnX = spawn + +noWindow :: b -> Window -> b +noWindow = const + +decreaseVolume = spawnX "pactl set-sink-volume @DEFAULT_SINK@ -5%" +increaseVolume = spawnX "pactl set-sink-volume @DEFAULT_SINK@ +5%" +playPause = spawnX "spotify-control play" +mediaPrev = spawnX "spotify-control prev" +mediaNext = spawnX "spotify-control next" + +decreaseVolumeDoc = doc "Decrease volume" decreaseVolume +increaseVolumeDoc = doc "Increase volume" increaseVolume +playPauseDoc = doc "Play/Pause current media" playPause +mediaPrevDoc = doc "Previous media" mediaPrev +mediaNextDoc = doc "Next media" mediaNext + + +button6 :: Button +button6 = 6 + +button7 :: Button +button7 = 7 + +button8 :: Button +button8 = 8 + +button9 :: Button +button9 = 9 + +button10 :: Button +button10 = 10 + +button11 :: Button +button11 = 11 + +button12 :: Button +button12 = 12 + +button13 :: Button +button13 = 13 + +button14 :: Button +button14 = 14 + +button15 :: Button +button15 = 15 + +keyBindingToKeymap :: (XConfig l -> KeyBindings) -> KeyMap l +keyBindingToKeymap bindings config = fmap bindingToX (bindings config) + + where + bindingToX b = + case b of + Documented _ (Action x) -> x + Documented _ (Submap mapping) -> + submap (fmap bindingToX mapping) + Documented _ (Repeat mapping) -> + fix $ \recur -> + submap (fmap (\b -> bindingToX b >> recur) mapping) + +keymap :: XConfig l -> KeyBindings +keymap = runKeys $ do + config <- getConfig + + let subkeys keysM = Submap (runKeys keysM config) + repeatable keysM = Repeat (runKeys keysM config) + + bind xK_apostrophe $ do + justMod $ + doc "Jumps between marks." $ + mapNextString $ \_ str -> + case str of + ['\''] -> jumpToLast + [ch] | isAlphaNum ch -> jumpToMark ch + "[" -> historyPrev + "]" -> historyNext + _ -> return () + + shiftMod $ + doc "Swap the current window with a mark." $ + mapNextString $ \_ str -> + case str of + ['\''] -> swapWithLastMark + [ch] | isAlphaNum ch -> swapWithMark ch + _ -> return () + + bind xK_BackSpace $ do + -- The only raw keybinding. Meant to get a terminal to unbrick XMonad if + -- something goes wrong with the keyboard layout and for first-time boots + -- where dmenu/alacritty may not be installed. + rawMask mod4Mask $ + doc "Spawns XTerm as a fallback if xkb is messed up." $ + spawnX "xterm" + + -- Moves xmobar to different monitors. + justMod $ + doc "Move XMobar to another screen." $ + spawnX "pkill -SIGUSR1 xmobar" + + bind xK_F1 $ do + -- Experimental. Sends 'a' to all windows. + -- + -- I've discovered that many clients ignore such synthetic events, including + -- Spotify, Chrome and Gedit. Some, like Chrome, seem to honor them if it's + -- focused. It's pretty annoying because it keeps me from doing some cool + -- things all for BS security theater, but I guess there might be some way + -- to do this via XTest? + shiftMod $ forAllWindows $ \w -> do + logs $ "Try send to " ++ show w + sendKey (0, xK_a) w + + justMod $ + doc "Print this documentation" + (safeSpawn "gxmessage" [ + "-fn", "Source Code Pro", + documentation (keymap config)] :: X ()) + + bind xK_F7 $ + + justMod $ + doc "Print this documentation." $ + logs (documentation (keymap config)) + + bind xK_F10 $ do + justMod playPauseDoc + + bind xK_F11 $ do + justMod mediaPrevDoc + + bind xK_F12 $ do + justMod mediaNextDoc + + bind xK_Return $ do + justMod swapMaster + + bind xK_Tab $ do + justMod $ windows W.focusDown + shiftMod $ windows W.focusUp + + -- Switch between different screens. These are the leftmost keys on the home + -- row in a Dvorak layout. One might want to switch these to ASD for QWERTY. + forM_ (zip [xK_a, xK_o, xK_e] [0..]) $ \(key, idx) -> + bind key $ do + -- Move focus to that screen. + justMod $ + doc ("Switch focus to screen " ++ show idx) $ + withScreen W.view idx + -- Swap the current screen with the one given + altMod $ + doc ("Swap the current screen with screen " ++ show idx) $ + withScreen W.greedyView idx + -- Move the current window to the select screen. + shiftMod $ + doc ("Move the current window to screne " ++ show idx) $ + withScreen W.shift idx + + altgrMod $ + logs "Test altgr" + + bind xK_bracketright $ do + justMod $ + doc "Increase the gaps between windows." $ + sendMessage $ modifyWindowBorder 5 + + bind xK_bracketleft $ do + justMod $ + doc "Decrease the gaps between windows." $ + sendMessage $ modifyWindowBorder (-5) + + bind xK_b $ do + justMod $ spawnX "bluetooth-select.sh" + + bind xK_c $ do + justMod $ + doc "Run PassMenu" runPassMenu + + shiftMod $ + doc "Kill the current window" CopyWindow.kill1 + + bind xK_f $ do + justMod $ + doc "Flip the current layout vertically" $ + sendMessage FlipLayout + shiftMod $ + doc "Flip the current layout horizontally" $ + sendMessage HFlipLayout + + bind xK_g $ do + justMod $ + doc "Goto a workspace\n\n\t\ + + \If the second character typed is alpha-numberic, jump to that\n\t\ + \workspace. The workspace is created on-the-fly if such a workspace\n\t\ + \does not exist.\n\n\t\ + + \If the second character typed is:\n\t\t\ + \]: go to the next workspace\n\t\t\ + \[: go to the previous workspace\n\t\t\ + \}: cycle the workspaces on the screens to the right\n\t\t\ + \{: cycle the workspaces on the screens to the left\n\t\t\ + \: 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 -- cgit