twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-05-19 03:20:21 -07:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #896 from Rogach/pr/window-navigation

Browse Source 
X.A.WindowNavigation: better handling of floating windows and Full layout
This commit is contained in:
Tony Zorman 2024-07-28 20:16:44 +02:00 committed by GitHub
commit eb7268451c
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
5 changed files with 924 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
CHANGES.md
View File

@ -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)

359
XMonad/Actions/WindowNavigation.hs
View File

@ -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 <droundy@darcs.net>,
-- Devin Mullins <me@twifkak.com>
-- Maintainer : Devin Mullins <me@twifkak.com>
-- Maintainer : Devin Mullins <me@twifkak.com>,
-- Platon Pronko <platon7pronko@gmail.com>
-- 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)
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
fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X ()
fromCurrentPoint posRef f = withFocused $ \win ->
currentPosition posRef >>= f win
-- | 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 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)
-- | 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)
wsid <- gets (W.currentTag . windowset)
mp <- M.lookup wsid <$> io (readIORef posRef)
-- | Inserts new position into the state.
modifyState :: WindowSet -> Point -> WNState -> WNState
modifyState oldWindowSet =
M.insert (W.currentTag oldWindowSet)
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
-- | "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 midPoint lower dim
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
-- 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)
pos = pointTransform dir currentPos
wr = rectTransform dir currentRect
-- 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
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
windowRect :: Window -> X (Maybe (Window, Rectangle))
windowRect win = withDisplay $ \dpy -> do
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
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))
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
-- 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:
-- Maybe below functions can be replaced with some standard helper functions?
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
-- | 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
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
-- | 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)

2
tests/Main.hs
View File

@ -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

635
tests/WindowNavigation.hs Normal file
View File

@ -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
}

2
xmonad-contrib.cabal
View File

@ -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