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` diff --git a/XMonad/Actions/CycleRecentWS.hs b/XMonad/Actions/CycleRecentWS.hs index 18fe330a..bc5182eb 100644 --- a/XMonad/Actions/CycleRecentWS.hs +++ b/XMonad/Actions/CycleRecentWS.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CycleRecentWS @@ -24,12 +27,19 @@ module XMonad.Actions.CycleRecentWS ( toggleRecentWS, toggleRecentNonEmptyWS, toggleWindowSets, - recentWS + recentWS, + +#ifdef TESTING + unView, +#endif ) where import XMonad hiding (workspaces) import XMonad.StackSet hiding (filter) +import Control.Arrow ((&&&)) +import Data.Function (on) + -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: -- @@ -76,41 +86,37 @@ 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 + (options, unView') <- gets $ (genOptions &&& unView) . windowset 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 + let setOption n = do windows $ view (options `cycref` n) . unView' (t, s) <- io event case () of () | t == keyPress && s == keyNext -> setOption (n+1) @@ -120,12 +126,37 @@ cycleWindowSets genOptions mods keyNext keyPrev = do io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime setOption 0 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. +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 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 } + | otherwise = w + pfxV = commonPrefix `on` fmap (tag . workspace) + pfxH = commonPrefix `on` fmap tag --- | Switch to the first of a finite list of WindowSets. -toggleWindowSets :: (WindowSet -> [WindowSet]) -> X () + insertAt :: Int -> x -> [x] -> [x] + insertAt n x xs = let (l, r) = splitAt n xs in l ++ [x] ++ r + + 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. +toggleWindowSets :: (WindowSet -> [WorkspaceId]) -> X () toggleWindowSets genOptions = do options <- gets $ genOptions . windowset case options of [] -> return () - o:_ -> windows (const o) + o:_ -> windows (view o) diff --git a/tests/CycleRecentWS.hs b/tests/CycleRecentWS.hs new file mode 100644 index 00000000..d09f0e52 --- /dev/null +++ b/tests/CycleRecentWS.hs @@ -0,0 +1,24 @@ +{-# 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, greedyView, mapLayout) + +import Instances +import Utils (tags) + +spec :: Spec +spec = do + prop "prop_unView" $ prop_unView + +prop_unView :: T -> Property +prop_unView ss = conjoin + [ 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 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