From 4c57dc73da6d8b0db8f84671619d11059da31775 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Fri, 20 Mar 2020 16:10:03 -0600 Subject: Added ability to cycle linearly through workspaces with win-N and win-P --- src/Internal/Keys.hs | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) (limited to 'src/Internal/Keys.hs') diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs index 4828f27..3e7e054 100644 --- a/src/Internal/Keys.hs +++ b/src/Internal/Keys.hs @@ -1,5 +1,7 @@ +{-# LANGUAGE RankNTypes #-} module Internal.Keys where +import Data.Maybe (isJust) import Debug.Trace import Control.Applicative import Prelude hiding ((!!)) @@ -32,6 +34,8 @@ applyKeys config@(XConfig {modMask = modm}) = do withWindowNavigation (xK_k, xK_h, xK_j, xK_l) $ config { keys = ks } +newtype Selector = Selector (forall a. (Eq a) => a -> [a] -> a) + data WinPrompt = WinPrompt instance XPrompt WinPrompt where @@ -71,6 +75,25 @@ newKeys = swapSc f t (W.Screen ws a b) = W.Screen (swapWs f t ws) a b + relativeWorkspaceShift :: Selector -> X () + relativeWorkspaceShift (Selector selector) = do + windows $ \ss -> do + let tags = sort $ (W.tag <$> filter (isJust . W.stack) (W.workspaces ss)) + from = W.tag $ W.workspace $ W.current ss + to = selector from tags + + W.greedyView to ss + + nextWorkspace = Selector select + where select n (x:y:xs) | n == x = y + select n (x:xs) = select n xs + select n _ = n + + prevWorkspace = Selector select + where select n (x:y:xs) | n == y = x + select n (x:xs) = select n xs + select n _ = n + swapWorkspace :: Char -> X () swapWorkspace toChar = do windows $ \ss -> do @@ -154,6 +177,9 @@ newKeys = , ((modm, xK_space), sendMessage NextLayout) + , ((modm, xK_n), relativeWorkspaceShift nextWorkspace) + , ((modm, xK_p), relativeWorkspaceShift prevWorkspace) + , ((modm, xK_q), spawn "xmonad --recompile && xmonad --restart") , ((modm, xK_z), sendMessage ToggleZoom) -- cgit From e57b0a3a870d1f9688491b17afbd5a9d994ad343 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Thu, 26 Mar 2020 16:21:29 -0600 Subject: Move logic from Keys.hs to Lib.hs. Added an monad XPlus that holds extra state with the MarkContext, etc. This should make it easier to handle as more and more state accrues over time. --- src/Internal/Keys.hs | 150 ++++++++++----------------------------------------- 1 file changed, 29 insertions(+), 121 deletions(-) (limited to 'src/Internal/Keys.hs') diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs index 3e7e054..902e743 100644 --- a/src/Internal/Keys.hs +++ b/src/Internal/Keys.hs @@ -1,6 +1,7 @@ {-# LANGUAGE RankNTypes #-} module Internal.Keys where +import Internal.XPlus import Data.Maybe (isJust) import Debug.Trace import Control.Applicative @@ -26,6 +27,8 @@ import XMonad.Util.Scratchpad import qualified Data.Map as Map import qualified XMonad.StackSet as W +import Internal.Lib + type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ()) applyKeys :: XConfig l -> IO (XConfig l) @@ -34,119 +37,10 @@ applyKeys config@(XConfig {modMask = modm}) = do withWindowNavigation (xK_k, xK_h, xK_j, xK_l) $ config { keys = ks } -newtype Selector = Selector (forall a. (Eq a) => a -> [a] -> a) - -data WinPrompt = WinPrompt - -instance XPrompt WinPrompt where - showXPrompt _ = "[Window] " - commandToComplete _ = id - -getHorizontallyOrderedScreens :: - W.StackSet wid l a ScreenId ScreenDetail -> - [W.Screen wid l a ScreenId ScreenDetail] --- ^ Returns a list of screens ordered from leftmost to rightmost. -getHorizontallyOrderedScreens windowSet = - flip sortBy screens $ \sc1 sc2 -> - let (SD (Rectangle x1 _ _ _)) = W.screenDetail sc1 - (SD (Rectangle x2 _ _ _)) = W.screenDetail sc2 - in x1 `compare` x2 - where - screens = W.current windowSet : W.visible windowSet - newKeys :: IO (KeyMap l) newKeys = withNewMarkContext $ \markContext -> return $ \config@(XConfig {modMask = modm}) -> - let workspacesByInt = - Map.fromList $ - zip ['1'..] (XMonad.workspaces config) - - gotoWorkspace ch = do - saveLastMark markContext - windows $ W.greedyView $ return ch - - shiftToWorkspace ch = do - windows $ W.shift $ return ch - - swapWs f t (W.Workspace t' l s) | t' == f = W.Workspace t l s - swapWs f t (W.Workspace t' l s) | t' == t = W.Workspace f l s - swapWs _ _ ws = ws - - swapSc f t (W.Screen ws a b) = W.Screen (swapWs f t ws) a b - - relativeWorkspaceShift :: Selector -> X () - relativeWorkspaceShift (Selector selector) = do - windows $ \ss -> do - let tags = sort $ (W.tag <$> filter (isJust . W.stack) (W.workspaces ss)) - from = W.tag $ W.workspace $ W.current ss - to = selector from tags - - W.greedyView to ss - - nextWorkspace = Selector select - where select n (x:y:xs) | n == x = y - select n (x:xs) = select n xs - select n _ = n - - prevWorkspace = Selector select - where select n (x:y:xs) | n == y = x - select n (x:xs) = select n xs - select n _ = n - - swapWorkspace :: Char -> X () - swapWorkspace toChar = do - windows $ \ss -> do - let from = W.tag $ W.workspace $ W.current ss - to = [toChar] in - (W.StackSet (swapSc from to $ W.current ss) - (map (swapSc from to) $ W.visible ss) - (map (swapWs from to) $ W.hidden ss) - (W.floating ss)) - - fuzzyCompletion s1 s0 = - let ws = filter (not . all isSpace) $ words (map toLower s1) - l0 = map toLower s0 in - all (`isInfixOf`l0) ws - - getString = runQuery $ do - t <- title - a <- appName - return $ - if map toLower a `isInfixOf` map toLower t - then t - else printf "%s - %s" a t - - withScreen :: (WorkspaceId -> WindowSet -> WindowSet) -> Int -> X () - withScreen fn n = do - saveLastMark markContext - windows $ \windowSet -> - case (getHorizontallyOrderedScreens windowSet !! n) of - Nothing -> windowSet - Just screen -> fn (W.tag $ W.workspace screen) windowSet - - windowJump = do - windowTitlesToWinId <- withWindowSet $ \ss -> - Map.fromList <$> - mapM (\wid -> (,) <$> getString wid <*> return wid) - (W.allWindows ss) - - mkXPrompt - WinPrompt - xpConfig - (\input -> do - return $ filter (fuzzyCompletion input) (Map.keys windowTitlesToWinId)) $ \str -> do - saveLastMark markContext - case Map.lookup str windowTitlesToWinId of - Just w -> focus w - Nothing -> - case filter (fuzzyCompletion str) (Map.keys windowTitlesToWinId) of - [s] -> - mapM_ focus (Map.lookup s windowTitlesToWinId) - _ -> return () - - in - Map.fromList [ ((modm, xK_F12), (void $ spawn "spotify-control next")) , ((modm, xK_F11), (void $ spawn "spotify-control prev")) @@ -160,15 +54,24 @@ newKeys = , ((modm .|. shiftMask, xK_t), withFocused $ windows . W.sink) , ((modm, xK_t), (void $ spawn (terminal config))) , ((modm, xK_m), (submap $ mapAlpha modm (markCurrentWindow markContext))) - , ((modm, xK_w), windowJump) + , ((modm, xK_w), runXPlus markContext config windowJump) , ((modm, xK_apostrophe), (submap $ Map.insert (modm, xK_apostrophe) (jumpToLast markContext) (mapAlpha modm (jumpToMark markContext)))) - , ((modm, xK_g), (submap $ mapNumbersAndAlpha 0 gotoWorkspace)) - , ((modm .|. shiftMask, xK_g), (submap $ mapNumbersAndAlpha 0 shiftToWorkspace)) - , ((modm .|. shiftMask .|. mod1Mask, xK_g), (submap $ mapNumbersAndAlpha 0 swapWorkspace)) + + , ((modm, xK_g), (submap $ + mapNumbersAndAlpha 0 ( + runXPlus markContext config . gotoWorkspace))) + + , ((modm .|. shiftMask, xK_g), (submap $ + mapNumbersAndAlpha 0 ( + runXPlus markContext config . shiftToWorkspace))) + + , ((modm .|. shiftMask .|. mod1Mask, xK_g), (submap $ + mapNumbersAndAlpha 0 ( + runXPlus markContext config . swapWorkspace))) , ((modm .|. shiftMask, xK_bracketleft), sendMessage (IncMasterN (-1))) , ((modm .|. shiftMask, xK_bracketright), sendMessage (IncMasterN 1)) @@ -177,8 +80,8 @@ newKeys = , ((modm, xK_space), sendMessage NextLayout) - , ((modm, xK_n), relativeWorkspaceShift nextWorkspace) - , ((modm, xK_p), relativeWorkspaceShift prevWorkspace) + , ((modm, xK_n), relativeWorkspaceShift next) + , ((modm, xK_p), relativeWorkspaceShift prev) , ((modm, xK_q), spawn "xmonad --recompile && xmonad --restart") , ((modm, xK_z), sendMessage ToggleZoom) @@ -186,13 +89,18 @@ newKeys = , ((modm, xK_Tab), windows W.focusDown) , ((modm .|. shiftMask, xK_Tab), windows W.focusUp) - , ((modm, xK_a), withScreen W.view 0) - , ((modm, xK_o), withScreen W.view 1) - , ((modm, xK_e), withScreen W.view 2) + , ((modm, xK_a), runXPlus markContext config (withScreen W.view 0)) + , ((modm, xK_o), runXPlus markContext config (withScreen W.view 1)) + , ((modm, xK_e), runXPlus markContext config (withScreen W.view 2)) + + , ((modm .|. shiftMask, xK_a), runXPlus markContext config (withScreen W.shift 0)) + , ((modm .|. shiftMask, xK_o), runXPlus markContext config (withScreen W.shift 1)) + , ((modm .|. shiftMask, xK_e), runXPlus markContext config (withScreen W.shift 2)) - , ((modm .|. shiftMask, xK_a), withScreen W.shift 0) - , ((modm .|. shiftMask, xK_o), withScreen W.shift 1) - , ((modm .|. shiftMask, xK_e), withScreen W.shift 2) + -- Buttons programmed on my mouse. + , ((shiftMask, xK_F1), withFocused $ windows . W.sink) + , ((shiftMask, xK_F2), kill) + , ((shiftMask, xK_F3), kill) ] mapNumbersAndAlpha :: KeyMask -> (Char -> X ()) -> Map (KeyMask, KeySym) (X ()) -- cgit From 63e1d3b9b8685ea77cb488844dddb59a6858c39d Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Thu, 26 Mar 2020 16:48:01 -0600 Subject: Add some bindings for the other buttons on the mouse --- src/Internal/Keys.hs | 34 +++++++++++++++++++++++++--------- 1 file changed, 25 insertions(+), 9 deletions(-) (limited to 'src/Internal/Keys.hs') diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs index 902e743..83d2e08 100644 --- a/src/Internal/Keys.hs +++ b/src/Internal/Keys.hs @@ -32,14 +32,30 @@ import Internal.Lib type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ()) applyKeys :: XConfig l -> IO (XConfig l) -applyKeys config@(XConfig {modMask = modm}) = do - ks <- newKeys - withWindowNavigation (xK_k, xK_h, xK_j, xK_l) $ - config { keys = ks } - -newKeys :: IO (KeyMap l) -newKeys = - withNewMarkContext $ \markContext -> +applyKeys config@(XConfig {modMask = modm}) = + withNewMarkContext $ \markContext -> do + ks <- newKeys markContext + ms <- newMouse markContext + withWindowNavigation (xK_k, xK_h, xK_j, xK_l) $ + config { keys = ks, mouseBindings = ms } + +newMouse :: MarkContext -> IO (XConfig l -> Map (KeyMask, Button) (Window -> X ())) +newMouse markContext = + return $ \config@(XConfig {modMask = modm}) -> + Map.fromList [ + ((modm, button1), \w -> focus w >> mouseMoveWindow w >> windows W.shiftMaster) + , ((modm, button2), windows . (W.shiftMaster .) . W.focusWindow) + , ((modm, button3), \w -> focus w >> mouseResizeWindow w >> windows W.shiftMaster) + + , ((modm, 6), const (relativeWorkspaceShift prev)) + , ((modm, 7), const (relativeWorkspaceShift next)) + + , ((modm, 8), const (relativeWorkspaceShift prev)) + , ((modm, 9), const (relativeWorkspaceShift next)) + ] + +newKeys :: MarkContext -> IO (KeyMap l) +newKeys markContext = return $ \config@(XConfig {modMask = modm}) -> Map.fromList [ ((modm, xK_F12), (void $ spawn "spotify-control next")) @@ -99,7 +115,7 @@ newKeys = -- Buttons programmed on my mouse. , ((shiftMask, xK_F1), withFocused $ windows . W.sink) - , ((shiftMask, xK_F2), kill) + , ((shiftMask, xK_F2), sendMessage ToggleZoom) , ((shiftMask, xK_F3), kill) ] -- cgit From 475a99a72e43a3ebd8c5761d67309f5ac9d90e6d Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Tue, 7 Apr 2020 10:05:36 -0600 Subject: Add the ability to swap screens using Mod4-Mod1-aoe --- src/Internal/Keys.hs | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'src/Internal/Keys.hs') diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs index 83d2e08..75a1de9 100644 --- a/src/Internal/Keys.hs +++ b/src/Internal/Keys.hs @@ -113,6 +113,10 @@ newKeys markContext = , ((modm .|. shiftMask, xK_o), runXPlus markContext config (withScreen W.shift 1)) , ((modm .|. shiftMask, xK_e), runXPlus markContext config (withScreen W.shift 2)) + , ((modm .|. mod1Mask, xK_a), runXPlus markContext config (withScreen W.greedyView 0)) + , ((modm .|. mod1Mask, xK_o), runXPlus markContext config (withScreen W.greedyView 1)) + , ((modm .|. mod1Mask, xK_e), runXPlus markContext config (withScreen W.greedyView 2)) + -- Buttons programmed on my mouse. , ((shiftMask, xK_F1), withFocused $ windows . W.sink) , ((shiftMask, xK_F2), sendMessage ToggleZoom) -- cgit From b5738a4792ea94f0f754aae4137d87ddc2a0f077 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Wed, 22 Apr 2020 11:34:55 -0600 Subject: Change how clicking works. Allow click through on focus and change focus to current window when pressing the mouse macro buttons. --- src/Internal/Keys.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) (limited to 'src/Internal/Keys.hs') diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs index 75a1de9..19ff5b5 100644 --- a/src/Internal/Keys.hs +++ b/src/Internal/Keys.hs @@ -1,6 +1,8 @@ {-# LANGUAGE RankNTypes #-} module Internal.Keys where +import System.Process +import XMonad.Util.Ungrab import Internal.XPlus import Data.Maybe (isJust) import Debug.Trace @@ -54,6 +56,12 @@ newMouse markContext = , ((modm, 9), const (relativeWorkspaceShift next)) ] +click :: X () +click = do + (dpy, root) <- asks $ (,) <$> display <*> theRoot + (_, _, window, _, _, _, _, _) <- io $ queryPointer dpy root + focus window + newKeys :: MarkContext -> IO (KeyMap l) newKeys markContext = return $ \config@(XConfig {modMask = modm}) -> @@ -118,9 +126,9 @@ newKeys markContext = , ((modm .|. mod1Mask, xK_e), runXPlus markContext config (withScreen W.greedyView 2)) -- Buttons programmed on my mouse. - , ((shiftMask, xK_F1), withFocused $ windows . W.sink) - , ((shiftMask, xK_F2), sendMessage ToggleZoom) - , ((shiftMask, xK_F3), kill) + , ((shiftMask, xK_F1), click >> (withFocused $ windows . W.sink)) + , ((shiftMask, xK_F2), click >> sendMessage ToggleZoom) + , ((shiftMask, xK_F3), click >> kill) ] mapNumbersAndAlpha :: KeyMask -> (Char -> X ()) -> Map (KeyMask, KeySym) (X ()) -- cgit