From 66d334f4cd937165ac5076e57598e9a03684d6c8 Mon Sep 17 00:00:00 2001 From: Platon Pronko Date: Wed, 27 Mar 2024 16:53:37 +0500 Subject: [PATCH] X.A.WindowNavigation: better handling of floating windows and Full layout Previous version most of the time just got "stuck" on floating windows, switching back and forth between floating window and tiled window underneath. This was because "magic point" was left in the same position and thus next navigation commands selected the same windows over and over again. Now the "magic point" is moved around such that it doesn't overlap with the previously selected window, and there are more complicated rules to make navigation between floating and tiled windows more natural. The original behavior of navigating between tiled windows is preserved almost precisely. Previous version also prevented switching windows using focusUp/focusDown when in Full layout. Now there's a special case that handles such situations. --- CHANGES.md | 5 + XMonad/Actions/WindowNavigation.hs | 373 +++++++++++++---- tests/Main.hs | 2 + tests/WindowNavigation.hs | 635 +++++++++++++++++++++++++++++ xmonad-contrib.cabal | 2 + 5 files changed, 930 insertions(+), 87 deletions(-) create mode 100644 tests/WindowNavigation.hs diff --git a/CHANGES.md b/CHANGES.md index cafcfe41b3..2798f4621d 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -92,6 +92,11 @@ - Added screen edge support with `SCTop`, `SCBottom`, `SCLeft` and `SCRight`. Now both corners and edges are supported. + * `XMonad.Actions.WindowNavigation` + + - Improve navigation in presence of floating windows. + - Handle window switching when in `Full` layout. + ### Other changes ## 0.18.0 (February 3, 2024) diff --git a/XMonad/Actions/WindowNavigation.hs b/XMonad/Actions/WindowNavigation.hs index b88970426c..e701d080a7 100644 --- a/XMonad/Actions/WindowNavigation.hs +++ b/XMonad/Actions/WindowNavigation.hs @@ -1,10 +1,12 @@ +{-# LANGUAGE TupleSections #-} -- I didn't want this, it's hlint's "suggestion" and it's apparently non-negotiable ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.WindowNavigation -- Description : Experimental rewrite of "XMonad.Layout.WindowNavigation". -- Copyright : (c) 2007 David Roundy , -- Devin Mullins --- Maintainer : Devin Mullins +-- Maintainer : Devin Mullins , +-- Platon Pronko -- License : BSD3-style (see LICENSE) -- Stability : unstable -- Portability : unportable @@ -37,17 +39,19 @@ module XMonad.Actions.WindowNavigation ( withWindowNavigationKeys, WNAction(..), go, swap, + goPure, swapPure, Direction2D(..), WNState, ) where -import XMonad -import XMonad.Prelude (catMaybes, fromMaybe, listToMaybe, sortOn) +import XMonad hiding (state) +import XMonad.Prelude (catMaybes, fromMaybe, sortOn) import XMonad.Util.Types (Direction2D(..)) import qualified XMonad.StackSet as W import Control.Arrow (second) import Data.IORef import Data.Map (Map()) +import Data.List (partition, find) import qualified Data.Map as M import qualified Data.Set as S @@ -101,27 +105,60 @@ withWindowNavigation (u,l,d,r) conf@XConfig{modMask=modm} = withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l) withWindowNavigationKeys wnKeys conf = do - posRef <- newIORef M.empty - return conf { keys = \cnf -> M.fromList (map (second (fromWNAction posRef)) wnKeys) + stateRef <- newIORef M.empty + return conf { keys = \cnf -> M.fromList (map (second (fromWNAction stateRef)) wnKeys) `M.union` keys conf cnf, - logHook = logHook conf >> trackMovement posRef } - where fromWNAction posRef (WNGo dir) = go posRef dir - fromWNAction posRef (WNSwap dir) = swap posRef dir + logHook = logHook conf >> trackMovement stateRef } + where fromWNAction stateRef (WNGo dir) = go stateRef dir + fromWNAction stateRef (WNSwap dir) = swap stateRef dir data WNAction = WNGo Direction2D | WNSwap Direction2D type WNState = Map WorkspaceId Point --- go: --- 1. get current position, verifying it matches the current window --- 2. get target windowrect --- 3. focus window --- 4. set new position +-- | Focus window in the given direction. go :: IORef WNState -> Direction2D -> X () -go = withTargetWindow W.focusWindow +go stateRef dir = runPureAction stateRef (goPure dir) +-- | Swap current window with the window in the given direction. +-- Note: doesn't work with floating windows (don't think it makes much sense to swap floating windows). swap :: IORef WNState -> Direction2D -> X () -swap = withTargetWindow swapWithFocused +swap stateRef dir = runPureAction stateRef (swapPure dir) + +type WindowRectFn x = (Window -> x (Maybe Rectangle)) +-- | (state, oldWindowSet, mappedWindows, windowRect) +type WNInput x = (WNState, WindowSet, S.Set Window, WindowRectFn x) +type WNOutput = (WNState, WindowSet) + +-- | Run the pure action inside X monad. +runPureAction :: IORef WNState -> (WNInput X -> X WNOutput) -> X () +runPureAction stateRef action = do + oldState <- io (readIORef stateRef) + oldWindowSet <- gets windowset + mappedWindows <- gets mapped + (newState, newWindowSet) <- action (oldState, oldWindowSet, mappedWindows, windowRectX) + windows (const newWindowSet) + io $ writeIORef stateRef newState + +-- | Version of `go` not dependent on X monad (needed for testing). +goPure :: Monad x => Direction2D -> WNInput x -> x WNOutput +goPure dir input@(oldState, oldWindowSet, mappedWindows, _) = + if length (filter (`S.member` mappedWindows) $ W.integrate' $ W.stack $ W.workspace $ W.current oldWindowSet) == 1 + then + -- Handle the special case of Full layout, when there's only one mapped window on a screen. + return ( oldState + , case dir of + U -> W.focusUp oldWindowSet + L -> W.focusDown oldWindowSet + D -> W.focusDown oldWindowSet + R -> W.focusUp oldWindowSet + ) + else + withTargetWindow W.focusWindow dir input + +-- | Version of `swap` not dependent on X monad (needed for testing). +swapPure :: Monad x => Direction2D -> WNInput x -> x WNOutput +swapPure = withTargetWindow swapWithFocused where swapWithFocused targetWin winSet = case W.peek winSet of Just currentWin -> W.focusWindow currentWin $ @@ -135,87 +172,249 @@ swap = withTargetWindow swapWithFocused | win == win2 = win1 | otherwise = win -withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X () -withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do - targets <- filter ((/= win) . fst) <$> navigableTargets pos dir - whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do - windows (adj targetWin) - setPosition posRef pos targetRect +-- | Select a target window in the given direction and modify the WindowSet. +-- 1. Get current position, verifying it matches the current window (exit if no focused window). +-- 2. Get the target window. +-- 3. Execute an action on the target window and windowset. +-- 4. Set the new position. +withTargetWindow :: Monad x => (Window -> WindowSet -> WindowSet) -> Direction2D -> WNInput x -> x WNOutput +withTargetWindow adj dir input@(oldState, oldWindowSet, _, _) = do + whenJust' (getCurrentWindow input) (oldState, oldWindowSet) $ \(win, winRect, pos) -> do + targetMaybe <- find ((/= win) . fst) <$> navigableTargets input dir winRect pos + whenJust' (pure targetMaybe) (oldState, oldWindowSet) $ \(targetWin, newPos) -> + let newWindowSet = adj targetWin oldWindowSet + in return (modifyState newWindowSet newPos oldState, newWindowSet) +-- | Update position on outside changes in windows. trackMovement :: IORef WNState -> X () -trackMovement posRef = fromCurrentPoint posRef $ \win pos -> - windowRect win >>= flip whenJust (setPosition posRef pos . snd) - -fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X () -fromCurrentPoint posRef f = withFocused $ \win -> - currentPosition posRef >>= f win - --- Gets the current position from the IORef passed in, or if nothing (say, from --- a restart), derives the current position from the current window. Also, --- verifies that the position is congruent with the current window (say, if you --- used mod-j/k or mouse or something). -currentPosition :: IORef WNState -> X Point -currentPosition posRef = do - root <- asks theRoot - currentWindow <- gets (W.peek . windowset) - currentRect <- maybe (Rectangle 0 0 0 0) snd <$> windowRect (fromMaybe root currentWindow) - - wsid <- gets (W.currentTag . windowset) - mp <- M.lookup wsid <$> io (readIORef posRef) - - return $ maybe (middleOf currentRect) (`inside` currentRect) mp - - where middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h) - -setPosition :: IORef WNState -> Point -> Rectangle -> X () -setPosition posRef oldPos newRect = do - wsid <- gets (W.currentTag . windowset) - io $ modifyIORef posRef $ M.insert wsid (oldPos `inside` newRect) - -inside :: Point -> Rectangle -> Point -Point x y `inside` Rectangle rx ry rw rh = - Point (x `within` (rx, rw)) (y `within` (ry, rh)) - where pos `within` (lower, dim) = if pos >= lower && pos < lower + fromIntegral dim - then pos - else midPoint lower dim +trackMovement stateRef = do + oldState <- io (readIORef stateRef) + oldWindowSet <- gets windowset + mappedWindows <- gets mapped + whenJust' (getCurrentWindow (oldState, oldWindowSet, mappedWindows, windowRectX)) () $ \(_, _, pos) -> do + io $ writeIORef stateRef $ modifyState oldWindowSet pos oldState + +-- | Get focused window and current position. +getCurrentWindow :: Monad x => WNInput x -> x (Maybe (Window, Rectangle, Point)) +getCurrentWindow input@(_, oldWindowSet, _, _) = + whenJust' (pure $ W.peek oldWindowSet) Nothing $ \window -> do + (pos, rect) <- currentPosition input + return $ Just (window, rect, pos) + +-- | Gets the current position from the state passed in, or if nothing +-- (say, from a restart), derives the current position from the current window. +-- Also, verifies that the position is congruent with the current window +-- (say, if you moved focus using mouse or something). +-- Returns the window rectangle for convenience, since we'll need it later anyway. +currentPosition :: Monad x => WNInput x -> x (Point, Rectangle) +currentPosition (state, oldWindowSet, _, windowRect) = do + currentRect <- fromMaybe (Rectangle 0 0 0 0) <$> maybe (pure Nothing) windowRect (W.peek oldWindowSet) + let posMaybe = M.lookup (W.currentTag oldWindowSet) state + middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h) + return $ case posMaybe of + Nothing -> (middleOf currentRect, currentRect) + Just pos -> (centerPosition currentRect pos, currentRect) + +-- | Inserts new position into the state. +modifyState :: WindowSet -> Point -> WNState -> WNState +modifyState oldWindowSet = + M.insert (W.currentTag oldWindowSet) + +-- | "Jumps" the current position into the middle of target rectangle. +-- (keeps the position as-is if it is already inside the target rectangle) +centerPosition :: Rectangle -> Point -> Point +centerPosition r@(Rectangle rx ry rw rh) pos@(Point x y) = do + if pointWithin x y r + then pos + else Point (midPoint rx rw) (midPoint ry rh) midPoint :: Position -> Dimension -> Position midPoint pos dim = pos + fromIntegral dim `div` 2 -navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)] -navigableTargets point dir = navigable dir point <$> windowRects +-- | Make a list of target windows we can navigate to, +-- sorted by desirability of navigation. +navigableTargets :: Monad x => WNInput x -> Direction2D -> Rectangle -> Point -> x [(Window, Point)] +navigableTargets input@(_, oldWindowSet, _, _) dir currentRect currentPos = do + allScreensWindowsAndRectangles <- mapSnd (rectTransform dir) <$> windowRects input + let + screenWindows = S.fromList $ W.integrate' $ W.stack $ W.workspace $ W.current oldWindowSet + (thisScreenWindowsAndRectangles, otherScreensWindowsAndRectangles) = partition (\(w, _) -> S.member w screenWindows) allScreensWindowsAndRectangles + + pos = pointTransform dir currentPos + wr = rectTransform dir currentRect + + rectInside r = (rect_p1 r >= rect_p1 wr && rect_p1 r < rect_p2 wr && rect_p2 r > rect_p1 wr && rect_p2 r <= rect_p2 wr) && + ((rect_o1 r >= rect_o1 wr && rect_o1 r < rect_o2 wr && rect_o2 r > rect_o1 wr && rect_o2 r <= rect_o2 wr) || + (rect_o1 r <= rect_o1 wr && rect_o2 r >= rect_o2 wr)) -- include windows that fully overlaps current on the orthogonal axis + sortByP2 = sortOn (rect_p2 . snd) + posBeforeEdge r = point_p pos < rect_p2 r + + rectOverlapsEdge r = rect_p1 r <= rect_p2 wr && rect_p2 r > rect_p2 wr && + rect_o1 r < rect_o2 wr && rect_o2 r > rect_o1 wr + rectOverlapsOneEdge r = rectOverlapsEdge r && rect_p1 r > rect_p1 wr + rectOverlapsBothEdges r = rectOverlapsEdge r && + rect_o1 r > rect_o1 wr && rect_o2 r < rect_o2 wr && point_o pos >= rect_o1 r && point_o pos < rect_o2 r + distanceToRectEdge r = max (max 0 (rect_o1 r - point_o pos)) (max 0 (point_o pos + 1 - rect_o2 r)) + distanceToRectCenter r = + let distance = (rect_o1 r + rect_o2 r) `div` 2 - point_o pos + in if distance <= 0 + then distance + 1 + else distance + sortByPosDistance = sortOn ((\r -> (rect_p1 r, distanceToRectEdge r, distanceToRectCenter r)) . snd) + + rectOutside r = rect_p1 r < rect_p1 wr && rect_p2 r > rect_p2 wr && + rect_o1 r < rect_o1 wr && rect_o2 r > rect_o2 wr + sortByLength = sortOn (rect_psize . snd) + + rectAfterEdge r = rect_p1 r > rect_p2 wr + + -- Modified from David Roundy and Devin Mullins original implementation of WindowNavigation: + inr r = point_p pos < rect_p2 r && point_o pos >= rect_o1 r && point_o pos < rect_o2 r --- Filters and sorts the windows in terms of what is closest from the Point in --- the Direction2D. -navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)] -navigable d pt = sortby d . filter (inr d pt . snd) + clamp v v1 v2 | v < v1 = v1 + | v >= v2 = v2 - 1 + | otherwise = v + dragPos r = DirPoint (max (point_p pos) (rect_p1 r)) (clamp (point_o pos) (rect_o1 r) (rect_o2 r)) --- Produces a list of normal-state windows, on any screen. Rectangles are --- adjusted based on screen position relative to the current screen, because I'm --- bad like that. -windowRects :: X [(Window, Rectangle)] -windowRects = fmap catMaybes . mapM windowRect . S.toList =<< gets mapped + return $ mapSnd (inversePointTransform dir) $ concat + [ + -- First, navigate to windows that are fully inside current window + -- and have higher coordinate bigger than current position. + -- ┌──────────────────┐ + -- │ current │ (all examples assume direction=R) + -- │ ┌──────────┐ │ + -- │ ──┼─► inside │ │ + -- │ └──────────┘ │ + -- └──────────────────┘ + -- Also include windows fully overlapping current on the orthogonal axis: + -- ┌──────────────┐ + -- │ overlapping │ + -- ┌───────────┤ ├────┐ + -- │ current ──┼─► │ │ + -- └───────────┤ ├────┘ + -- └──────────────┘ + mapSnd dragPos $ sortByP2 $ filterSnd posBeforeEdge $ filterSnd rectInside thisScreenWindowsAndRectangles -windowRect :: Window -> X (Maybe (Window, Rectangle)) -windowRect win = withDisplay $ \dpy -> do + -- Then navigate to windows that touch or overlap the edge of current window in the chosen direction. + -- ┌──────────────┬─────────────┐ ┌───────────┐ ┌─────────────┐ + -- │ current │ adjacent │ │ current │ │ current │ + -- │ ──┼─► │ │ ┌───┴───────────────┐ │ ┌───┴─────────────┐ + -- │ │ │ │ ──┼─► │ overlapping │ │ ──┼─► │ + -- │ ├─────────────┘ │ └───┬───────────────┘ └─────────┤ overlapping │ + -- │ │ │ │ │ │ + -- └──────────────┘ └───────────┘ └─────────────────┘ + , mapSnd dragPos $ sortByPosDistance $ filterSnd rectOverlapsOneEdge thisScreenWindowsAndRectangles + + -- Windows fully overlapping current window "in the middle" on the parallel axis are also included, + -- if position is inside them: + -- ┌───────────┐ + -- │ current │ + -- ┌───┤-----------├────────────────┐ + -- │ │ * ──┼─► overlapping │ + -- └───┤-----------├────────────────┘ + -- └───────────┘ + , mapSnd (\_ -> DirPoint (rect_p2 wr) (point_o pos)) $ sortByPosDistance $ filterSnd rectOverlapsBothEdges thisScreenWindowsAndRectangles + + -- Then navigate to windows that fully encompass the current window. + -- ┌─────────────────────┐ + -- │ outer │ + -- │ ┌─────────────┐ │ + -- │ │ current ──┼─► │ + -- │ └─────────────┘ │ + -- └─────────────────────┘ + , mapSnd (\_ -> DirPoint (rect_p2 wr) (point_o pos)) $ sortByLength $ filterSnd rectOutside thisScreenWindowsAndRectangles + + -- Then navigate to windows that are fully after current window in the chosen direction. + -- ┌──────────────┐ + -- │ current │ ┌────────────────┐ + -- │ │ │ │ + -- │ ──┼──┼─► not adjacent │ + -- │ │ │ │ + -- │ │ └────────────────┘ + -- └──────────────┘ + , mapSnd dragPos $ sortByPosDistance $ filterSnd rectAfterEdge thisScreenWindowsAndRectangles + + -- Cast a ray from the current position, jump to the first window (on another screen) that intersects this ray. + , mapSnd dragPos $ sortByPosDistance $ filterSnd inr otherScreensWindowsAndRectangles + + -- If everything else fails, then navigate to the window that is fully inside current window, + -- but is before the current position. + -- This can happen when we are at the last window on a screen, and attempt to navigate even further. + -- In this case it seems okay to jump to the remaining inner windows, since we don't have any other choice anyway, + -- and user is probably not so fully aware of the precise position anyway. + , mapSnd (\r -> DirPoint (rect_p2 r - 1) (clamp (point_o pos) (rect_o1 r) (rect_o2 r))) $ + sortByP2 $ filterSnd (not . posBeforeEdge) $ filterSnd rectInside thisScreenWindowsAndRectangles + ] + +-- Structs for direction-independent space - equivalent to rotating points and rectangles such that +-- navigation direction points to the right. +-- Allows us to abstract over direction in the navigation functions. +data DirPoint = DirPoint + { point_p :: Position -- coordinate parallel to the direction + , point_o :: Position -- coordinate orthogonal to the direction + } +data DirRectangle = DirRectangle + { rect_p1 :: Position -- lower rectangle coordinate parallel to the direction + , rect_p2 :: Position -- higher rectangle coordinate parallel to the direction + , rect_o1 :: Position -- lower rectangle coordinate orthogonal to the direction + , rect_o2 :: Position -- higher rectangle coordinate orthogonal to the direction + } +{- HLINT ignore "Use camelCase" -} +rect_psize :: DirRectangle -> Dimension +rect_psize r = fromIntegral (rect_p2 r - rect_p1 r) + +-- | Transform a point from screen space into direction-independent space. +pointTransform :: Direction2D -> Point -> DirPoint +pointTransform dir (Point x y) = case dir of + U -> DirPoint (negate y - 1) x + L -> DirPoint (negate x - 1) (negate y - 1) + D -> DirPoint y (negate x - 1) + R -> DirPoint x y + +-- | Transform a point from direction-independent space back into screen space. +inversePointTransform :: Direction2D -> DirPoint -> Point +inversePointTransform dir p = case dir of + U -> Point (point_o p) (negate $ point_p p + 1) + L -> Point (negate $ point_p p + 1) (negate $ point_o p + 1) + D -> Point (negate $ point_o p + 1) (point_p p) + R -> Point (point_p p) (point_o p) + +-- | Transform a rectangle from screen space into direction-independent space. +rectTransform :: Direction2D -> Rectangle -> DirRectangle +rectTransform dir (Rectangle x y w h) = case dir of + U -> DirRectangle (negate $ y + fromIntegral h) (negate y) x (x + fromIntegral w) + L -> DirRectangle (negate $ x + fromIntegral w) (negate x) (negate $ y + fromIntegral h) (negate y) + D -> DirRectangle y (y + fromIntegral h) (negate $ x + fromIntegral w) (negate x) + R -> DirRectangle x (x + fromIntegral w) y (y + fromIntegral h) + +-- | Produces a list of normal-state windows on all screens, excluding currently focused window. +windowRects :: Monad x => WNInput x -> x [(Window, Rectangle)] +windowRects (_, oldWindowSet, mappedWindows, windowRect) = + let + allWindows = filter (\w -> w `notElem` W.peek oldWindowSet) $ S.toList mappedWindows + windowRect2 w = fmap (w,) <$> windowRect w + in catMaybes <$> mapM windowRect2 allWindows + +windowRectX :: Window -> X (Maybe Rectangle) +windowRectX win = withDisplay $ \dpy -> do (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win - return $ Just (win, Rectangle x y (w + 2 * bw) (h + 2 * bw)) + return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw) `catchX` return Nothing --- Modified from droundy's implementation of WindowNavigation: - -inr :: Direction2D -> Point -> Rectangle -> Bool -inr D (Point px py) (Rectangle rx ry w h) = px >= rx && px < rx + fromIntegral w && - py < ry + fromIntegral h -inr U (Point px py) (Rectangle rx ry w _) = px >= rx && px < rx + fromIntegral w && - py > ry -inr R (Point px py) (Rectangle rx ry w h) = px < rx + fromIntegral w && - py >= ry && py < ry + fromIntegral h -inr L (Point px py) (Rectangle rx ry _ h) = px > rx && - py >= ry && py < ry + fromIntegral h - -sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)] -sortby D = sortOn (rect_y . snd) -sortby R = sortOn (rect_x . snd) -sortby U = reverse . sortby D -sortby L = reverse . sortby R +-- Maybe below functions can be replaced with some standard helper functions? + +-- | Execute a monadic action on the contents if Just, otherwise wrap default value and return it. +whenJust' :: Monad x => x (Maybe a) -> b -> (a -> x b) -> x b +whenJust' monadMaybeValue deflt f = do + maybeValue <- monadMaybeValue + case maybeValue of + Nothing -> return deflt + Just value -> f value + +-- | Filter a list of tuples on the second tuple member. +filterSnd :: (b -> Bool) -> [(a, b)] -> [(a, b)] +filterSnd f = filter (f . snd) + +-- | Map a second tuple member in a list of tuples. +mapSnd :: (b -> b') -> [(a, b)] -> [(a, b')] +mapSnd f = map (second f) diff --git a/tests/Main.hs b/tests/Main.hs index 813ba921fd..35fc8d7788 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -14,6 +14,7 @@ import qualified CycleRecentWS import qualified OrgMode import qualified GridSelect import qualified EZConfig +import qualified WindowNavigation main :: IO () main = hspec $ do @@ -53,3 +54,4 @@ main = hspec $ do context "OrgMode" OrgMode.spec context "GridSelect" GridSelect.spec context "EZConfig" EZConfig.spec + context "WindowNavigation" WindowNavigation.spec diff --git a/tests/WindowNavigation.hs b/tests/WindowNavigation.hs new file mode 100644 index 0000000000..1176dcac13 --- /dev/null +++ b/tests/WindowNavigation.hs @@ -0,0 +1,635 @@ +{-# OPTIONS_GHC -Wall #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module WindowNavigation where + +import Test.Hspec + +import qualified Data.Map as M +import qualified Data.Set as S +import Data.Functor.Identity + +import XMonad +import XMonad.Util.Types (Direction2D(..)) +import XMonad.Actions.WindowNavigation (goPure, swapPure, WNState) +import qualified XMonad.StackSet as W + +spec :: Spec +spec = do + it "two-window adjacent go right (empty state)" $ do + -- Simplest case - just move the focus once. + -- ┌─────┬──────┐ + -- │ 1 ──┼─► 2 │ + -- └─────┴──────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 1280) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect) + runNav R M.empty (mkws 1 [] [2]) + `shouldBe` (mkstate 960 640, mkws 2 [1] []) + + it "two-window adjacent go right (populated state)" $ do + -- Like the previous test, but this time internal stat is already populated with a position. + -- ┌─────┬──────┐ + -- │ 1 ──┼─► 2 │ + -- └─────┴──────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 1280) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect) + runNav R (mkstate 100 100) (mkws 1 [] [2]) + `shouldBe` (mkstate 960 100, mkws 2 [1] []) + + it "two-window adjacent go right (incorrectly-populated state)" $ do + -- This time we set the position incorrectly, testing if it will be reset to the center of focused window. + -- ┌─────┬──────┐ + -- │ 1 ──┼─► 2 │ + -- └─────┴──────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 1280) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect) + runNav R (mkstate 1000 100) (mkws 1 [] [2]) + `shouldBe` (mkstate 960 640, mkws 2 [1] []) + + it "swap windows" $ do + -- Swap windows around. + -- ┌─────┬──────┐ + -- │ 1 ◄─┼─► 2 │ + -- └─────┴──────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 1280) + ] + runIdentity (swapPure R (M.empty, mkws 1 [] [2], S.fromList [1, 2], windowRect)) + `shouldBe` (mkstate 960 640, mkws 1 [2] []) + + it "tall layout, go up" $ do + -- ┌─────┬─────┐ + -- │ │ 2 ▲ │ + -- │ 1 ├───┼─┤ + -- │ │ 3 │ │ + -- └─────┴─────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 640) + , (3, Rectangle 960 640 960 640) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2, 3], windowRect) + runNav U M.empty (mkws 3 [] [1, 2]) + `shouldBe` (mkstate 1440 639, mkws 2 [1, 3] []) + + it "tall layout, go down" $ do + -- ┌─────┬─────┐ + -- │ │ 2 │ + -- │ ├─────┤ + -- │ 1 │ 3 │ │ + -- │ ├───┼─┤ + -- │ │ 4 ▼ │ + -- └─────┴─────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 400) + , (3, Rectangle 960 400 960 400) + , (4, Rectangle 960 800 960 480) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect) + runNav D M.empty (mkws 3 [] [1, 2, 4]) + `shouldBe` (mkstate 1440 800, mkws 4 [2, 1, 3] []) + + it "tall layout, go left" $ do + -- ┌─────┬─────┐ + -- │ ◄─┼── 2 │ + -- │ ├─────┤ + -- │ 1 │ 3 │ + -- │ ├─────┤ + -- │ │ 4 │ + -- └─────┴─────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 400) + , (3, Rectangle 960 400 960 400) + , (4, Rectangle 960 800 960 480) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect) + runNav L M.empty (mkws 2 [] [1, 3, 4]) + `shouldBe` (mkstate 959 200, mkws 1 [2] [3, 4]) + + it "tall layout, go left and then right (window 2)" $ do + -- ┌─────┬─────┐ + -- │ ◄─┼── 2 │ + -- │ ──┼─► │ + -- │ ├─────┤ + -- │ 1 │ 3 │ + -- │ ├─────┤ + -- │ │ 4 │ + -- └─────┴─────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 400) + , (3, Rectangle 960 400 960 400) + , (4, Rectangle 960 800 960 480) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect) + let (st2, ws2) = runNav L M.empty (mkws 2 [] [1, 3, 4]) + (st2, ws2) `shouldBe` (mkstate 959 200, mkws 1 [2] [3, 4]) + let (st3, ws3) = runNav R st2 ws2 + (st3, ws3) `shouldBe` (mkstate 960 200, mkws 2 [] [1, 3, 4]) + + it "tall layout, go left and then right (window 3)" $ do + -- ┌─────┬─────┐ + -- │ │ 2 │ + -- │ ├─────┤ + -- │ 1 ◄─┼── 3 │ + -- │ ──┼─► │ + -- │ ├─────┤ + -- │ │ 4 │ + -- └─────┴─────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 400) + , (3, Rectangle 960 400 960 400) + , (4, Rectangle 960 800 960 480) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect) + let (st2, ws2) = runNav L M.empty (mkws 3 [] [1, 2, 4]) + (st2, ws2) `shouldBe` (mkstate 959 600, mkws 1 [3] [2, 4]) + let (st3, ws3) = runNav R st2 ws2 + (st3, ws3) `shouldBe` (mkstate 960 600, mkws 3 [] [1, 2, 4]) + + it "tall layout, go left and then right (window 4)" $ do + -- ┌─────┬─────┐ + -- │ │ 2 │ + -- │ ├─────┤ + -- │ 1 │ 3 │ + -- │ ├─────┤ + -- │ ◄─┼── 4 │ + -- │ ──┼─► │ + -- └─────┴─────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 400) + , (3, Rectangle 960 400 960 400) + , (4, Rectangle 960 800 960 480) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect) + let (st2, ws2) = runNav L M.empty (mkws 4 [] [1, 2, 3]) + (st2, ws2) `shouldBe` (mkstate 959 1040, mkws 1 [4] [2, 3]) + let (st3, ws3) = runNav R st2 ws2 + (st3, ws3) `shouldBe` (mkstate 960 1040, mkws 4 [] [1, 2, 3]) + + it "grid layout, go in a circle" $ do + -- ┌─────┬─────┐ + -- │ 1 ──┼─► 2 │ + -- │ │ │ + -- │ ▲ │ │ │ + -- ├─┼───┼───┼─┤ + -- │ │ │ ▼ │ + -- │ │ │ + -- │ 3 ◄─┼── 4 │ + -- └─────┴─────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 640) + , (2, Rectangle 960 0 960 640) + , (3, Rectangle 0 640 960 640) + , (4, Rectangle 960 640 960 640) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect) + let (st2, ws2) = runNav R M.empty (mkws 1 [] [2, 3, 4]) + (st2, ws2) `shouldBe` (mkstate 960 320, mkws 2 [1] [3, 4]) + let (st3, ws3) = runNav D st2 ws2 + (st3, ws3) `shouldBe` (mkstate 960 640, mkws 4 [3, 2, 1] []) + let (st4, ws4) = runNav L st3 ws3 + (st4, ws4) `shouldBe` (mkstate 959 640, mkws 3 [2, 1] [4]) + let (st5, ws5) = runNav U st4 ws4 + (st5, ws5) `shouldBe` (mkstate 959 639, mkws 1 [] [2, 3, 4]) + + it "ignore window that fully overlaps the current window in parallel direction when pos is outside it" $ do + -- ┌─────┬──────┬──────┐ + -- │ ┌───┴──────┴────┐ │ + -- │ │ | 4 | │ │ + -- │ └───┬──────┬────┘ │ + -- │ 1 │ 2 ──┼─► 3 │ + -- └─────┴──────┴──────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 600 1280) + , (2, Rectangle 600 0 600 1280) + , (3, Rectangle 1200 0 720 1280) + , (4, Rectangle 200 200 1520 400) + ] + runIdentity (goPure R (mkstate 900 900, mkws 2 [] [1, 3, 4], S.fromList [1..4], windowRect)) + `shouldBe` (mkstate 1200 900, mkws 3 [1,2] [4]) + + it "go to window that fully overlaps the current window in parallel direction when pos is inside it" $ do + -- ┌─────────────────┐ + -- │ ┌──────┐ │ + -- │ 1 │ │ │ + -- ├─────┤------├────┤ + -- │ │ │ │ + -- │ 2 │ 4 ──┼─► │ + -- │ │ │ │ + -- ├─────┤------├────┤ + -- │ 3 │ │ │ + -- │ └──────┘ │ + -- └─────────────────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 1920 400) + , (2, Rectangle 0 400 1920 400) + , (3, Rectangle 0 800 1920 480) + , (4, Rectangle 800 200 400 880) + ] + runIdentity (goPure R (mkstate 1000 600, mkws 4 [] [1, 2, 3], S.fromList [1..4], windowRect)) + `shouldBe` (mkstate 1200 600, mkws 2 [1,4] [3]) + + it "go from inner window to outer" $ do + -- ┌───────────────┐ + -- │ ┌──────┐ │ + -- │ 1 ◄─┼── 2 │ │ + -- │ └──────┘ │ + -- └───────────────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 1920 1280) + , (2, Rectangle 600 600 600 600) + ] + runIdentity (goPure L (M.empty, mkws 2 [] [1], S.fromList [1, 2], windowRect)) + `shouldBe` (mkstate 599 900, mkws 1 [2] []) + + it "if there are multiple outer windows, go to the smaller one" $ do + -- ┌────────────────────────┐ + -- │ ┌───────────────┐ │ + -- │ │ ┌──────┐ │ │ + -- │ │ 2 ◄─┼── 3 │ │ 1 │ + -- │ │ └──────┘ │ │ + -- │ └───────────────┘ │ + -- └────────────────────────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 1920 1280) + , (2, Rectangle 200 200 1520 880) + , (3, Rectangle 400 400 400 400) + ] + runIdentity (goPure L (M.empty, mkws 3 [] [1, 2], S.fromList [1..3], windowRect)) + `shouldBe` (mkstate 399 600, mkws 2 [1, 3] []) + + it "two tiled and one floating, floating fully inside" $ do + -- ┌───────────────────┬─────┐ + -- │ ┌───────┐ │ │ + -- │ ──┼─► ──┼─► ──┼─► │ + -- │ │ 3 │ 1 │ 2 │ + -- │ │ ◄─┼── ◄─┼── │ + -- │ └───────┘ │ │ + -- └───────────────────┴─────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 1280) + , (3, Rectangle 400 400 400 400) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect) + let (st2, ws2) = runNav R (mkstate 100 100) (mkws 1 [] [2, 3]) + (st2, ws2) `shouldBe` (mkstate 400 400, mkws 3 [2, 1] []) + let (st3, ws3) = runNav R st2 ws2 + (st3, ws3) `shouldBe` (mkstate 800 400, mkws 1 [] [2, 3]) + let (st4, ws4) = runNav R st3 ws3 + (st4, ws4) `shouldBe` (mkstate 960 400, mkws 2 [1] [3]) + let (st5, ws5) = runNav L st4 ws4 + (st5, ws5) `shouldBe` (mkstate 959 400, mkws 1 [] [2, 3]) + let (st6, ws6) = runNav L st5 ws5 + (st6, ws6) `shouldBe` (mkstate 799 400, mkws 3 [2, 1] []) + + it "two floating windows inside one big tiled one" $ do + -- ┌─────────┐ + -- │ │ │ + -- │ ┌──┼──┐ │ + -- │ │ ▼ │ │ + -- │ │ 3 │ │ + -- │ └──┼──┘ │ + -- │ ▼ │ + -- │ 1 │ + -- │ ┌──┼──┐ │ + -- │ │ ▼ │ │ + -- │ │ 4 │ │ + -- │ └──┼──┘ │ + -- │ ▼ │ + -- ├────┼────┤ + -- │ ▼ │ + -- │ 2 │ + -- └─────────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 1920 640) + , (2, Rectangle 0 640 1920 640) + , (3, Rectangle 200 200 100 100) + , (4, Rectangle 1000 400 100 100) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect) + let (st2, ws2) = runNav D (mkstate 1000 250) (mkws 1 [] [2, 3, 4]) + (st2, ws2) `shouldBe` (mkstate 299 250, mkws 3 [2, 1] [4]) + let (st3, ws3) = runNav D st2 ws2 + (st3, ws3) `shouldBe` (mkstate 299 300, mkws 1 [] [2, 3, 4]) + let (st4, ws4) = runNav D st3 ws3 + (st4, ws4) `shouldBe` (mkstate 1000 400, mkws 4 [3, 2, 1] []) + let (st5, ws5) = runNav D st4 ws4 + (st5, ws5) `shouldBe` (mkstate 1000 500, mkws 1 [] [2, 3, 4]) + let (st6, ws6) = runNav D st5 ws5 + (st6, ws6) `shouldBe` (mkstate 1000 640, mkws 2 [1] [3, 4]) + + it "floating window between two tiled ones" $ do + -- ┌───────┬────────┐ + -- │ 1 ┌───┴───┐ 2 │ + -- │ ──┼─► 3 ──┼─► │ + -- │ └───┬───┘ │ + -- └───────┴────────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 1280) + , (3, Rectangle 860 540 200 200) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect) + let (st2, ws2) = runNav R M.empty (mkws 1 [] [2, 3]) + (st2, ws2) `shouldBe` (mkstate 860 640, mkws 3 [2, 1] []) + let (st3, ws3) = runNav R st2 ws2 + (st3, ws3) `shouldBe` (mkstate 960 640, mkws 2 [1] [3]) + + it "floating window overlapping four tiled ones" $ do + -- ┌───────┬───────┐ + -- │ ┌───┴───┐ │ + -- │ 1 │ │ 2 │ + -- ├───┤ ├───┤ + -- │ ──┼─► 5 ──┼─► │ + -- │ 3 └───┬───┘ 4 │ + -- └───────┴───────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 640) + , (2, Rectangle 960 0 960 640) + , (3, Rectangle 0 640 960 640) + , (4, Rectangle 960 640 960 640) + , (5, Rectangle 760 440 400 400) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..5], windowRect) + let (st2, ws2) = runNav R (mkstate 480 640) (mkws 3 [] [1, 2, 4, 5]) + (st2, ws2) `shouldBe` (mkstate 760 640, mkws 5 [4, 2, 1, 3] []) + let (st3, ws3) = runNav R st2 ws2 + (st3, ws3) `shouldBe` (mkstate 960 640, mkws 4 [2, 1, 3] [5]) + + it "sequential inner floating windows" $ do + -- ┌───────────────────────────────────┬──────┐ + -- │ ┌───────┐ │ │ + -- │ │ │ ┌───────┐ │ │ + -- │ ──┼─► 3 ──┼─► 1 ──┼─► 4 ──┼─► ──┼─► 2 │ + -- │ ◄─┼── ◄─┼── ◄─┼── ◄─┼── ◄─┼── │ + -- │ └───────┘ │ │ │ │ + -- │ └───────┘ │ │ + -- └───────────────────────────────────┴──────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 1280) + , (3, Rectangle 200 200 200 200) + , (4, Rectangle 600 600 200 200) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect) + let (st2, ws2) = runNav R (mkstate 100 100) (mkws 1 [] [2, 3, 4]) + (st2, ws2) `shouldBe` (mkstate 200 200, mkws 3 [2,1] [4]) + let (st3, ws3) = runNav R st2 ws2 + (st3, ws3) `shouldBe` (mkstate 400 200, mkws 1 [] [2, 3, 4]) + let (st4, ws4) = runNav R st3 ws3 + (st4, ws4) `shouldBe` (mkstate 600 600, mkws 4 [3, 2, 1] []) + let (st5, ws5) = runNav R st4 ws4 + (st5, ws5) `shouldBe` (mkstate 800 600, mkws 1 [] [2, 3, 4]) + let (st6, ws6) = runNav R st5 ws5 + (st6, ws6) `shouldBe` (mkstate 960 600, mkws 2 [1] [3, 4]) + let (st7, ws7) = runNav L st6 ws6 + (st7, ws7) `shouldBe` (mkstate 959 600, mkws 1 [] [2, 3, 4]) + let (st8, ws8) = runNav L st7 ws7 + (st8, ws8) `shouldBe` (mkstate 799 600, mkws 4 [3, 2, 1] []) + let (st9, ws9) = runNav L st8 ws8 + (st9, ws9) `shouldBe` (mkstate 599 600, mkws 1 [] [2, 3, 4]) + let (st10, ws10) = runNav L st9 ws9 + (st10, ws10) `shouldBe` (mkstate 399 399, mkws 3 [2, 1] [4]) + let (st11, ws11) = runNav L st10 ws10 + (st11, ws11) `shouldBe` (mkstate 199 399, mkws 1 [] [2, 3, 4]) + + it "overlapping inner floating windows" $ do + -- ┌─────────────────────┬──────┐ + -- │ ┌─────────┐ │ │ + -- │ │ 3 ┌────┴─┐ │ │ + -- │ │ ──┼─► ──┼─► 1 ──┼─► 2 │ + -- │ │ ◄─┼── ◄─┼── ◄─┼── │ + -- │ │ │ 4 │ │ │ + -- │ └────┤ │ │ │ + -- │ └──────┘ │ │ + -- └─────────────────────┴──────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 1280) + , (3, Rectangle 200 200 400 400) + , (4, Rectangle 300 300 400 400) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect) + let (st2, ws2) = runNav R M.empty (mkws 3 [] [1, 2, 4]) + (st2, ws2) `shouldBe` (mkstate 400 400, mkws 4 [2, 1, 3] []) + let (st3, ws3) = runNav R st2 ws2 + (st3, ws3) `shouldBe` (mkstate 700 400, mkws 1 [3] [2, 4]) + let (st4, ws4) = runNav R st3 ws3 + (st4, ws4) `shouldBe` (mkstate 960 400, mkws 2 [1, 3] [4]) + let (st5, ws5) = runNav L st4 ws4 + (st5, ws5) `shouldBe` (mkstate 959 400, mkws 1 [3] [2, 4]) + let (st6, ws6) = runNav L st5 ws5 + (st6, ws6) `shouldBe` (mkstate 699 400, mkws 4 [2, 1, 3] []) + let (st7, ws7) = runNav L st6 ws6 + (st7, ws7) `shouldBe` (mkstate 599 400, mkws 3 [] [1, 2, 4]) + + it "bounce back from the wall to the floating window" $ do + -- ┌────────────────┬─────┐ + -- │ 1 ┌──────┐ │ │ + -- │ ┌───┼─► 3 │ │ 2 │ + -- │ └── │ │ │ │ + -- │ └──────┘ │ │ + -- └────────────────┴─────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 1280) + , (3, Rectangle 400 400 200 200) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect) + runNav L (mkstate 100 640) (mkws 1 [] [2, 3]) + `shouldBe` (mkstate 400 599, mkws 3 [2, 1] []) + + it "jump between screens" $ do + -- ┌─────┬──────┐ ┌────────┐ + -- │ │ 2 │ │ 5 │ + -- │ ├──────┤ ├────────┤ + -- │ 1 │ 3 ──┼──┼─► 6 │ + -- │ ├──────┤ └────────┘ + -- │ │ 4 │ + -- └─────┴──────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 400) + , (3, Rectangle 960 400 960 400) + , (4, Rectangle 960 800 960 480) + , (5, Rectangle 1920 0 1280 384) + , (6, Rectangle 1920 384 1280 384) + ] + initWindowSet = + W.StackSet + { W.current = + W.Screen + { W.workspace = + W.Workspace + { W.tag = "A" + , W.layout = Layout NullLayout + , W.stack = Just $ W.Stack { W.focus = 3, W.up = [], W.down = [1, 2, 4] } + } + , W.screen = 1 + , W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 } + } + , W.visible = + [ W.Screen + { W.workspace = + W.Workspace + { W.tag = "B" + , W.layout = Layout NullLayout + , W.stack = Just $ W.Stack { W.focus = 5, W.up = [], W.down = [6] } + } + , W.screen = 2 + , W.screenDetail = SD { screenRect = Rectangle 1920 0 1280 768 } + } + ] + , W.hidden = [] + , W.floating = M.empty + } + expectedWindowSet = + W.StackSet + { W.current = + W.Screen + { W.workspace = + W.Workspace + { W.tag = "B" + , W.layout = Layout NullLayout + , W.stack = Just $ W.Stack { W.focus = 6, W.up = [5], W.down = [] } + } + , W.screen = 2 + , W.screenDetail = SD { screenRect = Rectangle 1920 0 1280 768 } + } + , W.visible = + [ W.Screen + { W.workspace = + W.Workspace + { W.tag = "A" + , W.layout = Layout NullLayout + , W.stack = Just $ W.Stack { W.focus = 3, W.up = [], W.down = [1, 2, 4] } + } + , W.screen = 1 + , W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 } + } + ] + , W.hidden = [] + , W.floating = M.empty + } + + runIdentity (goPure R (M.empty, initWindowSet, S.fromList [1..6], windowRect)) + `shouldBe` (M.fromList [("B", Point 1920 600)], expectedWindowSet) + + it "floating window overlapping fully in the orthogonal direction" $ do + -- ┌─────┬──────────────────┐ + -- │ │ ┌───────┐ │ + -- │ │ 2 │ │ │ + -- │ ├──────┤-------├───┤ + -- │ 1 │ 3 │ │ 3 │ + -- │ ◄─┼── ◄─┼── 5 ◄─┼── │ + -- │ ├──────┤-------├───┤ + -- │ │ 4 │ │ │ + -- │ │ └───────┘ │ + -- └─────┴──────────────────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 960 0 960 400) + , (3, Rectangle 960 400 960 400) + , (4, Rectangle 960 800 960 480) + , (5, Rectangle 1360 200 200 800) + ] + runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..5], windowRect) + let (st2, ws2) = runNav L (mkstate 1800 600) (mkws 3 [] [1, 2, 4, 5]) + (st2, ws2) `shouldBe` (mkstate 1559 600, mkws 5 [4, 2, 1, 3] []) + let (st3, ws3) = runNav L st2 ws2 + (st3, ws3) `shouldBe` (mkstate 1359 600, mkws 3 [] [1, 2, 4, 5]) + let (st4, ws4) = runNav L st3 ws3 + (st4, ws4) `shouldBe` (mkstate 959 600, mkws 1 [3] [2, 4, 5]) + + it "navigation to free-floating windows on the same screen" $ do + -- ┌──────┐ + -- │ │ ┌──────┐ + -- │ │ │ │ + -- │ ──┼──┼─► 2 │ + -- │ │ │ │ + -- │ 1 │ └──────┘ + -- │ │ + -- │ │ + -- └──────┘ + let windowRect w = + Identity $ M.lookup w $ M.fromList + [ (1, Rectangle 0 0 960 1280) + , (2, Rectangle 1200 400 400 400) + ] + runIdentity (goPure R (M.empty, mkws 1 [] [2], S.fromList [1, 2], windowRect)) + `shouldBe` (mkstate 1200 640, mkws 2 [1] []) + + it "switch between windows in Full layout" $ do + let windowRect w = Identity $ M.lookup w $ M.fromList [(1, Rectangle 0 0 1920 1280)] + runIdentity (goPure D (M.empty, mkws 1 [] [2, 3], S.fromList [1], windowRect)) + `shouldBe` (M.empty, mkws 2 [1] [3]) + +data NullLayout a = NullLayout deriving (Show, Read, Eq) +instance LayoutClass NullLayout a + +-- to make WindowSets comparable +instance Eq (Layout w) where + (==) a b = show a == show b + (/=) a b = show a /= show b + +-- make a state with a position for a single workspace +mkstate :: Position -> Position -> WNState +mkstate px py = M.fromList [("A", Point px py)] + +-- make a single-workspace WindowSet +mkws :: Window -> [Window] -> [Window] -> WindowSet +mkws focusedWindow upWindows downWindows = W.StackSet + { W.current = W.Screen + { W.workspace = W.Workspace + { W.tag = "A" + , W.layout = Layout NullLayout + , W.stack = Just $ W.Stack { W.focus = focusedWindow, W.up = upWindows, W.down = downWindows } + } + , W.screen = 1 + , W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 } + } + , W.visible = [] + , W.hidden = [] + , W.floating = M.empty + } diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index f40128b417..b159100094 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -429,6 +429,7 @@ test-suite tests RotateSome Selective SwapWorkspaces + WindowNavigation Utils XMonad.Actions.CopyWindow XMonad.Actions.CycleRecentWS @@ -443,6 +444,7 @@ test-suite tests XMonad.Actions.TagWindows XMonad.Actions.WindowBringer XMonad.Actions.WindowGo + XMonad.Actions.WindowNavigation XMonad.Hooks.ManageDocks XMonad.Hooks.ManageHelpers XMonad.Hooks.UrgencyHook