From f0809e5d1d48700e03c5bd6ea2d67d3663088e3f Mon Sep 17 00:00:00 2001 From: slotThe Date: Tue, 11 May 2021 15:36:20 +0200 Subject: [PATCH 1/8] X.A.CycleRecentWS: Cycle workspaces, not windowsets MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The way that workspace cycling is implemented right now—by generating new windowsets where the things we want happen to be true and then replacing the old windowsets—is not safe, as workspaces and layouts may carry state with them. That state will get lost in translation when windowsets are simply replaced. As an example, a conflict occurs when using `X.L.ShowWName.showWName` in one's layoutHook. When cycling through workspaces via, e.g., `cycleRecentWS` the flashed workspace tag will not disappear, as the necessary state to control this isn't present in the new windowset. Instead, what we want to do is to keep the "current" windowset alive and actually switch to the requested workspaces. This mostly works without much trouble, the only hard part is maintaining the invariant that previewed workspaces don't count towards the history of recently-viewed workspaces. This is done by remembering the tag-order of the original windowset and then restoring that at the end. This is a breaking change, insofar as it changes the type signatures of the exported functions `recentWS`, `cycleWindowSets`, and `toggleWindowSets` to return a list of `WorkspaceId`s instead of a list of `WindowSet`s. Fixes: https://github.com/xmonad/xmonad-contrib/issues/504 --- XMonad/Actions/CycleRecentWS.hs | 110 ++++++++++++++++++++++---------- 1 file changed, 78 insertions(+), 32 deletions(-) diff --git a/XMonad/Actions/CycleRecentWS.hs b/XMonad/Actions/CycleRecentWS.hs index 18fe330a..aa381eb1 100644 --- a/XMonad/Actions/CycleRecentWS.hs +++ b/XMonad/Actions/CycleRecentWS.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CycleRecentWS @@ -30,6 +31,10 @@ module XMonad.Actions.CycleRecentWS ( import XMonad hiding (workspaces) import XMonad.StackSet hiding (filter) +import Control.Arrow ((&&&)) +import Data.List (find) +import Data.Maybe (fromJust) + -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: -- @@ -76,56 +81,97 @@ toggleRecentNonEmptyWS :: X () toggleRecentNonEmptyWS = toggleWindowSets $ recentWS (not . null . stack) --- | Given a predicate p and the current WindowSet w, create a list of recent WindowSets, --- most recent first, where the focused workspace satisfies p. +-- | Given a predicate @p@ and the current 'WindowSet' @w@, create a +-- list of workspaces to choose from. They are ordered by recency and +-- have to satisfy @p@. recentWS :: (WindowSpace -> Bool) -- ^ A workspace predicate. -> WindowSet -- ^ The current WindowSet - -> [WindowSet] -recentWS p w = map (`view` w) recentTags - where recentTags = map tag - $ filter p - $ map workspace (visible w) - ++ hidden w - ++ [workspace (current w)] + -> [WorkspaceId] +recentWS p w = map tag + $ filter p + $ map workspace (visible w) + ++ hidden w + ++ [workspace (current w)] - -cycref :: [a] -> Int -> a -cycref l i = l !! (i `mod` length l) - --- | Cycle through a finite list of WindowSets with repeated presses of a key, while +-- | Cycle through a finite list of workspaces with repeated presses of a key, while -- a modifier key is held down. For best effects use the same modkey+key combination -- as the one used to invoke this action. -cycleWindowSets :: (WindowSet -> [WindowSet]) -- ^ A function used to create a list of WindowSets to choose from - -> [KeySym] -- ^ A list of modifier keys used when invoking this action. - -- As soon as one of them is released, the final WindowSet is chosen and the action exits. - -> KeySym -- ^ Key used to preview next WindowSet from the list of generated options - -> KeySym -- ^ Key used to preview previous WindowSet from the list of generated options. - -- If it's the same as nextOption key, it is effectively ignored. +cycleWindowSets :: (WindowSet -> [WorkspaceId]) -- ^ A function used to create a list of workspaces to choose from + -> [KeySym] -- ^ A list of modifier keys used when invoking this action. + -- As soon as one of them is released, the final workspace is chosen and the action exits. + -> KeySym -- ^ Key used to preview next workspace from the list of generated options + -> KeySym -- ^ Key used to preview previous workspace from the list of generated options. + -- If it's the same as nextOption key, it is effectively ignored. -> X () cycleWindowSets genOptions mods keyNext keyPrev = do - options <- gets $ genOptions . windowset + origWSet <- gets windowset + let options = genOptions origWSet XConf {theRoot = root, display = d} <- ask let event = allocaXEvent $ \p -> do maskEvent d (keyPressMask .|. keyReleaseMask) p KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p s <- keycodeToKeysym d c 0 return (t, s) - let setOption n = do windows $ const $ options `cycref` n - (t, s) <- io event - case () of - () | t == keyPress && s == keyNext -> setOption (n+1) - | t == keyPress && s == keyPrev -> setOption (n-1) - | t == keyRelease && s `elem` mods -> return () - | otherwise -> setOption n + let setOption n = do + let nextWs = options `cycref` n + syncW ws = windows $ view ws . restoreOrder origWSet + (t, s) <- io event + if | t == keyPress && s == keyNext -> syncW nextWs >> setOption (n + 1) + | t == keyPress && s == keyPrev -> syncW nextWs >> setOption (n - 1) + | t == keyRelease && s `elem` mods -> + syncW =<< gets (tag . workspace . current . windowset) + | otherwise -> setOption n io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime - setOption 0 + windows $ view (options `cycref` 0) -- view the first ws + setOption 1 io $ ungrabKeyboard d currentTime + where + cycref :: [a] -> Int -> a + cycref l i = l !! (i `mod` length l) + -- | Given an old and a new 'WindowSet', which is __exactly__ one + -- 'view' away from the old one, restore the workspace order of the + -- former inside of the latter. This respects any new state that the + -- new 'WindowSet' may have accumulated. + restoreOrder :: WindowSet -> WindowSet -> WindowSet + restoreOrder origW w + | -- The focused screen changed; the old focus is on a visible screen + newFocT `elem` visT = + w { current = (current origW){ workspace = findFoc (workspace <$> visible w) } + , visible = zipWith (\v ws -> v{ workspace = ws }) vis (updateNewFoc visW) + } + | -- The focused screen didn't change; the old focus is hidden + newFocT `elem` hidT = + w { current = (current origW){ workspace = findFoc (hidden w) } + , hidden = updateNewFoc hid + } + | otherwise = w + where + -- Foci, old and new + focT = tag . workspace . current $ origW + (newFoc, newFocT) = id &&& tag $ workspace (current w) --- | Switch to the first of a finite list of WindowSets. -toggleWindowSets :: (WindowSet -> [WindowSet]) -> X () + -- Workspaces in the _original_ windowset + (hid, hidT) = id &&& map tag $ hidden origW + (vis, (visW, visT)) = id &&& map workspace &&& map (tag . workspace) + $ visible origW + + -- | Given a list of new workspaces that contain the old focus, + -- return that workspace. + findFoc :: [WindowSpace] -> WindowSpace + findFoc ws = fromJust $ find ((== focT) . tag) ws + + -- | Given a list of old workspaces that contain the new focus, + -- update the state of the focus. + updateNewFoc :: [WindowSpace] -> [WindowSpace] + updateNewFoc ws = before ++ newFoc : after + where (before, after) = drop 1 <$> break ((== newFocT) . tag) ws + +-- | Given some function that generates a list of workspaces from a +-- given 'WindowSet', switch to the first generated workspace. +toggleWindowSets :: (WindowSet -> [WorkspaceId]) -> X () toggleWindowSets genOptions = do options <- gets $ genOptions . windowset case options of [] -> return () - o:_ -> windows (const o) + o:_ -> windows (view o) From 3db9167da498d870f34424c4c43b21dafc5fd9a5 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Fri, 14 May 2021 00:35:30 +0100 Subject: [PATCH 2/8] X.A.CycleRecentWS: Rename restoreOrder to unView Makes it more obvious what it really does. Also, don't expose origWSet as a variable, lest someone uses it. :-) --- XMonad/Actions/CycleRecentWS.hs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/XMonad/Actions/CycleRecentWS.hs b/XMonad/Actions/CycleRecentWS.hs index aa381eb1..3f83a950 100644 --- a/XMonad/Actions/CycleRecentWS.hs +++ b/XMonad/Actions/CycleRecentWS.hs @@ -104,8 +104,7 @@ cycleWindowSets :: (WindowSet -> [WorkspaceId]) -- ^ A function used to create a -- If it's the same as nextOption key, it is effectively ignored. -> X () cycleWindowSets genOptions mods keyNext keyPrev = do - origWSet <- gets windowset - let options = genOptions origWSet + (options, unView') <- gets $ (genOptions &&& unView) . windowset XConf {theRoot = root, display = d} <- ask let event = allocaXEvent $ \p -> do maskEvent d (keyPressMask .|. keyReleaseMask) p @@ -114,7 +113,7 @@ cycleWindowSets genOptions mods keyNext keyPrev = do return (t, s) let setOption n = do let nextWs = options `cycref` n - syncW ws = windows $ view ws . restoreOrder origWSet + syncW ws = windows $ view ws . unView' (t, s) <- io event if | t == keyPress && s == keyNext -> syncW nextWs >> setOption (n + 1) | t == keyPress && s == keyPrev -> syncW nextWs >> setOption (n - 1) @@ -133,8 +132,8 @@ cycleWindowSets genOptions mods keyNext keyPrev = do -- 'view' away from the old one, restore the workspace order of the -- former inside of the latter. This respects any new state that the -- new 'WindowSet' may have accumulated. - restoreOrder :: WindowSet -> WindowSet -> WindowSet - restoreOrder origW w + unView :: WindowSet -> WindowSet -> WindowSet + unView origW w | -- The focused screen changed; the old focus is on a visible screen newFocT `elem` visT = w { current = (current origW){ workspace = findFoc (workspace <$> visible w) } From 24786c6d04c2a992a57c7443fafb942b9206bced Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Thu, 13 May 2021 18:14:27 +0100 Subject: [PATCH 3/8] X.A.CycleRecentWS: Add property test for unView Scary looking code better be tested. :-) (For the record, the test did find an issue that is already fixed in the previous commit.) --- XMonad/Actions/CycleRecentWS.hs | 77 ++++++++++++++++++--------------- tests/CycleRecentWS.hs | 20 +++++++++ tests/Main.hs | 2 + xmonad-contrib.cabal | 8 ++-- 4 files changed, 69 insertions(+), 38 deletions(-) create mode 100644 tests/CycleRecentWS.hs diff --git a/XMonad/Actions/CycleRecentWS.hs b/XMonad/Actions/CycleRecentWS.hs index 3f83a950..4c0a8522 100644 --- a/XMonad/Actions/CycleRecentWS.hs +++ b/XMonad/Actions/CycleRecentWS.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CycleRecentWS @@ -25,7 +27,11 @@ module XMonad.Actions.CycleRecentWS ( toggleRecentWS, toggleRecentNonEmptyWS, toggleWindowSets, - recentWS + recentWS, + +#ifdef TESTING + unView, +#endif ) where import XMonad hiding (workspaces) @@ -128,43 +134,44 @@ cycleWindowSets genOptions mods keyNext keyPrev = do cycref :: [a] -> Int -> a cycref l i = l !! (i `mod` length l) - -- | Given an old and a new 'WindowSet', which is __exactly__ one - -- 'view' away from the old one, restore the workspace order of the - -- former inside of the latter. This respects any new state that the - -- new 'WindowSet' may have accumulated. - unView :: WindowSet -> WindowSet -> WindowSet - unView origW w - | -- The focused screen changed; the old focus is on a visible screen - newFocT `elem` visT = - w { current = (current origW){ workspace = findFoc (workspace <$> visible w) } - , visible = zipWith (\v ws -> v{ workspace = ws }) vis (updateNewFoc visW) - } - | -- The focused screen didn't change; the old focus is hidden - newFocT `elem` hidT = - w { current = (current origW){ workspace = findFoc (hidden w) } - , hidden = updateNewFoc hid - } - | otherwise = w - where - -- Foci, old and new - focT = tag . workspace . current $ origW - (newFoc, newFocT) = id &&& tag $ workspace (current w) +-- | Given an old and a new 'WindowSet', which is __exactly__ one +-- 'view' away from the old one, restore the workspace order of the +-- former inside of the latter. This respects any new state that the +-- new 'WindowSet' may have accumulated. +unView :: forall i l a s sd. Eq i + => StackSet i l a s sd -> StackSet i l a s sd -> StackSet i l a s sd +unView origW w + | -- The focused screen changed; the old focus is on a visible screen + newFocT `elem` visT = + w { current = (current origW){ workspace = findFoc (workspace <$> visible w) } + , visible = zipWith (\v ws -> v{ workspace = ws }) vis (updateNewFoc visW) + } + | -- The focused screen didn't change; the old focus is hidden + newFocT `elem` hidT = + w { current = (current origW){ workspace = findFoc (hidden w) } + , hidden = updateNewFoc hid + } + | otherwise = w + where + -- Foci, old and new + focT = tag . workspace . current $ origW + (newFoc, newFocT) = id &&& tag $ workspace (current w) - -- Workspaces in the _original_ windowset - (hid, hidT) = id &&& map tag $ hidden origW - (vis, (visW, visT)) = id &&& map workspace &&& map (tag . workspace) - $ visible origW + -- Workspaces in the _original_ windowset + (hid, hidT) = id &&& map tag $ hidden origW + (vis, (visW, visT)) = id &&& map workspace &&& map (tag . workspace) + $ visible origW - -- | Given a list of new workspaces that contain the old focus, - -- return that workspace. - findFoc :: [WindowSpace] -> WindowSpace - findFoc ws = fromJust $ find ((== focT) . tag) ws + -- | Given a list of new workspaces that contain the old focus, + -- return that workspace. + findFoc :: [Workspace i l a] -> Workspace i l a + findFoc ws = fromJust $ find ((== focT) . tag) ws - -- | Given a list of old workspaces that contain the new focus, - -- update the state of the focus. - updateNewFoc :: [WindowSpace] -> [WindowSpace] - updateNewFoc ws = before ++ newFoc : after - where (before, after) = drop 1 <$> break ((== newFocT) . tag) ws + -- | Given a list of old workspaces that contain the new focus, + -- update the state of the focus. + updateNewFoc :: [Workspace i l a] -> [Workspace i l a] + updateNewFoc ws = before ++ newFoc : after + where (before, after) = drop 1 <$> break ((== newFocT) . tag) ws -- | Given some function that generates a list of workspaces from a -- given 'WindowSet', switch to the first generated workspace. diff --git a/tests/CycleRecentWS.hs b/tests/CycleRecentWS.hs new file mode 100644 index 00000000..b7bd39dd --- /dev/null +++ b/tests/CycleRecentWS.hs @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -Wall #-} +module CycleRecentWS where + +import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck + +import XMonad.Actions.CycleRecentWS (unView) +import XMonad.StackSet (view) + +import Instances +import Utils (tags) + +spec :: Spec +spec = do + prop "prop_unView" $ prop_unView + +prop_unView :: T -> Property +prop_unView ss = conjoin + [ counterexample (show t) (unView ss (view t ss) === ss) | t <- tags ss ] diff --git a/tests/Main.hs b/tests/Main.hs index ecc1d9c1..c2ef02d0 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -10,6 +10,7 @@ import qualified RotateSome import qualified Selective import qualified SwapWorkspaces import qualified XPrompt +import qualified CycleRecentWS main :: IO () main = hspec $ do @@ -45,3 +46,4 @@ main = hspec $ do prop "prop_skipGetLastWord" $ XPrompt.prop_skipGetLastWord context "NoBorders" $ NoBorders.spec context "ExtensibleConf" $ ExtensibleConf.spec + context "CycleRecentWS" $ CycleRecentWS.spec diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index e60951ea..8a4bb557 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -373,15 +373,16 @@ library test-suite tests type: exitcode-stdio-1.0 main-is: Main.hs - other-modules: ManageDocks + other-modules: CycleRecentWS + Instances + ManageDocks NoBorders RotateSome Selective SwapWorkspaces - XPrompt - Instances Utils ExtensibleConf + XMonad.Actions.CycleRecentWS XMonad.Actions.CycleWS XMonad.Actions.FocusNth XMonad.Actions.PhysicalScreens @@ -409,6 +410,7 @@ test-suite tests XMonad.Util.WorkspaceCompare XMonad.Util.XSelection XMonad.Util.XUtils + XPrompt hs-source-dirs: tests, . build-depends: base , QuickCheck >= 2 From 12b30c393c64549c364f70dad4aeb935f1f3a320 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Fri, 14 May 2021 00:35:30 +0100 Subject: [PATCH 4/8] X.A.CycleRecentWS: Simplify/fix unView To make this more "obviously correct", make it resemble the `view` implementation, just do the exact reverse. Now the only complex bit is the "undelete" operation. This also fixes another issue: state was only preserved in the focused workspace, but it may have changed in another visible workspace as well. The property test is updated to test this. --- XMonad/Actions/CycleRecentWS.hs | 50 +++++++++++++-------------------- tests/CycleRecentWS.hs | 7 +++-- 2 files changed, 25 insertions(+), 32 deletions(-) diff --git a/XMonad/Actions/CycleRecentWS.hs b/XMonad/Actions/CycleRecentWS.hs index 4c0a8522..99fe34a7 100644 --- a/XMonad/Actions/CycleRecentWS.hs +++ b/XMonad/Actions/CycleRecentWS.hs @@ -38,8 +38,7 @@ import XMonad hiding (workspaces) import XMonad.StackSet hiding (filter) import Control.Arrow ((&&&)) -import Data.List (find) -import Data.Maybe (fromJust) +import Data.Function (on) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: @@ -140,38 +139,29 @@ cycleWindowSets genOptions mods keyNext keyPrev = do -- new 'WindowSet' may have accumulated. unView :: forall i l a s sd. Eq i => StackSet i l a s sd -> StackSet i l a s sd -> StackSet i l a s sd -unView origW w - | -- The focused screen changed; the old focus is on a visible screen - newFocT `elem` visT = - w { current = (current origW){ workspace = findFoc (workspace <$> visible w) } - , visible = zipWith (\v ws -> v{ workspace = ws }) vis (updateNewFoc visW) - } - | -- The focused screen didn't change; the old focus is hidden - newFocT `elem` hidT = - w { current = (current origW){ workspace = findFoc (hidden w) } - , hidden = updateNewFoc hid - } +unView w0 w + | currentTag w0 == currentTag w = w + + | v1 : vs <- visible w + , currentTag w0 == (tag . workspace) v1 + = w { current = v1 + , visible = insertAt (commonPrefixV (visible w0) vs) (current w) vs } + + | h1 : hs <- hidden w + , currentTag w0 == tag h1 + = w { current = (current w){ workspace = h1 } + , hidden = insertAt (commonPrefixH (hidden w0) hs) (workspace (current w)) hs } + | otherwise = w where - -- Foci, old and new - focT = tag . workspace . current $ origW - (newFoc, newFocT) = id &&& tag $ workspace (current w) + commonPrefixV = commonPrefix `on` fmap (tag . workspace) + commonPrefixH = commonPrefix `on` fmap tag - -- Workspaces in the _original_ windowset - (hid, hidT) = id &&& map tag $ hidden origW - (vis, (visW, visT)) = id &&& map workspace &&& map (tag . workspace) - $ visible origW + insertAt :: Int -> x -> [x] -> [x] + insertAt n x xs = let (l, r) = splitAt n xs in l ++ [x] ++ r - -- | Given a list of new workspaces that contain the old focus, - -- return that workspace. - findFoc :: [Workspace i l a] -> Workspace i l a - findFoc ws = fromJust $ find ((== focT) . tag) ws - - -- | Given a list of old workspaces that contain the new focus, - -- update the state of the focus. - updateNewFoc :: [Workspace i l a] -> [Workspace i l a] - updateNewFoc ws = before ++ newFoc : after - where (before, after) = drop 1 <$> break ((== newFocT) . tag) ws + commonPrefix :: Eq x => [x] -> [x] -> Int + commonPrefix a b = length $ takeWhile id $ zipWith (==) a b -- | Given some function that generates a list of workspaces from a -- given 'WindowSet', switch to the first generated workspace. diff --git a/tests/CycleRecentWS.hs b/tests/CycleRecentWS.hs index b7bd39dd..737e8aea 100644 --- a/tests/CycleRecentWS.hs +++ b/tests/CycleRecentWS.hs @@ -6,7 +6,7 @@ import Test.Hspec.QuickCheck import Test.QuickCheck import XMonad.Actions.CycleRecentWS (unView) -import XMonad.StackSet (view) +import XMonad.StackSet (view, mapLayout) import Instances import Utils (tags) @@ -17,4 +17,7 @@ spec = do prop_unView :: T -> Property prop_unView ss = conjoin - [ counterexample (show t) (unView ss (view t ss) === ss) | t <- tags ss ] + [ counterexample (show t) (unView ss (state (view t ss)) === state ss) + | t <- tags ss ] + where + state = mapLayout succ From b65b83661b37c3f29738985e796f5cca17a1440a Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Fri, 14 May 2021 10:13:21 +0100 Subject: [PATCH 5/8] X.A.CycleRecentWS: Simplify unView even more Instead of implementing `view` in reverse, we can use it directly and then just fix the order of visible/hidden workspaces. --- XMonad/Actions/CycleRecentWS.hs | 26 +++++++++----------------- 1 file changed, 9 insertions(+), 17 deletions(-) diff --git a/XMonad/Actions/CycleRecentWS.hs b/XMonad/Actions/CycleRecentWS.hs index 99fe34a7..11d78cf9 100644 --- a/XMonad/Actions/CycleRecentWS.hs +++ b/XMonad/Actions/CycleRecentWS.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CycleRecentWS @@ -137,25 +138,16 @@ cycleWindowSets genOptions mods keyNext keyPrev = do -- 'view' away from the old one, restore the workspace order of the -- former inside of the latter. This respects any new state that the -- new 'WindowSet' may have accumulated. -unView :: forall i l a s sd. Eq i +unView :: forall i l a s sd. (Eq i, Eq s) => StackSet i l a s sd -> StackSet i l a s sd -> StackSet i l a s sd -unView w0 w - | currentTag w0 == currentTag w = w - - | v1 : vs <- visible w - , currentTag w0 == (tag . workspace) v1 - = w { current = v1 - , visible = insertAt (commonPrefixV (visible w0) vs) (current w) vs } - - | h1 : hs <- hidden w - , currentTag w0 == tag h1 - = w { current = (current w){ workspace = h1 } - , hidden = insertAt (commonPrefixH (hidden w0) hs) (workspace (current w)) hs } - - | otherwise = w +unView w0 = fixOrderH . fixOrderV . view (currentTag w0) where - commonPrefixV = commonPrefix `on` fmap (tag . workspace) - commonPrefixH = commonPrefix `on` fmap tag + fixOrderV w | v : vs <- visible w = w{ visible = insertAt (pfxV (visible w0) vs) v vs } + | otherwise = w + fixOrderH w | h : hs <- hidden w = w{ hidden = insertAt (pfxH (hidden w0) hs) h hs } + | otherwise = w + pfxV = commonPrefix `on` fmap (tag . workspace) + pfxH = commonPrefix `on` fmap tag insertAt :: Int -> x -> [x] -> [x] insertAt n x xs = let (l, r) = splitAt n xs in l ++ [x] ++ r From 1e2e1273b8793df04097b7a7c13283a6fdbb72b3 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Fri, 14 May 2021 00:36:58 +0100 Subject: [PATCH 6/8] X.A.CycleRecentWS: Revert setOption changes These are remnants of the first fix attempt, but are no longer necessary. This reduces the diff to `view . unview` instead of `const`. --- XMonad/Actions/CycleRecentWS.hs | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/XMonad/Actions/CycleRecentWS.hs b/XMonad/Actions/CycleRecentWS.hs index 11d78cf9..3a72d20b 100644 --- a/XMonad/Actions/CycleRecentWS.hs +++ b/XMonad/Actions/CycleRecentWS.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- @@ -117,18 +116,15 @@ cycleWindowSets genOptions mods keyNext keyPrev = do KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p s <- keycodeToKeysym d c 0 return (t, s) - let setOption n = do - let nextWs = options `cycref` n - syncW ws = windows $ view ws . unView' - (t, s) <- io event - if | t == keyPress && s == keyNext -> syncW nextWs >> setOption (n + 1) - | t == keyPress && s == keyPrev -> syncW nextWs >> setOption (n - 1) - | t == keyRelease && s `elem` mods -> - syncW =<< gets (tag . workspace . current . windowset) - | otherwise -> setOption n + let setOption n = do windows $ view (options `cycref` n) . unView' + (t, s) <- io event + case () of + () | t == keyPress && s == keyNext -> setOption (n+1) + | t == keyPress && s == keyPrev -> setOption (n-1) + | t == keyRelease && s `elem` mods -> return () + | otherwise -> setOption n io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime - windows $ view (options `cycref` 0) -- view the first ws - setOption 1 + setOption 0 io $ ungrabKeyboard d currentTime where cycref :: [a] -> Int -> a From 86522a27b03a75505e5708648a2fc45375d86564 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Fri, 14 May 2021 00:36:32 +0100 Subject: [PATCH 7/8] X.A.CycleRecentWS: Make unView work with greedyView as well Entirely unnecessary for the current version of `cycleWindowSets`, but if anyone ever wants to use `greedyView`, this shows that it's not at all complicated to adapt `unView` to that. --- XMonad/Actions/CycleRecentWS.hs | 3 ++- tests/CycleRecentWS.hs | 7 ++++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/XMonad/Actions/CycleRecentWS.hs b/XMonad/Actions/CycleRecentWS.hs index 3a72d20b..bc5182eb 100644 --- a/XMonad/Actions/CycleRecentWS.hs +++ b/XMonad/Actions/CycleRecentWS.hs @@ -136,8 +136,9 @@ cycleWindowSets genOptions mods keyNext keyPrev = do -- new 'WindowSet' may have accumulated. unView :: forall i l a s sd. (Eq i, Eq s) => StackSet i l a s sd -> StackSet i l a s sd -> StackSet i l a s sd -unView w0 = fixOrderH . fixOrderV . view (currentTag w0) +unView w0 w1 = fixOrderH . fixOrderV . view' (currentTag w0) $ w1 where + view' = if screen (current w0) == screen (current w1) then greedyView else view fixOrderV w | v : vs <- visible w = w{ visible = insertAt (pfxV (visible w0) vs) v vs } | otherwise = w fixOrderH w | h : hs <- hidden w = w{ hidden = insertAt (pfxH (hidden w0) hs) h hs } diff --git a/tests/CycleRecentWS.hs b/tests/CycleRecentWS.hs index 737e8aea..d09f0e52 100644 --- a/tests/CycleRecentWS.hs +++ b/tests/CycleRecentWS.hs @@ -6,7 +6,7 @@ import Test.Hspec.QuickCheck import Test.QuickCheck import XMonad.Actions.CycleRecentWS (unView) -import XMonad.StackSet (view, mapLayout) +import XMonad.StackSet (view, greedyView, mapLayout) import Instances import Utils (tags) @@ -17,7 +17,8 @@ spec = do prop_unView :: T -> Property prop_unView ss = conjoin - [ counterexample (show t) (unView ss (state (view t ss)) === state ss) - | t <- tags ss ] + [ counterexample desc (unView ss (state (v t ss)) === state ss) + | t <- tags ss + , (desc, v) <- [("view " <> show t, view), ("greedyView " <> show t, greedyView)] ] where state = mapLayout succ From 055c4877a1815955c80f4ea46f41ffa8110228b2 Mon Sep 17 00:00:00 2001 From: slotThe Date: Wed, 2 Jun 2021 08:31:23 +0200 Subject: [PATCH 8/8] Update CHANGES.md --- CHANGES.md | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index ded0d27c..82224aef 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -92,6 +92,15 @@ `tiActions`, `tiDirs`, `noAction`, and `inHome` for a more convenient specification of topics. + * `XMonad.Actions.CycleRecentWS` + + - Changed the signature of `recentWS` to return a `[WorkspaceId]` + instead of a `[WindowSet]`, while `cycleWindowSets` and + `toggleWindowSets` now take a function `WindowSet -> + [WorkspaceId]` instead of one to `[WindowSet]` as their first + argument. This fixes the interplay between this module and any + layout that stores state. + ### New Modules * `XMonad.Hooks.StatusBar.PP`