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 From 49f20ca3391ca713c021fdf15bf9db3fe54f18f6 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Sun, 10 Apr 2022 13:51:43 -0600 Subject: More refactoring. Started breaking up Layout. Moved Language extensions into stack file. --- src/Rahm/Desktop/Keys.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 9712f84..0bebd6f 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE RankNTypes, FlexibleContexts, ViewPatterns #-} module Rahm.Desktop.Keys (applyKeys) where import XMonad.Util.Run (safeSpawn) @@ -26,7 +25,7 @@ import Data.Char import Data.List hiding ((!!)) import Data.List.Safe ((!!)) import Data.Map (Map) -import Rahm.Desktop.Layout +import Rahm.Desktop.Layout.Layout import Rahm.Desktop.Marking import Rahm.Desktop.PromptConfig import System.IO @@ -46,7 +45,7 @@ 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.Layout.LayoutList import Rahm.Desktop.MouseMotion import Rahm.Desktop.Windows import Rahm.Desktop.Lib -- cgit From 4ec113c501dd0435bce173110ef2f0ba0293c360 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Mon, 11 Apr 2022 22:58:45 -0600 Subject: Rename Zoom to Pop and move into its own Module. Much cleaner. --- src/Rahm/Desktop/Keys.hs | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 0bebd6f..7ca6161 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -54,6 +54,7 @@ import Rahm.Desktop.PassMenu import Rahm.Desktop.Logger import Rahm.Desktop.RebindKeys import Rahm.Desktop.Swallow +import Rahm.Desktop.Layout.Pop (PopMessage(..)) import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward) type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ()) @@ -311,16 +312,16 @@ keymap = runKeys $ do bind xK_j $ do justMod $ - doc "Shrink the size of the zoom region" $ - sendMessage ShrinkZoom + doc "Shrink the size of the master region" $ + sendMessage Shrink 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 + doc "Expand the size of the master region" $ + sendMessage Expand shiftMod $ doc "Go to the next window in history." historyNext @@ -524,7 +525,7 @@ keymap = runKeys $ do bind xK_z $ do noMod -|- justMod $ doc "Toggle zoom on the current window." $ - sendMessage ToggleZoom + sendMessage TogglePop -- Z is reserved to create sub keybindings to do various things. -- I don't really use these at the moment. @@ -536,7 +537,7 @@ keymap = runKeys $ do -- modifier. shiftMod $ doc "Toggle zoom on the current window." $ - sendMessage ToggleZoom + sendMessage TogglePop bind xF86XK_Calculator $ do noMod $ spawnX $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3" @@ -625,7 +626,7 @@ mouseMap = runButtons $ do noMod $ noWindow $ click >> CopyWindow.kill1 bind button14 $ do - noMod $ noWindow $ click >> sendMessage ToggleZoom + noMod $ noWindow $ click >> sendMessage TogglePop bind button15 $ do noMod $ noWindow $ spawnX "pavucontrol" -- cgit From e3cd7723739aed7dea5ec8bc8952e16b2cc4b06c Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Tue, 12 Apr 2022 00:23:26 -0600 Subject: Break the Flippable modifiers into their own file. This also combines the two into a single type. --- src/Rahm/Desktop/Keys.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 7ca6161..b8a4c4e 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -55,6 +55,7 @@ import Rahm.Desktop.Logger import Rahm.Desktop.RebindKeys import Rahm.Desktop.Swallow import Rahm.Desktop.Layout.Pop (PopMessage(..)) +import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically) import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward) type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ()) @@ -245,10 +246,10 @@ keymap = runKeys $ do bind xK_f $ do justMod $ doc "Flip the current layout vertically" $ - sendMessage FlipLayout + sendMessage flipVertically shiftMod $ doc "Flip the current layout horizontally" $ - sendMessage HFlipLayout + sendMessage flipHorizontally bind xK_g $ do justMod $ @@ -625,6 +626,7 @@ mouseMap = runButtons $ do bind button13 $ do noMod $ noWindow $ click >> CopyWindow.kill1 + bind button14 $ do noMod $ noWindow $ click >> sendMessage TogglePop -- cgit From 7e6fc4bd1427dfcfb849c9e23a64bff57b19baba Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Tue, 12 Apr 2022 01:04:05 -0600 Subject: Break out the ModifyDescription into its own file. --- src/Rahm/Desktop/Keys.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index b8a4c4e..c8d9092 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -56,6 +56,7 @@ import Rahm.Desktop.RebindKeys import Rahm.Desktop.Swallow import Rahm.Desktop.Layout.Pop (PopMessage(..)) import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically) +import Rahm.Desktop.Layout.Rotate (rotateLayout) import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward) type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ()) @@ -398,7 +399,7 @@ keymap = runKeys $ do justMod $ doc "Run a command via Rofi" runDMenu shiftMod $ doc "Rotate the current layout. (flips x, y coordinates)" $ - sendMessage DoRotate + sendMessage rotateLayout bind xK_s $ do altMod $ spawnX "sudo -A systemctl suspend && xsecurelock" -- cgit From 1fbaaa7ce69ed6320693c389bf670fd3cf20cdd1 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Tue, 12 Apr 2022 01:05:48 -0600 Subject: Move Rahm.Desktop.Layout.Layout to Rahm.Desktop.Layout --- src/Rahm/Desktop/Keys.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index c8d9092..e780fbf 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -25,7 +25,7 @@ import Data.Char import Data.List hiding ((!!)) import Data.List.Safe ((!!)) import Data.Map (Map) -import Rahm.Desktop.Layout.Layout +import Rahm.Desktop.Layout import Rahm.Desktop.Marking import Rahm.Desktop.PromptConfig import System.IO -- cgit From 96643003bd14195f4868712789cd056e9d3581ae Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Tue, 12 Apr 2022 01:54:43 -0600 Subject: Add another layout modifier to add a hole. This is mostly an academic exercise, as there's probably not much reason to put a hole in the layout, but I must admit that sometimes is aesthetically pleasing to see a little more desktop wallpaper in some cases. --- src/Rahm/Desktop/Keys.hs | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index e780fbf..0ff8da3 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -54,6 +54,7 @@ import Rahm.Desktop.PassMenu import Rahm.Desktop.Logger import Rahm.Desktop.RebindKeys import Rahm.Desktop.Swallow +import Rahm.Desktop.Layout.Hole (toggleHole) import Rahm.Desktop.Layout.Pop (PopMessage(..)) import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically) import Rahm.Desktop.Layout.Rotate (rotateLayout) @@ -188,6 +189,12 @@ keymap = runKeys $ do doc "Print this documentation." $ logs (documentation (keymap config)) + bind xK_F8 $ + + justMod $ + doc "Print this documentation." $ + sendMessage toggleHole + bind xK_F10 $ do justMod playPauseDoc -- cgit From e0d58319014226faeff1a09c7abce7865b551b30 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Tue, 12 Apr 2022 11:09:19 -0600 Subject: Clean up Poppable so it's a proper proxy to the underlying layout rather than a LayoutModifier. --- src/Rahm/Desktop/Keys.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 0ff8da3..5284a9d 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -55,7 +55,7 @@ import Rahm.Desktop.Logger import Rahm.Desktop.RebindKeys import Rahm.Desktop.Swallow import Rahm.Desktop.Layout.Hole (toggleHole) -import Rahm.Desktop.Layout.Pop (PopMessage(..)) +import Rahm.Desktop.Layout.Pop (togglePop) import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically) import Rahm.Desktop.Layout.Rotate (rotateLayout) import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward) @@ -534,7 +534,7 @@ keymap = runKeys $ do bind xK_z $ do noMod -|- justMod $ doc "Toggle zoom on the current window." $ - sendMessage TogglePop + sendMessage togglePop -- Z is reserved to create sub keybindings to do various things. -- I don't really use these at the moment. @@ -546,7 +546,7 @@ keymap = runKeys $ do -- modifier. shiftMod $ doc "Toggle zoom on the current window." $ - sendMessage TogglePop + sendMessage togglePop bind xF86XK_Calculator $ do noMod $ spawnX $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3" @@ -636,7 +636,7 @@ mouseMap = runButtons $ do bind button14 $ do - noMod $ noWindow $ click >> sendMessage TogglePop + noMod $ noWindow $ click >> sendMessage togglePop bind button15 $ do noMod $ noWindow $ spawnX "pavucontrol" -- cgit From 85937a13ad9a272d4c9e462b9b7a8b121ae453a6 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Tue, 12 Apr 2022 11:45:41 -0600 Subject: Change keys to make H+Space a leader key for doing layout related stuff. Not sure how I feel about it right now; it'll take some getting used to. --- src/Rahm/Desktop/Keys.hs | 44 ++++++++++++++++++++++++++++++++++---------- 1 file changed, 34 insertions(+), 10 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 5284a9d..33830dc 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -263,7 +263,7 @@ keymap = runKeys $ do justMod $ doc "Goto a workspace\n\n\t\ - \If the second character typed is alpha-numberic, jump to that\n\t\ + \If the second character typed is alpha-numeric, 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\ @@ -412,15 +412,39 @@ keymap = runKeys $ 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 + justMod $ subkeys $ do + + bind xK_n $ + noMod $ doc "Use the next layout in the layout list." $ + sendMessage toNextLayout + + bind xK_p $ + noMod $ doc "Use the previous layout in thelayout list." $ + sendMessage toPreviousLayout + + bind xK_b $ + noMod $ doc "Go back to the first layout in the layout list." $ + sendMessage toFirstLayout + + bind xK_h $ + noMod $ doc "Flip the layout across the horizontal axis" $ + sendMessage flipVertically + + bind xK_v $ + noMod $ doc "Flip the layout across the vertical axis" $ + sendMessage flipHorizontally + + bind xK_r $ + noMod $ doc "Rotate the layout 90 degrees" $ + sendMessage rotateLayout + + bind xK_t $ + noMod $ doc "Toggle the pop window" $ + sendMessage togglePop + + bind xK_x $ + noMod $ doc "Toggle the hole" $ + sendMessage toggleHole bind xK_t $ do justMod $ -- cgit From 3c6a91392cc249a3e71c206dd06dd8a2aa79c329 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Tue, 12 Apr 2022 11:55:57 -0600 Subject: noMod -> (noMod -|- justMod) --- src/Rahm/Desktop/Keys.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 33830dc..27de459 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -412,38 +412,38 @@ keymap = runKeys $ do altMod $ spawnX "sudo -A systemctl suspend && xsecurelock" bind xK_space $ do - justMod $ subkeys $ do + justMod $ doc "Layout-related bindings" $ subkeys $ do bind xK_n $ - noMod $ doc "Use the next layout in the layout list." $ + (noMod -|- justMod) $ doc "Use the next layout in the layout list." $ sendMessage toNextLayout bind xK_p $ - noMod $ doc "Use the previous layout in thelayout list." $ + (noMod -|- justMod) $ doc "Use the previous layout in the layout list." $ sendMessage toPreviousLayout bind xK_b $ - noMod $ doc "Go back to the first layout in the layout list." $ + (noMod -|- justMod) $ doc "Go back to the first layout in the layout list." $ sendMessage toFirstLayout bind xK_h $ - noMod $ doc "Flip the layout across the horizontal axis" $ + (noMod -|- justMod) $ doc "Flip the layout across the horizontal axis" $ sendMessage flipVertically bind xK_v $ - noMod $ doc "Flip the layout across the vertical axis" $ + (noMod -|- justMod) $ doc "Flip the layout across the vertical axis" $ sendMessage flipHorizontally bind xK_r $ - noMod $ doc "Rotate the layout 90 degrees" $ + (noMod -|- justMod) $ doc "Rotate the layout 90 degrees" $ sendMessage rotateLayout bind xK_t $ - noMod $ doc "Toggle the pop window" $ + (noMod -|- justMod) $ doc "Toggle the pop window" $ sendMessage togglePop bind xK_x $ - noMod $ doc "Toggle the hole" $ + (noMod -|- justMod) $ doc "Toggle the hole" $ sendMessage toggleHole bind xK_t $ do -- cgit From 2f636306406371a32e52c1f7bd7a103d4285b586 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Tue, 12 Apr 2022 12:19:02 -0600 Subject: Clean up LayoutList and move to Layout.List --- src/Rahm/Desktop/Keys.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 27de459..87f88cf 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -45,7 +45,6 @@ import XMonad.Actions.SpawnOn as SpawnOn import qualified Data.Map as Map import qualified XMonad.StackSet as W -import Rahm.Desktop.Layout.LayoutList import Rahm.Desktop.MouseMotion import Rahm.Desktop.Windows import Rahm.Desktop.Lib @@ -54,6 +53,7 @@ import Rahm.Desktop.PassMenu import Rahm.Desktop.Logger import Rahm.Desktop.RebindKeys import Rahm.Desktop.Swallow +import Rahm.Desktop.Layout.List (toNextLayout, toPreviousLayout, toFirstLayout) import Rahm.Desktop.Layout.Hole (toggleHole) import Rahm.Desktop.Layout.Pop (togglePop) import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically) -- cgit From e5bee7f2f095bffdef1c31e27f4b036780b01654 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Tue, 12 Apr 2022 13:07:17 -0600 Subject: Add type-static way to get the length of a LayoutList --- src/Rahm/Desktop/Keys.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 87f88cf..321d185 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -53,7 +53,8 @@ import Rahm.Desktop.PassMenu import Rahm.Desktop.Logger import Rahm.Desktop.RebindKeys import Rahm.Desktop.Swallow -import Rahm.Desktop.Layout.List (toNextLayout, toPreviousLayout, toFirstLayout) +import Rahm.Desktop.Layout.List ( + toNextLayout, toPreviousLayout, toFirstLayout, toIndexedLayout) import Rahm.Desktop.Layout.Hole (toggleHole) import Rahm.Desktop.Layout.Pop (togglePop) import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically) @@ -438,10 +439,14 @@ keymap = runKeys $ do (noMod -|- justMod) $ doc "Rotate the layout 90 degrees" $ sendMessage rotateLayout - bind xK_t $ + 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" $ sendMessage toggleHole -- cgit From f85c7160e122f367a357d93689947daa1ef241ef Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Tue, 12 Apr 2022 16:44:35 -0600 Subject: Fix repeatable key to do an action when first pressed. --- src/Rahm/Desktop/Keys.hs | 26 +++++++++++++++++++++----- 1 file changed, 21 insertions(+), 5 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 321d185..622fd3a 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -115,17 +115,19 @@ button15 :: Button button15 = 15 keyBindingToKeymap :: (XConfig l -> KeyBindings) -> KeyMap l -keyBindingToKeymap bindings config = fmap bindingToX (bindings config) +keyBindingToKeymap bindings config = Map.mapWithKey bindingToX (bindings config) where - bindingToX b = + bindingToX :: (KeyMask, KeySym) -> Documented KeyBinding -> X () + bindingToX key b = case b of Documented _ (Action x) -> x Documented _ (Submap mapping) -> - submap (fmap bindingToX mapping) - Documented _ (Repeat mapping) -> + submap (Map.mapWithKey bindingToX mapping) + Documented _ (Repeat mapping) -> do + mapM_ (bindingToX key) (Map.lookup key mapping) fix $ \recur -> - submap (fmap (\b -> bindingToX b >> recur) mapping) + submap (Map.mapWithKey (\k b -> bindingToX k b >> recur) mapping) keymap :: XConfig l -> KeyBindings keymap = runKeys $ do @@ -451,6 +453,20 @@ keymap = runKeys $ do (noMod -|- justMod) $ doc "Toggle the hole" $ sendMessage toggleHole + 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) -- cgit From 6cee136399b92f302a9b660c140167b69b251e51 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Wed, 13 Apr 2022 00:22:08 -0600 Subject: Add ConsistentMosaic, a wrapper to make Mosaic more consistent. Right now, Mosaic operate on the windows itself. But this means that swapping windows can act very unintuitively. This wrapper changes mosaci to work on window /positions/ rather than windows themselves, so the window in position 1 will always be the same size, and when moved to position 2, it will inherit that position's size. There's still some buggy behavior, but it is in general much more intuitive than it was before. --- src/Rahm/Desktop/Keys.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 622fd3a..f7aae3c 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -60,6 +60,7 @@ import Rahm.Desktop.Layout.Pop (togglePop) import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically) import Rahm.Desktop.Layout.Rotate (rotateLayout) import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward) +import Rahm.Desktop.Layout.ConsistentMosaic type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ()) type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ()) @@ -362,7 +363,7 @@ keymap = runKeys $ do shiftMod $ doc "For mosaic layout, shrink the size-share of the current window" $ - withFocused $ sendMessage . shrinkWindowAlt + sendMessage =<< shrinkPositionAlt bind xK_m $ do justMod $ @@ -389,7 +390,7 @@ keymap = runKeys $ do shiftMod $ doc "For mosaic layout, increase the size-share of the current window." $ - withFocused $ sendMessage . expandWindowAlt + sendMessage =<< expandPositionAlt bind xK_q $ do shiftMod $ -- cgit From c92cd07aaf7c54cd528166fc46dbade8008f5392 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Wed, 13 Apr 2022 18:29:27 -0600 Subject: [WIP] Working on better workspaces --- src/Rahm/Desktop/Keys.hs | 95 +++++++++++++++++++++++++++--------------------- 1 file changed, 53 insertions(+), 42 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index f7aae3c..2f30763 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -61,6 +61,7 @@ import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically) import Rahm.Desktop.Layout.Rotate (rotateLayout) import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward) import Rahm.Desktop.Layout.ConsistentMosaic +import Rahm.Desktop.Workspaces type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ()) type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ()) @@ -264,6 +265,19 @@ keymap = runKeys $ do sendMessage flipHorizontally bind xK_g $ do + let selectWorkspace :: (KeySym, String) -> Maybe (X WorkspaceId) + selectWorkspace s = case s of + (_, [ch]) | isAlphaNum ch -> Just $ return [ch] + (_, "]") -> Just $ adjacentWorkspace next =<< getCurrentWorkspace + (_, "[") -> Just $ adjacentWorkspace prev =<< getCurrentWorkspace + (_, "}") -> Just $ adjacentScreen next + (_, "{") -> Just $ adjacentScreen prev + (_, "/") -> Just $ runMaybeT $ do + windowId <- askWindowId + workspaceWithWindow askWindowId + (_, " ") -> Just $ accompaningWorkspace <$> getCurrentWorkspace + _ -> Nothing + justMod $ doc "Goto a workspace\n\n\t\ @@ -279,35 +293,45 @@ keymap = runKeys $ do \: 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 - + case ((keysym, str), selectWorkspace (keysym, str)) of + (_, Just w) -> pushHistory $ gotoWorkspace =<< w -- Test binding. Tests that I can still submap keysyms alone (keys -- where XLookupString won't return anything helpful.) - (f, _) | f == xK_F1 -> + ((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 + mapNextStringWithKeysym $ \_ keysym str -> + case ((keysym, str), selectWorkspace (keysym, str)) of + (_, Just w) -> shiftToWorkspace =<< w + _ -> return () + + controlMod $ + doc "Move the current focused window to another workspace and view that workspace" $ + mapNextStringWithKeysym $ \_ keysym str -> + case ((keysym, str), selectWorkspace (keysym, str)) of + (_, Just w) -> pushHistory $ do + ws <- w + shiftToWorkspace ws + gotoWorkspace ws + _ -> return () + + altMod $ + doc "Copy a window to the given workspace" $ + mapNextStringWithKeysym $ \_ keysym str -> + case ((keysym, str), selectWorkspace (keysym, str)) of + (_, Just ws) -> windows . CopyWindow.copy =<< ws _ -> return () + shiftAltMod $ doc "Swap this workspace with another workspace (rename)." $ - mapNextString $ \_ str -> - case str of - [ch] | isAlphaNum ch -> swapWorkspace ch + mapNextStringWithKeysym $ \_ keysym str -> + case ((keysym, str), selectWorkspace (keysym, str)) of + (_, Just ws) -> swapWorkspace =<< ws _ -> return () bind xK_h $ do @@ -373,16 +397,6 @@ keymap = runKeys $ do [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." $ @@ -511,14 +525,6 @@ keymap = runKeys $ do 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 @@ -660,10 +666,12 @@ mouseMap = runButtons $ do justMod $ \w -> focus w >> mouseResizeWindow w >> windows W.shiftMaster bind button6 $ - justMod $ noWindow (withRelativeWorkspace prev W.greedyView) + justMod $ + noWindow (viewAdjacent prev) bind button7 $ - justMod $ noWindow (withRelativeWorkspace next W.greedyView) + justMod $ + noWindow (viewAdjacent next) bind button8 $ justMod $ noWindow mediaPrev @@ -675,7 +683,7 @@ mouseMap = runButtons $ do noMod $ subMouse $ do bind button3 $ - noMod $ noWindow (gotoWorkspace 's') + noMod $ noWindow (gotoWorkspace "s") bind button13 $ do noMod $ noWindow $ click >> CopyWindow.kill1 @@ -714,7 +722,10 @@ mouseMap = runButtons $ do bind button15 $ do noMod $ subMouse $ do - bind button13 $ noMod $ noWindow gotoAccompaningWorkspace + bind button13 $ + noMod $ + noWindow $ + gotoWorkspace =<< (accompaningWorkspace <$> getCurrentWorkspace) bind button15 $ do noMod $ noWindow jumpToLast @@ -723,8 +734,8 @@ mouseMap = runButtons $ do let workspaceButtons = [ (button2, swapMaster), - (button9, withRelativeWorkspace next W.greedyView), - (button8, withRelativeWorkspace prev W.greedyView), + (button9, viewAdjacent next), + (button8, viewAdjacent prev), (button4, windows W.focusUp), (button5, windows W.focusDown), -- cgit From 3cc28186cd3ab934e29c4864f7c6b074475906a1 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Thu, 14 Apr 2022 01:24:30 -0600 Subject: Make workspaces more consistent --- src/Rahm/Desktop/Keys.hs | 44 ++++++++++++++++++++++++++++---------------- 1 file changed, 28 insertions(+), 16 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 2f30763..6e16c25 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -5,6 +5,7 @@ import Data.Monoid (Endo(..)) import Control.Monad.Trans.Class import Control.Monad.Reader import Control.Monad.Writer +import Control.Monad.Trans.Maybe import Control.Monad.Loops (iterateWhile) import Control.Monad.Fix (fix) import Graphics.X11.ExtraTypes.XF86; @@ -267,30 +268,38 @@ keymap = runKeys $ do bind xK_g $ do let selectWorkspace :: (KeySym, String) -> Maybe (X WorkspaceId) selectWorkspace s = case s of - (_, [ch]) | isAlphaNum ch -> Just $ return [ch] + (_, [ch]) | isAlphaNum ch || ch == '*' -> Just $ return [ch] (_, "]") -> Just $ adjacentWorkspace next =<< getCurrentWorkspace (_, "[") -> Just $ adjacentWorkspace prev =<< getCurrentWorkspace (_, "}") -> Just $ adjacentScreen next (_, "{") -> Just $ adjacentScreen prev - (_, "/") -> Just $ runMaybeT $ do - windowId <- askWindowId - workspaceWithWindow askWindowId + (_, "^") -> Just firstWorkspaceId + (_, "$") -> Just lastWorkspaceId + (_, "/") -> Just $ do + cur <- getCurrentWorkspace + fromMaybe cur <$> runMaybeT (do + windowId <- MaybeT askWindowId + MaybeT $ workspaceWithWindow windowId) (_, " ") -> Just $ accompaningWorkspace <$> getCurrentWorkspace _ -> Nothing justMod $ - doc "Goto a workspace\n\n\t\ - - \If the second character typed is alpha-numeric, 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\ + doc "Goto/Send/Etc To a workspace\n\n\t\ + + \Workspaces are alphanumeric characters. So if the next key typed is an\n\t\ + \alphanumeric character, that's the workspace to operate on\n\n\ + + \The following special characters can also reference workspaces:\n\t\t\ + \]: The next non-visible workspace\n\t\t\ + \[: The previous non-visible 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\t\t\ \F1: display this help.\n" $ mapNextStringWithKeysym $ \_ keysym str -> case ((keysym, str), selectWorkspace (keysym, str)) of @@ -308,6 +317,7 @@ keymap = runKeys $ do mapNextStringWithKeysym $ \_ keysym str -> case ((keysym, str), selectWorkspace (keysym, str)) of (_, Just w) -> shiftToWorkspace =<< w + ((_, "_"), _) -> CopyWindow.kill1 _ -> return () controlMod $ @@ -332,6 +342,8 @@ keymap = runKeys $ do mapNextStringWithKeysym $ \_ keysym str -> case ((keysym, str), selectWorkspace (keysym, str)) of (_, Just ws) -> swapWorkspace =<< ws + ((_, "_"), _) -> + mapM_ (\w -> focus w >> CopyWindow.kill1) =<< windowsInCurrentWorkspace _ -> return () bind xK_h $ do -- cgit From 0992b3df262c9ac91cc87133bd451ddcd4fcc6ad Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Thu, 14 Apr 2022 12:11:45 -0600 Subject: Minor changes --- src/Rahm/Desktop/Keys.hs | 36 ++++++++++++++++++++++++------------ 1 file changed, 24 insertions(+), 12 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 6e16c25..1bf1b2f 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -269,17 +269,18 @@ keymap = runKeys $ do let selectWorkspace :: (KeySym, String) -> Maybe (X WorkspaceId) selectWorkspace s = case s of (_, [ch]) | isAlphaNum ch || ch == '*' -> Just $ return [ch] - (_, "]") -> Just $ adjacentWorkspace next =<< getCurrentWorkspace - (_, "[") -> Just $ adjacentWorkspace prev =<< getCurrentWorkspace + (_, "]") -> Just $ adjacentWorkspaceNotVisible next + =<< getCurrentWorkspace + (_, "[") -> Just $ adjacentWorkspaceNotVisible prev + =<< getCurrentWorkspace + (_, ")") -> Just $ adjacentWorkspace next =<< getCurrentWorkspace + (_, "(") -> Just $ adjacentWorkspace prev =<< getCurrentWorkspace (_, "}") -> Just $ adjacentScreen next (_, "{") -> Just $ adjacentScreen prev (_, "^") -> Just firstWorkspaceId (_, "$") -> Just lastWorkspaceId - (_, "/") -> Just $ do - cur <- getCurrentWorkspace - fromMaybe cur <$> runMaybeT (do - windowId <- MaybeT askWindowId - MaybeT $ workspaceWithWindow windowId) + (_, "/") -> Just $ fromMaybe <$> getCurrentWorkspace <*> runMaybeT ( + (MaybeT . workspaceWithWindow) =<< MaybeT askWindowId) (_, " ") -> Just $ accompaningWorkspace <$> getCurrentWorkspace _ -> Nothing @@ -289,9 +290,11 @@ keymap = runKeys $ do \Workspaces are alphanumeric characters. So if the next key typed is an\n\t\ \alphanumeric character, that's the workspace to operate on\n\n\ - \The following special characters can also reference workspaces:\n\t\t\ - \]: The next non-visible workspace\n\t\t\ - \[: The previous non-visible workspace\n\t\t\ + \\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\ @@ -299,8 +302,9 @@ keymap = runKeys $ do \^: 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\t\t\ - \F1: display this help.\n" $ + \_: 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" $ mapNextStringWithKeysym $ \_ keysym str -> case ((keysym, str), selectWorkspace (keysym, str)) of (_, Just w) -> pushHistory $ gotoWorkspace =<< w @@ -725,6 +729,14 @@ mouseMap = runButtons $ do bind button2 $ noMod $ windows . W.sink bind button3 $ noMod mouseResizeWindow + let swapButtons = [ + (button6, windows W.swapDown), + (button7, windows W.swapUp) + ] + + forM_ (map fst swapButtons) $ \b -> + bind b $ noMod $ \w -> click >> (continuous swapButtons b) w + bind button13 $ noMod $ subMouse $ do bind button13 $ noMod $ subMouse $ do bind button13 $ noMod $ noWindow $ spawnX "xsecurelock" -- cgit From 643642e5e76fd5278a26f560dca60e5b18ac8933 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Thu, 14 Apr 2022 16:50:03 -0600 Subject: Rename KeysM -> Keys/Dsl --- src/Rahm/Desktop/Keys.hs | 81 +++++++++++++++++++++++++----------------------- 1 file changed, 43 insertions(+), 38 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 1bf1b2f..fec7ce5 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -1,67 +1,66 @@ 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.Trans.Maybe -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 Control.Monad.Fix (fix) +import Control.Monad.Loops (iterateWhile) +import Control.Monad.Reader +import Control.Monad.Trans.Class +import Control.Monad.Trans.Maybe +import Control.Monad.Writer 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 Data.Maybe (isJust, fromMaybe) +import Data.Monoid (Endo(..)) +import Debug.Trace +import Graphics.X11.ExtraTypes.XF86; +import Graphics.X11.ExtraTypes.XorgDefault +import Prelude hiding ((!!)) import System.IO +import System.Process import Text.Printf import XMonad -import Rahm.Desktop.Submap +import XMonad.Actions.CopyWindow as CopyWindow +import XMonad.Actions.RotSlaves +import XMonad.Actions.SpawnOn as SpawnOn import XMonad.Actions.WindowNavigation +import XMonad.Hooks.ManageDocks +import XMonad.Layout.MosaicAlt +import XMonad.Layout.Spacing import XMonad.Prompt import XMonad.Prompt.Input import XMonad.Prompt.Shell import XMonad.Util.CustomKeys +import XMonad.Util.Run (safeSpawn) import XMonad.Util.Scratchpad -import XMonad.Actions.RotSlaves -import XMonad.Actions.CopyWindow as CopyWindow -import XMonad.Actions.SpawnOn as SpawnOn +import XMonad.Util.Ungrab import qualified Data.Map as Map import qualified XMonad.StackSet as W -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.Layout.List ( - toNextLayout, toPreviousLayout, toFirstLayout, toIndexedLayout) +import Rahm.Desktop.Keys.Dsl +import Rahm.Desktop.Layout +import Rahm.Desktop.Layout.ConsistentMosaic +import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically) import Rahm.Desktop.Layout.Hole (toggleHole) +import Rahm.Desktop.Layout.List (toNextLayout, toPreviousLayout, toFirstLayout, toIndexedLayout) import Rahm.Desktop.Layout.Pop (togglePop) -import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically) import Rahm.Desktop.Layout.Rotate (rotateLayout) +import Rahm.Desktop.Lib +import Rahm.Desktop.Logger +import Rahm.Desktop.Marking +import Rahm.Desktop.MouseMotion +import Rahm.Desktop.PassMenu +import Rahm.Desktop.PromptConfig +import Rahm.Desktop.RebindKeys import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward) -import Rahm.Desktop.Layout.ConsistentMosaic +import Rahm.Desktop.Submap +import Rahm.Desktop.Swallow +import Rahm.Desktop.SwapMaster (swapMaster) +import Rahm.Desktop.Windows import Rahm.Desktop.Workspaces type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ()) @@ -851,8 +850,14 @@ windowSpecificBindings config = do rawMask (controlMask .|. shiftMask) $ emitKey (0, xK_Home) bind xK_d $ + rawMask controlMask $ emitKey (controlMask .|. shiftMask, xK_Tab) + + bind xK_Escape $ rawMask controlMask $ emitKey (controlMask, xK_w) + bind xK_i $ do + rawMask controlMask $ emitKey (controlMask, xK_Tab) + bind xK_F2 $ -- Experimental. noMod $ logs "This is a test" -- cgit From a14486b47a51e772a3b230bc82390cb667f2ecd5 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Thu, 14 Apr 2022 23:09:50 -0600 Subject: Some changes to marking --- src/Rahm/Desktop/Keys.hs | 9 +++++++++ 1 file changed, 9 insertions(+) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index fec7ce5..d302b59 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -150,6 +150,15 @@ keymap = runKeys $ do _ -> return () shiftMod $ + doc "Move the marked windo to the current workspace." $ + mapNextString $ \_ str -> + case str of + [ch] | isAlphaNum ch -> do + ws <- getCurrentWorkspace + maybe (return ()) (windows . W.shiftWin ws) =<< markToWindow ch + _ -> return () + + controlMod $ doc "Swap the current window with a mark." $ mapNextString $ \_ str -> case str of -- cgit From 7a5051f7955a8b4e69b2c28b5a9b34f9730e21f0 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Fri, 15 Apr 2022 23:55:35 -0600 Subject: Make history much, much more reliable. This time history is being done using a hook to keep track of history. This means I don't have to manually call pushHistory every time I focus a new window. --- src/Rahm/Desktop/Keys.hs | 39 ++++++++++++++++++++++++++------------- 1 file changed, 26 insertions(+), 13 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index d302b59..ebc8b7f 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -62,6 +62,7 @@ import Rahm.Desktop.Swallow import Rahm.Desktop.SwapMaster (swapMaster) import Rahm.Desktop.Windows import Rahm.Desktop.Workspaces +import Rahm.Desktop.History type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ()) type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ()) @@ -143,10 +144,10 @@ keymap = runKeys $ do doc "Jumps between marks." $ mapNextString $ \_ str -> case str of - ['\''] -> jumpToLast + ['\''] -> jumpToLastLocation [ch] | isAlphaNum ch -> jumpToMark ch - "[" -> historyPrev - "]" -> historyNext + "[" -> historyBack + "]" -> historyForward _ -> return () shiftMod $ @@ -162,7 +163,7 @@ keymap = runKeys $ do doc "Swap the current window with a mark." $ mapNextString $ \_ str -> case str of - ['\''] -> swapWithLastMark + -- ['\''] -> swapWithLastMark [ch] | isAlphaNum ch -> swapWithMark ch _ -> return () @@ -315,7 +316,7 @@ keymap = runKeys $ do \F1: display this help.\n\n\t" $ mapNextStringWithKeysym $ \_ keysym str -> case ((keysym, str), selectWorkspace (keysym, str)) of - (_, Just w) -> pushHistory $ gotoWorkspace =<< w + (_, Just w) -> gotoWorkspace =<< w -- Test binding. Tests that I can still submap keysyms alone (keys -- where XLookupString won't return anything helpful.) ((f, _), _) | f == xK_F1 -> @@ -336,7 +337,7 @@ keymap = runKeys $ do doc "Move the current focused window to another workspace and view that workspace" $ mapNextStringWithKeysym $ \_ keysym str -> case ((keysym, str), selectWorkspace (keysym, str)) of - (_, Just w) -> pushHistory $ do + (_, Just w) -> do ws <- w shiftToWorkspace ws gotoWorkspace ws @@ -377,7 +378,7 @@ keymap = runKeys $ do sendMessage Shrink shiftMod $ - doc "Go to the previous window in history." historyPrev + doc "Go to the previous window in history." historyBack bind xK_k $ do justMod $ @@ -385,7 +386,7 @@ keymap = runKeys $ do sendMessage Expand shiftMod $ - doc "Go to the next window in history." historyNext + doc "Go to the next window in history." historyForward bind xK_l $ do justMod $ @@ -551,7 +552,7 @@ keymap = runKeys $ do bind xK_p $ do (justMod -|- noMod) $ - doc "Go to the prior window in the history" historyPrev + doc "Go to the prior window in the history" historyBack bind xK_t $ do (justMod -|- noMod) $ logs "Test Log" @@ -562,7 +563,7 @@ keymap = runKeys $ do -- spawnX (terminal config ++ " -t Notes -e notes new") bind xK_n $ do (justMod -|- noMod) $ - doc "Go to the next window in the history" historyNext + doc "Go to the next window in the history" historyForward bind xK_c $ do shiftMod $ @@ -606,6 +607,18 @@ keymap = runKeys $ do doc "Set the volume of an application via rofi." $ spawnX "set-volume.sh -a" + let navigateHistory = repeatable $ do + bind xK_bracketright $ do + noMod $ + doc "Move forward in location history" historyForward + + bind xK_bracketleft $ do + noMod $ + doc "Move backward in location history" historyBack + + bind xK_bracketleft $ noMod navigateHistory + bind xK_bracketright $ noMod navigateHistory + -- Double-tap Z to toggle zoom. bind xK_z $ do noMod -|- justMod $ @@ -723,8 +736,8 @@ mouseMap = runButtons $ do (button4, increaseVolume), (button5, decreaseVolume), (button2, playPause), - (button9, historyNext), - (button8, historyPrev), + (button9, historyForward), + (button8, historyBack), (button6, mediaPrev), (button7, mediaNext) ] @@ -760,7 +773,7 @@ mouseMap = runButtons $ do gotoWorkspace =<< (accompaningWorkspace <$> getCurrentWorkspace) bind button15 $ do - noMod $ noWindow jumpToLast + noMod $ noWindow jumpToLastLocation let workspaceButtons = [ -- cgit From d1a00e6e42b4b513f7de66a9e710f62faca2ef00 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Sat, 16 Apr 2022 00:20:03 -0600 Subject: fix some hlint warnings --- src/Rahm/Desktop/Keys.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index ebc8b7f..3e660b5 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -292,7 +292,7 @@ keymap = runKeys $ do (MaybeT . workspaceWithWindow) =<< MaybeT askWindowId) (_, " ") -> Just $ accompaningWorkspace <$> getCurrentWorkspace _ -> Nothing - + justMod $ doc "Goto/Send/Etc To a workspace\n\n\t\ @@ -319,7 +319,7 @@ keymap = runKeys $ do (_, Just w) -> gotoWorkspace =<< w -- Test binding. Tests that I can still submap keysyms alone (keys -- where XLookupString won't return anything helpful.) - ((f, _), _) | f == xK_F1 -> + ((f, _), _) | f == xK_F1 -> (safeSpawn "gxmessage" [ "-fn", "Source Code Pro", documentation (keymap config)] :: X ()) @@ -456,7 +456,7 @@ keymap = runKeys $ do 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." $ sendMessage toNextLayout @@ -616,8 +616,10 @@ keymap = runKeys $ do noMod $ doc "Move backward in location history" historyBack - bind xK_bracketleft $ noMod navigateHistory - bind xK_bracketright $ noMod navigateHistory + bind xK_bracketleft $ noMod $ + doc "Move forward in location history" navigateHistory + bind xK_bracketright $ noMod $ + doc "Move backward in location history" navigateHistory -- Double-tap Z to toggle zoom. bind xK_z $ do @@ -756,7 +758,7 @@ mouseMap = runButtons $ do ] forM_ (map fst swapButtons) $ \b -> - bind b $ noMod $ \w -> click >> (continuous swapButtons b) w + bind b $ noMod $ \w -> click >> continuous swapButtons b w bind button13 $ noMod $ subMouse $ do bind button13 $ noMod $ subMouse $ do @@ -770,7 +772,7 @@ mouseMap = runButtons $ do bind button13 $ noMod $ noWindow $ - gotoWorkspace =<< (accompaningWorkspace <$> getCurrentWorkspace) + gotoWorkspace . accompaningWorkspace =<< getCurrentWorkspace bind button15 $ do noMod $ noWindow jumpToLastLocation -- cgit From e7d0c65ef807cf6d595273a764ec95d17c8708b5 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Sat, 16 Apr 2022 11:33:57 -0600 Subject: Switch Ctrl-i and Ctrl-d for chrome bindings --- src/Rahm/Desktop/Keys.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index d302b59..6912473 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -859,13 +859,13 @@ windowSpecificBindings config = do rawMask (controlMask .|. shiftMask) $ emitKey (0, xK_Home) bind xK_d $ - rawMask controlMask $ emitKey (controlMask .|. shiftMask, xK_Tab) + rawMask controlMask $ emitKey (controlMask, xK_Tab) bind xK_Escape $ rawMask controlMask $ emitKey (controlMask, xK_w) bind xK_i $ do - rawMask controlMask $ emitKey (controlMask, xK_Tab) + rawMask controlMask $ emitKey (controlMask .|. shiftMask, xK_Tab) bind xK_F2 $ -- Experimental. -- cgit From 9dc562c177fef4ad3b25bfac348c21a6c57839f5 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Sun, 17 Apr 2022 23:15:55 -0600 Subject: Starting to implement window management language --- src/Rahm/Desktop/Keys.hs | 70 ++++++++++++++++-------------------------------- 1 file changed, 23 insertions(+), 47 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 74960df..1369a17 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -6,7 +6,6 @@ import Control.Monad.Fix (fix) import Control.Monad.Loops (iterateWhile) import Control.Monad.Reader import Control.Monad.Trans.Class -import Control.Monad.Trans.Maybe import Control.Monad.Writer import Data.Char import Data.List hiding ((!!)) @@ -49,7 +48,7 @@ import Rahm.Desktop.Layout.Hole (toggleHole) import Rahm.Desktop.Layout.List (toNextLayout, toPreviousLayout, toFirstLayout, toIndexedLayout) import Rahm.Desktop.Layout.Pop (togglePop) import Rahm.Desktop.Layout.Rotate (rotateLayout) -import Rahm.Desktop.Lib +import Rahm.Desktop.Common import Rahm.Desktop.Logger import Rahm.Desktop.Marking import Rahm.Desktop.MouseMotion @@ -142,30 +141,13 @@ keymap = runKeys $ do bind xK_apostrophe $ do justMod $ doc "Jumps between marks." $ - mapNextString $ \_ str -> - case str of - ['\''] -> jumpToLastLocation - [ch] | isAlphaNum ch -> jumpToMark ch - "[" -> historyBack - "]" -> historyForward - _ -> return () + mapNextString $ const (mapM_ focusLocation <=< markToLocation) shiftMod $ - doc "Move the marked windo to the current workspace." $ - mapNextString $ \_ str -> - case str of - [ch] | isAlphaNum ch -> do - ws <- getCurrentWorkspace - maybe (return ()) (windows . W.shiftWin ws) =<< markToWindow ch - _ -> return () - - controlMod $ - doc "Swap the current window with a mark." $ - mapNextString $ \_ str -> - case str of - -- ['\''] -> swapWithLastMark - [ch] | isAlphaNum ch -> swapWithMark ch - _ -> return () + doc "Move the marked window to the current workspace." $ + mapNextString $ \_ str -> do + mapM_ (\loc -> moveLocationToWorkspace loc <$> getCurrentWorkspace) + =<< markToLocation str bind xK_BackSpace $ do -- The only raw keybinding. Meant to get a terminal to unbrick XMonad if @@ -275,23 +257,6 @@ keymap = runKeys $ do sendMessage flipHorizontally bind xK_g $ do - let selectWorkspace :: (KeySym, String) -> Maybe (X WorkspaceId) - selectWorkspace s = case s of - (_, [ch]) | isAlphaNum ch || ch == '*' -> Just $ return [ch] - (_, "]") -> Just $ adjacentWorkspaceNotVisible next - =<< getCurrentWorkspace - (_, "[") -> Just $ adjacentWorkspaceNotVisible prev - =<< getCurrentWorkspace - (_, ")") -> Just $ adjacentWorkspace next =<< getCurrentWorkspace - (_, "(") -> Just $ adjacentWorkspace prev =<< getCurrentWorkspace - (_, "}") -> Just $ adjacentScreen next - (_, "{") -> Just $ adjacentScreen prev - (_, "^") -> Just firstWorkspaceId - (_, "$") -> Just lastWorkspaceId - (_, "/") -> Just $ fromMaybe <$> getCurrentWorkspace <*> runMaybeT ( - (MaybeT . workspaceWithWindow) =<< MaybeT askWindowId) - (_, " ") -> Just $ accompaningWorkspace <$> getCurrentWorkspace - _ -> Nothing justMod $ doc "Goto/Send/Etc To a workspace\n\n\t\ @@ -315,7 +280,7 @@ keymap = runKeys $ do \Other keybindings starting with H-g\n\t\t\ \F1: display this help.\n\n\t" $ mapNextStringWithKeysym $ \_ keysym str -> - case ((keysym, str), selectWorkspace (keysym, str)) of + case ((keysym, str), selectWorkspace str) of (_, Just w) -> gotoWorkspace =<< w -- Test binding. Tests that I can still submap keysyms alone (keys -- where XLookupString won't return anything helpful.) @@ -328,7 +293,7 @@ keymap = runKeys $ do shiftMod $ doc "Move the currently focused window to another workspace" $ mapNextStringWithKeysym $ \_ keysym str -> - case ((keysym, str), selectWorkspace (keysym, str)) of + case ((keysym, str), selectWorkspace str) of (_, Just w) -> shiftToWorkspace =<< w ((_, "_"), _) -> CopyWindow.kill1 _ -> return () @@ -336,7 +301,7 @@ keymap = runKeys $ do controlMod $ doc "Move the current focused window to another workspace and view that workspace" $ mapNextStringWithKeysym $ \_ keysym str -> - case ((keysym, str), selectWorkspace (keysym, str)) of + case ((keysym, str), selectWorkspace str) of (_, Just w) -> do ws <- w shiftToWorkspace ws @@ -346,14 +311,14 @@ keymap = runKeys $ do altMod $ doc "Copy a window to the given workspace" $ mapNextStringWithKeysym $ \_ keysym str -> - case ((keysym, str), selectWorkspace (keysym, str)) of + case ((keysym, str), selectWorkspace str) of (_, Just ws) -> windows . CopyWindow.copy =<< ws _ -> return () shiftAltMod $ doc "Swap this workspace with another workspace (rename)." $ mapNextStringWithKeysym $ \_ keysym str -> - case ((keysym, str), selectWorkspace (keysym, str)) of + case ((keysym, str), selectWorkspace str) of (_, Just ws) -> swapWorkspace =<< ws ((_, "_"), _) -> mapM_ (\w -> focus w >> CopyWindow.kill1) =<< windowsInCurrentWorkspace @@ -419,7 +384,7 @@ keymap = runKeys $ do doc "Mark the current window with the next typed character." $ mapNextString $ \_ str -> case str of - [ch] | isAlphaNum ch -> markCurrentWindow ch + [ch] | isAlpha ch -> markCurrentWindow str _ -> return () bind xK_plus $ do @@ -452,6 +417,17 @@ keymap = runKeys $ do sendMessage rotateLayout bind xK_s $ do + justMod $ + mapNextString $ \_ mark -> do + loc' <- markToLocation mark + case loc' of + Nothing -> return () + Just loc -> do + mapM_ setAlternateWindow (locationWindow loc) + mapNextString $ \_ ws -> do + mapM_ (moveLocationToWorkspace loc=<<) (selectWorkspace ws) + + altMod $ spawnX "sudo -A systemctl suspend && xsecurelock" bind xK_space $ do -- cgit From dac3bec93f90b58d1bf97e81d992651b1cf83458 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Mon, 18 Apr 2022 01:31:22 -0600 Subject: Add basic language for moving windows around --- src/Rahm/Desktop/Keys.hs | 88 ++++++++++++++++++------------------------------ 1 file changed, 32 insertions(+), 56 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 1369a17..23927ef 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -1,5 +1,6 @@ module Rahm.Desktop.Keys (applyKeys) where +import Control.Monad.Trans.Maybe import Control.Applicative import Control.Monad import Control.Monad.Fix (fix) @@ -11,7 +12,7 @@ import Data.Char import Data.List hiding ((!!)) import Data.List.Safe ((!!)) import Data.Map (Map) -import Data.Maybe (isJust, fromMaybe) +import Data.Maybe (isJust, fromMaybe, mapMaybe) import Data.Monoid (Endo(..)) import Debug.Trace import Graphics.X11.ExtraTypes.XF86; @@ -51,6 +52,7 @@ import Rahm.Desktop.Layout.Rotate (rotateLayout) import Rahm.Desktop.Common import Rahm.Desktop.Logger import Rahm.Desktop.Marking +import Rahm.Desktop.Lang import Rahm.Desktop.MouseMotion import Rahm.Desktop.PassMenu import Rahm.Desktop.PromptConfig @@ -141,13 +143,11 @@ keymap = runKeys $ do bind xK_apostrophe $ do justMod $ doc "Jumps between marks." $ - mapNextString $ const (mapM_ focusLocation <=< markToLocation) - - shiftMod $ - doc "Move the marked window to the current workspace." $ - mapNextString $ \_ str -> do - mapM_ (\loc -> moveLocationToWorkspace loc <$> getCurrentWorkspace) - =<< markToLocation str + runMaybeT_ $ do + l <- readNextLocationSet + case l of + (h:_) -> lift (focusLocation h) + _ -> return () bind xK_BackSpace $ do -- The only raw keybinding. Meant to get a terminal to unbrick XMonad if @@ -279,50 +279,23 @@ keymap = runKeys $ do \_: 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" $ - mapNextStringWithKeysym $ \_ keysym str -> - case ((keysym, str), selectWorkspace str) of - (_, Just w) -> gotoWorkspace =<< w - -- 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 () + runMaybeT_ $ (lift . gotoWorkspaceFn) =<< readNextWorkspace shiftMod $ doc "Move the currently focused window to another workspace" $ - mapNextStringWithKeysym $ \_ keysym str -> - case ((keysym, str), selectWorkspace str) of - (_, Just w) -> shiftToWorkspace =<< w - ((_, "_"), _) -> CopyWindow.kill1 - _ -> return () + runMaybeT_ $ do + ws <- readNextWorkspace + loc <- lift getCurrentLocation + lift $ moveLocationToWorkspaceFn ws loc controlMod $ doc "Move the current focused window to another workspace and view that workspace" $ - mapNextStringWithKeysym $ \_ keysym str -> - case ((keysym, str), selectWorkspace str) of - (_, Just w) -> do - ws <- w - shiftToWorkspace ws - gotoWorkspace ws - _ -> return () - - altMod $ - doc "Copy a window to the given workspace" $ - mapNextStringWithKeysym $ \_ keysym str -> - case ((keysym, str), selectWorkspace str) of - (_, Just ws) -> windows . CopyWindow.copy =<< ws - _ -> return () - - shiftAltMod $ - doc "Swap this workspace with another workspace (rename)." $ - mapNextStringWithKeysym $ \_ keysym str -> - case ((keysym, str), selectWorkspace str) of - (_, Just ws) -> swapWorkspace =<< ws - ((_, "_"), _) -> - mapM_ (\w -> focus w >> CopyWindow.kill1) =<< windowsInCurrentWorkspace - _ -> return () + runMaybeT_ $ do + ws <- readNextWorkspace + loc <- lift getCurrentLocation + lift $ do + moveLocationToWorkspaceFn ws loc + gotoWorkspaceFn ws bind xK_h $ do justMod $ @@ -382,7 +355,7 @@ keymap = runKeys $ do bind xK_m $ do justMod $ doc "Mark the current window with the next typed character." $ - mapNextString $ \_ str -> + runMaybeT_ $ mapNextString $ \_ str -> lift $ case str of [ch] | isAlpha ch -> markCurrentWindow str _ -> return () @@ -417,16 +390,19 @@ keymap = runKeys $ do sendMessage rotateLayout bind xK_s $ do - justMod $ - mapNextString $ \_ mark -> do - loc' <- markToLocation mark - case loc' of - Nothing -> return () - Just loc -> do - mapM_ setAlternateWindow (locationWindow loc) - mapNextString $ \_ ws -> do - mapM_ (moveLocationToWorkspace loc=<<) (selectWorkspace ws) + justMod $ runMaybeT_ $ do + locations <- readNextLocationSet + + workspace <- readNextWorkspace + mapM_ (lift . moveLocationToWorkspaceFn workspace) locations + lift $ setAlternateWindows (mapMaybe locationWindow locations) + forM_ locations $ \loc -> + case locationWindow loc of + Nothing -> return () + Just win -> do + lift $ logs $ printf "setAlternate %s %s" (show win) (show $ locationWorkspace loc) + lift $ setAlternateWorkspace win (locationWorkspace loc) altMod $ spawnX "sudo -A systemctl suspend && xsecurelock" -- cgit From 8b6c4a54f79b35ba153acf6dd6b6f1804237c545 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Mon, 18 Apr 2022 10:11:05 -0600 Subject: Extend marking language to the mark command itself --- src/Rahm/Desktop/Keys.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 23927ef..da3b695 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -355,10 +355,11 @@ keymap = runKeys $ do bind xK_m $ do justMod $ doc "Mark the current window with the next typed character." $ - runMaybeT_ $ mapNextString $ \_ str -> lift $ + runMaybeT_ $ do + locs <- readNextLocationSet + mapNextString $ \_ str -> lift $ case str of - [ch] | isAlpha ch -> markCurrentWindow str - _ -> return () + [ch] | isAlpha ch -> markAllLocations str locs bind xK_plus $ do justMod $ -- cgit From 75886bd10e782425179f244d0a650d9861bc2843 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Mon, 18 Apr 2022 16:38:05 -0600 Subject: Rename Lang to WindowManagementLanguage (Moved to Wml.hs). Add more features to it. --- src/Rahm/Desktop/Keys.hs | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index da3b695..6973b81 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -52,7 +52,7 @@ import Rahm.Desktop.Layout.Rotate (rotateLayout) import Rahm.Desktop.Common import Rahm.Desktop.Logger import Rahm.Desktop.Marking -import Rahm.Desktop.Lang +import Rahm.Desktop.Keys.Wml import Rahm.Desktop.MouseMotion import Rahm.Desktop.PassMenu import Rahm.Desktop.PromptConfig @@ -140,7 +140,7 @@ keymap = runKeys $ do let subkeys keysM = Submap (runKeys keysM config) repeatable keysM = Repeat (runKeys keysM config) - bind xK_apostrophe $ do + forM_ [xK_apostrophe, xK_w] $ \k -> bind k $ do justMod $ doc "Jumps between marks." $ runMaybeT_ $ do @@ -189,8 +189,9 @@ keymap = runKeys $ do bind xK_F8 $ justMod $ - doc "Print this documentation." $ - sendMessage toggleHole + doc "Experimental" $ do + (logs . printf "WS: %s" . show . fmap workspaceName) =<< workspaceForString ",^" + (logs . printf "Wins: %s" . show) =<< locationSetForString "&s@,^" bind xK_F10 $ do justMod playPauseDoc @@ -489,9 +490,6 @@ keymap = runKeys $ do 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." $ -- cgit From 25958a8363691a86a60667ca4f92b65247c51d89 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Mon, 18 Apr 2022 20:47:07 -0600 Subject: Change window border when selecting windows --- src/Rahm/Desktop/Keys.hs | 29 ++++++++++++++++------------- 1 file changed, 16 insertions(+), 13 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 6973b81..69873e4 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -32,6 +32,7 @@ import XMonad.Layout.Spacing import XMonad.Prompt import XMonad.Prompt.Input import XMonad.Prompt.Shell +import XMonad.Util.XUtils import XMonad.Util.CustomKeys import XMonad.Util.Run (safeSpawn) import XMonad.Util.Scratchpad @@ -392,19 +393,21 @@ keymap = runKeys $ do sendMessage rotateLayout bind xK_s $ do - justMod $ runMaybeT_ $ do - locations <- readNextLocationSet - - workspace <- readNextWorkspace - mapM_ (lift . moveLocationToWorkspaceFn workspace) locations - - lift $ setAlternateWindows (mapMaybe locationWindow locations) - forM_ locations $ \loc -> - case locationWindow loc of - Nothing -> return () - Just win -> do - lift $ logs $ printf "setAlternate %s %s" (show win) (show $ locationWorkspace loc) - lift $ setAlternateWorkspace win (locationWorkspace loc) + justMod $ do + locations <- fromMaybe [] <$> runMaybeT readNextLocationSet + let locationWindows = mapMaybe locationWindow locations + + withBorderColor "#00ffff" locationWindows $ do + runMaybeT_ $ do + workspace <- readNextWorkspace + mapM_ (lift . moveLocationToWorkspaceFn workspace) locations + + lift $ setAlternateWindows locationWindows + forM_ locations $ \loc -> + case locationWindow loc of + Nothing -> return () + Just win -> do + lift $ setAlternateWorkspace win (locationWorkspace loc) altMod $ spawnX "sudo -A systemctl suspend && xsecurelock" -- cgit From 41b4bf01d61a0d42d27145700e41318715b37e1f Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Mon, 18 Apr 2022 23:00:26 -0600 Subject: Highlight windows for marking too --- src/Rahm/Desktop/Keys.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 69873e4..9ae9c30 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -354,14 +354,16 @@ keymap = runKeys $ do doc "For mosaic layout, shrink the size-share of the current window" $ sendMessage =<< shrinkPositionAlt - bind xK_m $ do + bind xK_m $ justMod $ - doc "Mark the current window with the next typed character." $ - runMaybeT_ $ do - locs <- readNextLocationSet - mapNextString $ \_ str -> lift $ - case str of - [ch] | isAlpha ch -> markAllLocations str locs + doc "Mark the current window with the next typed character." $ do + locs <- fromMaybe [] <$> runMaybeT readNextLocationSet + withBorderColor "#00ffff" (mapMaybe locationWindow locs) $ do + runMaybeT_ $ do + mapNextString $ \_ str -> lift $ + case str of + [ch] | isAlpha ch -> markAllLocations str locs + _ -> return () bind xK_plus $ do justMod $ -- cgit From 6bfec2037120cd5e3dbd46f7f911fbfb9b718daf Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Wed, 20 Apr 2022 00:56:29 -0600 Subject: Add macro support to WML. Macros may be defined by using w begins defining a windowset macro t begins defining a workspace macro The next character typed is the key chord to save the macro to. The next sequence of keys read up until the Return key is the macro value. This macro may then be used as WML objects. Macros are pretty primitive right now. I need to think about if it would be worthwhile to make these macros either take arguments or add some kind of state to WML a la sed to take a step to make the language Turing complete, and if such a development would actually be desirable. If anything it would be an academic exercise. --- src/Rahm/Desktop/Keys.hs | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 9ae9c30..a453df1 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -187,13 +187,6 @@ keymap = runKeys $ do doc "Print this documentation." $ logs (documentation (keymap config)) - bind xK_F8 $ - - justMod $ - doc "Experimental" $ do - (logs . printf "WS: %s" . show . fmap workspaceName) =<< workspaceForString ",^" - (logs . printf "Wins: %s" . show) =<< locationSetForString "&s@,^" - bind xK_F10 $ do justMod playPauseDoc @@ -299,6 +292,18 @@ keymap = runKeys $ do moveLocationToWorkspaceFn ws loc gotoWorkspaceFn ws + bind xK_d $ + justMod $ + doc "Record (define) macros." $ + subkeys $ do + bind xK_w $ noMod $ + doc "Record a windowset macro" $ + runMaybeT_ readWindowsetMacro + + bind xK_t $ noMod $ + doc "Record a workspace macro" $ + runMaybeT_ readWorkspaceMacro + bind xK_h $ do justMod $ doc "Focus on the next window down in the stack" $ -- cgit From fd7831aba6f1698883906258a0a1966880427d94 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Fri, 22 Apr 2022 00:27:36 -0600 Subject: Infrastructure for better logging, finally! Right now all existing logs are logged at Info, but this will change. This should make it significantly easier to debug things wit log levels like Trace. I may at some point define more log level endpoints or come up with a more expressive logging system, but this is a good start. --- src/Rahm/Desktop/Keys.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index a453df1..c8abbf0 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -172,7 +172,7 @@ keymap = runKeys $ do -- 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 + logs Info "Try send to %s" (show w) sendKey (0, xK_a) w justMod $ @@ -185,7 +185,7 @@ keymap = runKeys $ do justMod $ doc "Print this documentation." $ - logs (documentation (keymap config)) + (logs Info "%s" (documentation (keymap config)) :: X ()) bind xK_F10 $ do justMod playPauseDoc @@ -221,7 +221,7 @@ keymap = runKeys $ do withScreen W.shift idx altgrMod $ - logs "Test altgr" + (logs Info "Test altgr" :: X ()) bind xK_bracketright $ do justMod $ @@ -391,7 +391,7 @@ keymap = runKeys $ do bind xK_q $ (justMod -|- noMod) $ doc "EXPERIMENTAL: Move mouse to control media." $ - mouseRotateMotion (logs "CW") (logs "CCW") + mouseRotateMotion (logs Info "CW") (logs Info "CCW") bind xK_r $ do justMod $ doc "Run a command via Rofi" runDMenu @@ -516,7 +516,7 @@ keymap = runKeys $ do doc "Go to the prior window in the history" historyBack bind xK_t $ do - (justMod -|- noMod) $ logs "Test Log" + (justMod -|- noMod) $ (logs Info "Test Log" :: X ()) -- bind xK_n $ do -- (justMod -|- noMod) $ @@ -845,7 +845,7 @@ windowSpecificBindings config = do bind xK_F2 $ -- Experimental. - noMod $ logs "This is a test" + noMod $ (logs Info "This is a test" :: X ()) -- Add a binding to xev as a test. configureIf (title =? "Event Tester") $ @@ -878,9 +878,9 @@ windowBindings xconfig = map <- execWriterT $ windowSpecificBindings xconfig w <- ask - liftX $ logs $ printf "For Window: %s" (show w) + liftX $ logs Info "For Window: %s" (show w) forM_ (Map.toList map) $ \(key, action) -> do - liftX $ logs $ printf " -- remap: %s" (show key) + liftX $ logs Info " -- remap: %s" (show key) remapKey key action applyKeys :: XConfig l -> IO (XConfig l) -- cgit From 7dfbd2e4bc893f7527f9cc4ebf9c474ddfb0dc65 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Fri, 22 Apr 2022 16:22:30 -0600 Subject: Some new styling and better logging capabilites --- src/Rahm/Desktop/Keys.hs | 14 ++++++++++++++ 1 file changed, 14 insertions(+) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index c8abbf0..d0305b3 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -73,6 +73,9 @@ 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 @@ -600,6 +603,17 @@ keymap = runKeys $ do doc "Toggle zoom on the current window." $ sendMessage togglePop + bind xK_F8 $ do + justMod $ 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" -- cgit From 32a394483e5d8f571b27a70f9a7156cae1ed6180 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Fri, 22 Apr 2022 18:03:27 -0600 Subject: Run hlint --- src/Rahm/Desktop/Keys.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index d0305b3..728db52 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -187,7 +187,7 @@ keymap = runKeys $ do bind xK_F7 $ justMod $ - doc "Print this documentation." $ + doc "Print this documentation." (logs Info "%s" (documentation (keymap config)) :: X ()) bind xK_F10 $ do @@ -223,7 +223,7 @@ keymap = runKeys $ do doc ("Move the current window to screne " ++ show idx) $ withScreen W.shift idx - altgrMod $ + altgrMod (logs Info "Test altgr" :: X ()) bind xK_bracketright $ do @@ -519,7 +519,7 @@ keymap = runKeys $ do doc "Go to the prior window in the history" historyBack bind xK_t $ do - (justMod -|- noMod) $ (logs Info "Test Log" :: X ()) + (justMod -|- noMod) (logs Info "Test Log" :: X ()) -- bind xK_n $ do -- (justMod -|- noMod) $ @@ -612,7 +612,7 @@ keymap = runKeys $ do ["-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" @@ -859,7 +859,7 @@ windowSpecificBindings config = do bind xK_F2 $ -- Experimental. - noMod $ (logs Info "This is a test" :: X ()) + noMod (logs Info "This is a test" :: X ()) -- Add a binding to xev as a test. configureIf (title =? "Event Tester") $ -- cgit From 72414e1732064079719b1f1021dc4badce654903 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Sun, 24 Apr 2022 20:34:51 -0600 Subject: Add R.D.StackSet as a replacement for StackSet. --- src/Rahm/Desktop/Keys.hs | 51 ++++++++++++++++++++++++++++-------------------- 1 file changed, 30 insertions(+), 21 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 728db52..a8b05a4 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -37,9 +37,9 @@ import XMonad.Util.CustomKeys import XMonad.Util.Run (safeSpawn) import XMonad.Util.Scratchpad import XMonad.Util.Ungrab +import Prettyprinter import qualified Data.Map as Map -import qualified XMonad.StackSet as W import Rahm.Desktop.DMenu import Rahm.Desktop.Keys.Dsl @@ -64,6 +64,7 @@ import Rahm.Desktop.Swallow import Rahm.Desktop.SwapMaster (swapMaster) import Rahm.Desktop.Windows import Rahm.Desktop.Workspaces +import qualified Rahm.Desktop.StackSet as W import Rahm.Desktop.History type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ()) @@ -280,11 +281,11 @@ keymap = runKeys $ do runMaybeT_ $ (lift . gotoWorkspaceFn) =<< readNextWorkspace shiftMod $ - doc "Move the currently focused window to another workspace" $ + doc "Swap a workspace with another workspace." $ runMaybeT_ $ do - ws <- readNextWorkspace - loc <- lift getCurrentLocation - lift $ moveLocationToWorkspaceFn ws loc + ws1 <- readNextWorkspace + ws2 <- readNextWorkspace + lift $ windows $ W.swapWorkspaces (workspaceName ws1) (workspaceName ws2) controlMod $ doc "Move the current focused window to another workspace and view that workspace" $ @@ -366,12 +367,14 @@ keymap = runKeys $ do justMod $ doc "Mark the current window with the next typed character." $ do locs <- fromMaybe [] <$> runMaybeT readNextLocationSet - withBorderColor "#00ffff" (mapMaybe locationWindow locs) $ do - runMaybeT_ $ do - mapNextString $ \_ str -> lift $ - case str of - [ch] | isAlpha ch -> markAllLocations str locs - _ -> return () + let wins = mapMaybe locationWindow locs + withBorderWidth 4 wins $ + withBorderColor "#00ffff" wins $ do + runMaybeT_ $ do + mapNextString $ \_ str -> lift $ + case str of + [ch] | isAlpha ch -> markAllLocations str locs + _ -> return () bind xK_plus $ do justMod $ @@ -407,17 +410,18 @@ keymap = runKeys $ do locations <- fromMaybe [] <$> runMaybeT readNextLocationSet let locationWindows = mapMaybe locationWindow locations - withBorderColor "#00ffff" locationWindows $ do - runMaybeT_ $ do - workspace <- readNextWorkspace - mapM_ (lift . moveLocationToWorkspaceFn workspace) locations + withBorderWidth 4 locationWindows $ + withBorderColor "#00ffff" locationWindows $ do + runMaybeT_ $ do + workspace <- readNextWorkspace + mapM_ (lift . moveLocationToWorkspaceFn workspace) locations - lift $ setAlternateWindows locationWindows - forM_ locations $ \loc -> - case locationWindow loc of - Nothing -> return () - Just win -> do - lift $ setAlternateWorkspace win (locationWorkspace loc) + lift $ setAlternateWindows locationWindows + forM_ locations $ \loc -> + case locationWindow loc of + Nothing -> return () + Just win -> do + lift $ setAlternateWorkspace win (locationWorkspace loc) altMod $ spawnX "sudo -A systemctl suspend && xsecurelock" @@ -613,6 +617,11 @@ keymap = runKeys $ do setLogLevel next logs next "LogLevel set to %s." (show next) + shiftMod $ do + ss <- withWindowSet return + logs Info "Current Stack Set:%s" + (show $ viaShow $ W.mapLayout (const ()) ss) + bind xF86XK_Calculator $ do noMod $ spawnX $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3" -- cgit From 1ff9a98f85df0c3df4e3f1c3f332100922d18317 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Sun, 24 Apr 2022 20:47:40 -0600 Subject: Roll ScreenRotate into StackSet --- src/Rahm/Desktop/Keys.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index a8b05a4..0f61018 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -58,7 +58,6 @@ import Rahm.Desktop.MouseMotion import Rahm.Desktop.PassMenu import Rahm.Desktop.PromptConfig import Rahm.Desktop.RebindKeys -import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward) import Rahm.Desktop.Submap import Rahm.Desktop.Swallow import Rahm.Desktop.SwapMaster (swapMaster) @@ -771,8 +770,8 @@ mouseMap = runButtons $ do (button4, windows W.focusUp), (button5, windows W.focusDown), - (button7, windows screenRotateForward), - (button6, windows screenRotateBackward) + (button7, windows W.screenRotateForward), + (button6, windows W.screenRotateBackward) ] forM_ (map fst workspaceButtons) $ \b -> -- cgit From 07252ce0461d8746481881dbcc6ca07b71fd8553 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Sun, 24 Apr 2022 21:06:10 -0600 Subject: Roll Windows.hs into R.D.StackSet --- src/Rahm/Desktop/Keys.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 0f61018..8cb2b76 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -61,7 +61,6 @@ import Rahm.Desktop.RebindKeys import Rahm.Desktop.Submap import Rahm.Desktop.Swallow import Rahm.Desktop.SwapMaster (swapMaster) -import Rahm.Desktop.Windows import Rahm.Desktop.Workspaces import qualified Rahm.Desktop.StackSet as W import Rahm.Desktop.History @@ -174,9 +173,9 @@ keymap = runKeys $ do -- 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 + shiftMod $ withWindowSet $ mapM_ (\w -> do logs Info "Try send to %s" (show w) - sendKey (0, xK_a) w + sendKey (0, xK_a) w) . W.allWindows justMod $ doc "Print this documentation" @@ -888,7 +887,7 @@ windowBindings :: XConfig l -> XConfig l windowBindings xconfig = xconfig { startupHook = do - forAllWindows (runQuery doQuery) + withWindowSet $ mapM_ (runQuery doQuery) . W.allWindows startupHook xconfig, manageHook = (doQuery >> return (Endo id)) <> manageHook xconfig -- cgit From 9b60476c272d5a9dd8cce4b811c2da6ee4a203aa Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Sun, 24 Apr 2022 21:37:30 -0600 Subject: Add M-S-s to swap windows with eachother --- src/Rahm/Desktop/Keys.hs | 44 ++++++++++++++++++++++++++++---------------- 1 file changed, 28 insertions(+), 16 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 8cb2b76..50b7104 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -404,22 +404,34 @@ keymap = runKeys $ do sendMessage rotateLayout bind xK_s $ do - justMod $ do - locations <- fromMaybe [] <$> runMaybeT readNextLocationSet - let locationWindows = mapMaybe locationWindow locations - - withBorderWidth 4 locationWindows $ - withBorderColor "#00ffff" locationWindows $ do - runMaybeT_ $ do - workspace <- readNextWorkspace - mapM_ (lift . moveLocationToWorkspaceFn workspace) locations - - lift $ setAlternateWindows locationWindows - forM_ locations $ \loc -> - case locationWindow loc of - Nothing -> return () - Just win -> do - lift $ setAlternateWorkspace win (locationWorkspace loc) + forM_ [(False, justMod), (True, shiftMod)] $ \(doSwap, f) -> + f $ + doc (if doSwap + then "Swap a windowset with another windowset." + else "Shift a windowset to a workspace") $ do + locations <- fromMaybe [] <$> runMaybeT readNextLocationSet + let locationWindows = mapMaybe locationWindow locations + + withBorderWidth 4 locationWindows $ + withBorderColor "#00ffff" locationWindows $ do + runMaybeT_ $ do + if doSwap + then do + otherWindows <- + lift $ mapMaybe locationWindow . fromMaybe [] <$> + runMaybeT readNextLocationSet + lift $ windows $ + W.swapWindows (zip locationWindows otherWindows) + else do + workspace <- readNextWorkspace + mapM_ (lift . moveLocationToWorkspaceFn workspace) locations + + lift $ setAlternateWindows locationWindows + forM_ locations $ \loc -> + case locationWindow loc of + Nothing -> return () + Just win -> do + lift $ setAlternateWorkspace win (locationWorkspace loc) altMod $ spawnX "sudo -A systemctl suspend && xsecurelock" -- cgit From fcea6ce1371de988deb2dd719263cb2c9c59dfd7 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Thu, 28 Apr 2022 18:15:34 -0600 Subject: Add Bordering layout. The bordering layout can add windows along the border of the screen, that way something like videos or something can be shown in the corner of the screen. --- src/Rahm/Desktop/Keys.hs | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 50b7104..26021bb 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -14,6 +14,7 @@ import Data.List.Safe ((!!)) import Data.Map (Map) import Data.Maybe (isJust, fromMaybe, mapMaybe) import Data.Monoid (Endo(..)) +import Data.Proxy import Debug.Trace import Graphics.X11.ExtraTypes.XF86; import Graphics.X11.ExtraTypes.XorgDefault @@ -44,6 +45,7 @@ import qualified Data.Map as Map import Rahm.Desktop.DMenu import Rahm.Desktop.Keys.Dsl import Rahm.Desktop.Layout +import Rahm.Desktop.Layout.Bordering import Rahm.Desktop.Layout.ConsistentMosaic import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically) import Rahm.Desktop.Layout.Hole (toggleHole) @@ -294,6 +296,44 @@ keymap = runKeys $ do moveLocationToWorkspaceFn ws loc gotoWorkspaceFn ws + bind xK_n $ do + justMod $ + doc "Banish the current window to the border" $ + withFocused $ sendMessage . toggleBanish + + shiftMod $ + doc "Rotate border windows" $ repeatable $ do + + bind xK_h $ do + + (justMod -|- noMod) $ + withFocused $ sendMessage . moveForward + + shiftMod $ + sendMessage (rotateBorderForward (Proxy :: Proxy Window)) + + bind xK_l $ do + + (justMod -|- noMod) $ + withFocused $ sendMessage . moveBackward + + shiftMod $ + sendMessage (rotateBorderBackward (Proxy :: Proxy Window)) + + bind xK_plus $ do + + (justMod -|- noMod) $ + sendMessage $ + changeWidth Proxy (1/24) <> + changeHeight (Proxy :: Proxy Window) (1/24) + + bind xK_minus $ do + + (justMod -|- noMod) $ + sendMessage $ + changeWidth Proxy (-1/24) <> + changeHeight (Proxy :: Proxy Window) (-1/24) + bind xK_d $ justMod $ doc "Record (define) macros." $ -- cgit From 13f2c99387be8217fd48a252057957f6bf6ac230 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Sun, 1 May 2022 15:49:35 -0600 Subject: Change WML workspaces to have a Maybe name. --- src/Rahm/Desktop/Keys.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 26021bb..ab72645 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -282,10 +282,9 @@ keymap = runKeys $ do shiftMod $ doc "Swap a workspace with another workspace." $ - runMaybeT_ $ do - ws1 <- readNextWorkspace - ws2 <- readNextWorkspace - lift $ windows $ W.swapWorkspaces (workspaceName ws1) (workspaceName ws2) + runMaybeT_ $ + lift . windows . uncurry W.swapWorkspaces =<< + (,) <$> readNextWorkspaceName <*> readNextWorkspaceName controlMod $ doc "Move the current focused window to another workspace and view that workspace" $ -- cgit From 69be48b87dbad3fec795236592fdd90f15cbb396 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Wed, 8 Jun 2022 10:29:04 -0600 Subject: Change up the override keys for browsers --- src/Rahm/Desktop/Keys.hs | 55 +++++++++++++++++++++++++----------------------- 1 file changed, 29 insertions(+), 26 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index ab72645..b57d310 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -839,9 +839,29 @@ 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 @@ -865,25 +885,6 @@ windowSpecificBindings config = do -- 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) @@ -891,20 +892,21 @@ windowSpecificBindings config = do rawMask controlMask $ emitKey (controlMask, xK_BackSpace) bind xK_b $ do - rawMask controlMask $ emitKey (controlMask, xK_Left) - rawMask (controlMask .|. shiftMask) $ + rawMask altMask $ emitKey (controlMask, xK_Left) + rawMask (altMask .|. shiftMask) $ emitKey (controlMask .|. shiftMask, xK_Left) bind xK_e $ do - rawMask controlMask $ emitKey (controlMask, xK_Right) - rawMask (controlMask .|. shiftMask) $ + rawMask altMask $ emitKey (controlMask, xK_Right) + rawMask (altMask .|. shiftMask) $ emitKey (controlMask .|. shiftMask, xK_Right) bind xK_dollar $ - rawMask controlMask $ emitKey (0, xK_End) + rawMask altMask $ emitKey (0, xK_End) - bind xK_at $ - rawMask (controlMask .|. shiftMask) $ emitKey (0, xK_Home) + 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) @@ -926,6 +928,7 @@ windowSpecificBindings config = do where browsers = ["Google-chrome", "Brave-browser", "firefox-default"] + spotify = ["Spotify"] -- Create a permutation from a list of modifiers. -- -- cgit From 3c49e047d920c8662b61726460df3eb31df0b146 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Fri, 18 Nov 2022 12:17:19 -0700 Subject: Add "Theater" concept. This is the set of the current set of screens and workspaces. It can be saved and restored. In a sense it works like how most other tiling managers handle "workspaces" where one can change all screens at once. Not that it's a superior system to XMonad (it's not), but it's sometimes helpful. --- src/Rahm/Desktop/Keys.hs | 30 ++++++++++++++++++++++++------ 1 file changed, 24 insertions(+), 6 deletions(-) (limited to 'src/Rahm/Desktop/Keys.hs') diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index b57d310..fb49394 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -64,6 +64,8 @@ import Rahm.Desktop.Submap import Rahm.Desktop.Swallow import Rahm.Desktop.SwapMaster (swapMaster) import Rahm.Desktop.Workspaces +import Rahm.Desktop.Theater + import qualified Rahm.Desktop.StackSet as W import Rahm.Desktop.History @@ -281,10 +283,18 @@ keymap = runKeys $ do runMaybeT_ $ (lift . gotoWorkspaceFn) =<< readNextWorkspace shiftMod $ - doc "Swap a workspace with another workspace." $ - runMaybeT_ $ - lift . windows . uncurry W.swapWorkspaces =<< - (,) <$> readNextWorkspaceName <*> readNextWorkspaceName + doc "Restore the theater marked with the next typed character." $ + runMaybeT_ $ do + mapNextString $ \_ str -> lift $ + case str of + [ch] | isAlpha ch -> restoreTheater [ch] + _ -> return () + + -- shiftMod $ + -- doc "Swap a workspace with another workspace." $ + -- runMaybeT_ $ + -- lift . windows . uncurry W.swapWorkspaces =<< + -- (,) <$> readNextWorkspaceName <*> readNextWorkspaceName controlMod $ doc "Move the current focused window to another workspace and view that workspace" $ @@ -400,12 +410,12 @@ keymap = runKeys $ do doc "For mosaic layout, shrink the size-share of the current window" $ sendMessage =<< shrinkPositionAlt - bind xK_m $ + bind xK_m $ do justMod $ doc "Mark the current window with the next typed character." $ do locs <- fromMaybe [] <$> runMaybeT readNextLocationSet let wins = mapMaybe locationWindow locs - withBorderWidth 4 wins $ + withBorderWidth 2 wins $ withBorderColor "#00ffff" wins $ do runMaybeT_ $ do mapNextString $ \_ str -> lift $ @@ -413,6 +423,14 @@ keymap = runKeys $ do [ch] | isAlpha ch -> markAllLocations str locs _ -> return () + shiftMod $ + doc "Mark the current theater with the next typed character." $ + runMaybeT_ $ do + mapNextString $ \_ str -> lift $ + case str of + [ch] | isAlpha ch -> saveCurrentTheater str + _ -> return () + bind xK_plus $ do justMod $ doc "Increase the number of windows in the master region." $ -- cgit