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
xmonad-contrib/XMonad/Actions/Navigation2D.hs
L.S. Leary ea6e1a5d6d Removed extraneous blank line from Nav2D.
2016-08-29 16:53:46 +12:00

887 lines
44 KiB
Haskell
Raw Blame History

{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, PatternGuards, RankNTypes, TypeSynonymInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.Navigation2D
-- Copyright : (c) 2011 Norbert Zeh <nzeh@cs.dal.ca>
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Norbert Zeh <nzeh@cs.dal.ca>
-- Stability : unstable
-- Portability : unportable
--
-- Navigation2D is an xmonad extension that allows easy directional
-- navigation of windows and screens (in a multi-monitor setup).
-----------------------------------------------------------------------------
module XMonad.Actions.Navigation2D ( -- * Usage
-- $usage
-- * Finer points
-- $finer_points
-- * Alternative directional navigation modules
-- $alternatives
-- * Incompatibilities
-- $incompatibilities
-- * Detailed technical discussion
-- $technical
-- * Exported functions and types
-- #Exports#
navigation2D
, navigation2DP
, additionalNav2DKeys
, additionalNav2DKeysP
, withNavigation2DConfig
, Navigation2DConfig(..)
, def
, defaultNavigation2DConfig
, Navigation2D
, lineNavigation
, centerNavigation
, hybridNavigation
, fullScreenRect
, singleWindowRect
, switchLayer
, windowGo
, windowSwap
, windowToScreen
, screenGo
, screenSwap
, Direction2D(..)
) where
import Control.Applicative
import qualified Data.List as L
import qualified Data.Map as M
import Data.Maybe
import XMonad hiding (Screen)
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.EZConfig (additionalKeys, additionalKeysP)
import XMonad.Util.Types
-- $usage
-- #Usage#
-- Navigation2D provides directional navigation (go left, right, up, down) for
-- windows and screens. It treats floating and tiled windows as two separate
-- layers and provides mechanisms to navigate within each layer and to switch
-- between layers. Navigation2D provides two different navigation strategies
-- (see <#Technical_Discussion> for details): /Line navigation/ feels rather
-- natural but may make it impossible to navigate to a given window from the
-- current window, particularly in the floating layer. /Center navigation/
-- feels less natural in certain situations but ensures that all windows can be
-- reached without the need to involve the mouse. A third option is to use
-- /Hybrid navigation/, which automatically chooses between the two whenever
-- navigation is attempted. Navigation2D allows different navigation strategies
-- to be used in the two layers and allows customization of the navigation strategy
-- for the tiled layer based on the layout currently in effect.
--
-- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.Navigation2D
--
-- Then add the configuration of the module to your main function:
--
-- > main = xmonad $ navigation2D def
-- > (xK_Up, xK_Left, xK_Down, xK_Right)
-- > [(mod4Mask, windowGo ),
-- > (mod4Mask .|. shiftMask, windowSwap)]
-- > False
-- > $ def
--
-- Alternatively, you can use navigation2DP:
--
-- > main = xmonad $ navigation2D def
-- > ("<Up>", "<Left>", "<Down>", "<Right>")
-- > [("M-", windowGo ),
-- > ("M-S-", windowSwap)]
-- > False
-- > $ def
--
-- That's it. If instead you'd like more control, you can combine
-- withNavigation2DConfig and additionalNav2DKeys or additionalNav2DKeysP:
--
-- > main = xmonad $ withNavigation2DConfig def
-- > $ additionalNav2DKeys (xK_Up, xK_Left, xK_Down, xK_Right)
-- > [(mod4Mask, windowGo ),
-- > (mod4Mask .|. shiftMask, windowSwap)]
-- > False
-- > $ additionalNav2DKeys (xK_u, xK_l, xK_d, xK_r)
-- > [(mod4Mask, screenGo ),
-- > (mod4Mask .|. shiftMask, screenSwap)]
-- > False
-- > $ def
--
-- Or you can add the configuration of the module to your main function:
--
-- > main = xmonad $ withNavigation2DConfig def $ def
--
-- And specify your keybindings normally:
--
-- > -- Switch between layers
-- > , ((modm, xK_space), switchLayer)
-- >
-- > -- Directional navigation of windows
-- > , ((modm, xK_Right), windowGo R False)
-- > , ((modm, xK_Left ), windowGo L False)
-- > , ((modm, xK_Up ), windowGo U False)
-- > , ((modm, xK_Down ), windowGo D False)
-- >
-- > -- Swap adjacent windows
-- > , ((modm .|. controlMask, xK_Right), windowSwap R False)
-- > , ((modm .|. controlMask, xK_Left ), windowSwap L False)
-- > , ((modm .|. controlMask, xK_Up ), windowSwap U False)
-- > , ((modm .|. controlMask, xK_Down ), windowSwap D False)
-- >
-- > -- Directional navigation of screens
-- > , ((modm, xK_r ), screenGo R False)
-- > , ((modm, xK_l ), screenGo L False)
-- > , ((modm, xK_u ), screenGo U False)
-- > , ((modm, xK_d ), screenGo D False)
-- >
-- > -- Swap workspaces on adjacent screens
-- > , ((modm .|. controlMask, xK_r ), screenSwap R False)
-- > , ((modm .|. controlMask, xK_l ), screenSwap L False)
-- > , ((modm .|. controlMask, xK_u ), screenSwap U False)
-- > , ((modm .|. controlMask, xK_d ), screenSwap D False)
-- >
-- > -- Send window to adjacent screen
-- > , ((modm .|. mod1Mask, xK_r ), windowToScreen R False)
-- > , ((modm .|. mod1Mask, xK_l ), windowToScreen L False)
-- > , ((modm .|. mod1Mask, xK_u ), windowToScreen U False)
-- > , ((modm .|. mod1Mask, xK_d ), windowToScreen D False)
--
-- For detailed instruction on editing the key binding see:
--
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- $finer_points
-- #Finer_Points#
-- The above should get you started. Here are some finer points:
--
-- Navigation2D has the ability to wrap around at screen edges. For example, if
-- you navigated to the rightmost window on the rightmost screen and you
-- continued to go right, this would get you to the leftmost window on the
-- leftmost screen. This feature may be useful for switching between screens
-- that are far apart but may be confusing at least to novice users. Therefore,
-- it is disabled in the above example (e.g., navigation beyond the rightmost
-- window on the rightmost screen is not possible and trying to do so will
-- simply not do anything.) If you want this feature, change all the 'False'
-- values in the above example to 'True'. You could also decide you want
-- wrapping only for a subset of the operations and no wrapping for others.
--
-- By default, all layouts use the 'defaultTiledNavigation' strategy specified
-- in the 'Navigation2DConfig' (by default, line navigation is used). To
-- override this behaviour for some layouts, add a pair (\"layout name\",
-- navigation strategy) to the 'layoutNavigation' list in the
-- 'Navigation2DConfig', where \"layout name\" is the string reported by the
-- layout's description method (normally what is shown as the layout name in
-- your status bar). For example, all navigation strategies normally allow only
-- navigation between mapped windows. The first step to overcome this, for
-- example, for the Full layout, is to switch to center navigation for the Full
-- layout:
--
-- > myNavigation2DConfig = def { layoutNavigation = [("Full", centerNavigation)] }
-- >
-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig
-- > $ def
--
-- The navigation between windows is based on their screen rectangles, which are
-- available /and meaningful/ only for mapped windows. Thus, as already said,
-- the default is to allow navigation only between mapped windows. However,
-- there are layouts that do not keep all windows mapped. One example is the
-- Full layout, which unmaps all windows except the one that has the focus,
-- thereby preventing navigation to any other window in the layout. To make
-- navigation to unmapped windows possible, unmapped windows need to be assigned
-- rectangles to pretend they are mapped, and a natural way to do this for the
-- Full layout is to pretend all windows occupy the full screen and are stacked
-- on top of each other so that only the frontmost one is visible. This can be
-- done as follows:
--
-- > myNavigation2DConfig = def { layoutNavigation = [("Full", centerNavigation)]
-- > , unmappedWindowRect = [("Full", singleWindowRect)]
-- > }
-- >
-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig
-- > $ def
--
-- With this setup, Left/Up navigation behaves like standard
-- 'XMonad.StackSet.focusUp' and Right/Down navigation behaves like
-- 'XMonad.StackSet.focusDown', thus allowing navigation between windows in the
-- layout.
--
-- In general, each entry in the 'unmappedWindowRect' association list is a pair
-- (\"layout description\", function), where the function computes a rectangle
-- for each unmapped window from the screen it is on and the window ID.
-- Currently, Navigation2D provides only two functions of this type:
-- 'singleWindowRect' and 'fullScreenRect'.
--
-- With per-layout navigation strategies, if different layouts are in effect on
-- different screens in a multi-monitor setup, and different navigation
-- strategies are defined for these active layouts, the most general of these
-- navigation strategies is used across all screens (because Navigation2D does
-- not distinguish between windows on different workspaces), where center
-- navigation is more general than line navigation, as discussed formally under
-- <#Technical_Discussion>.
-- $alternatives
-- #Alternatives#
--
-- There exist two alternatives to Navigation2D:
-- "XMonad.Actions.WindowNavigation" and "XMonad.Layout.WindowNavigation".
-- X.L.WindowNavigation has the advantage of colouring windows to indicate the
-- window that would receive the focus in each navigation direction, but it does
-- not support navigation across multiple monitors, does not support directional
-- navigation of floating windows, and has a very unintuitive definition of
-- which window receives the focus next in each direction. X.A.WindowNavigation
-- does support navigation across multiple monitors but does not provide window
-- colouring while retaining the unintuitive navigational semantics of
-- X.L.WindowNavigation. This makes it very difficult to predict which window
-- receives the focus next. Neither X.A.WindowNavigation nor
-- X.L.WindowNavigation supports directional navigation of screens.
-- $technical
-- #Technical_Discussion#
-- An in-depth discussion of the navigational strategies implemented in
-- Navigation2D, including formal proofs of their properties, can be found
-- at <http://www.cs.dal.ca/~nzeh/xmonad/Navigation2D.pdf>.
-- $incompatibilities
-- #Incompatibilities#
-- Currently Navigation2D is known not to play nicely with tabbed layouts, but
-- it should work well with any other tiled layout. My hope is to address the
-- incompatibility with tabbed layouts in a future version. The navigation to
-- unmapped windows, for example in a Full layout, by assigning rectangles to
-- unmapped windows is more a workaround than a clean solution. Figuring out
-- how to deal with tabbed layouts may also lead to a more general and cleaner
-- solution to query the layout for a window's rectangle that may make this
-- workaround unnecessary. At that point, the 'unmappedWindowRect' field of the
-- 'Navigation2DConfig' will disappear.
-- | A rectangle paired with an object
type Rect a = (a, Rectangle)
-- | A shorthand for window-rectangle pairs. Reduces typing.
type WinRect = Rect Window
-- | A shorthand for workspace-rectangle pairs. Reduces typing.
type WSRect = Rect WorkspaceId
----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
-- --
-- PUBLIC INTERFACE --
-- --
----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
-- | Encapsulates the navigation strategy
data Navigation2D = N Generality (forall a . Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a)
runNav :: forall a . Eq a => Navigation2D -> (Direction2D -> Rect a -> [Rect a] -> Maybe a)
runNav (N _ nav) = nav
-- | Score that indicates how general a navigation strategy is
type Generality = Int
instance Eq Navigation2D where
(N x _) == (N y _) = x == y
instance Ord Navigation2D where
(N x _) <= (N y _) = x <= y
-- | Line navigation. To illustrate this navigation strategy, consider
-- navigating to the left from the current window. In this case, we draw a
-- horizontal line through the center of the current window and consider all
-- windows that intersect this horizontal line and whose right boundaries are to
-- the left of the left boundary of the current window. From among these
-- windows, we choose the one with the rightmost right boundary.
lineNavigation :: Navigation2D
lineNavigation = N 1 doLineNavigation
-- | Center navigation. Again, consider navigating to the left. Then we
-- consider the cone bounded by the two rays shot at 45-degree angles in
-- north-west and south-west direction from the center of the current window. A
-- window is a candidate to receive the focus if its center lies in this cone.
-- We choose the window whose center has minimum L1-distance from the current
-- window center. The tie breaking strategy for windows with the same distance
-- is a bit complicated (see <#Technical_Discussion>) but ensures that all
-- windows can be reached and that windows with the same center are traversed in
-- their order in the window stack, that is, in the order
-- 'XMonad.StackSet.focusUp' and 'XMonad.StackSet.focusDown' would traverse
-- them.
centerNavigation :: Navigation2D
centerNavigation = N 2 doCenterNavigation
-- | Hybrid navigation. This attempts Line navigation, then falls back on Center
-- navigation if it does not find any suitable target windows. This is useful since
-- Line navigation tends to fail on gaps, but provides more intuitive motions
-- when it succeeds—provided there are no floating windows.
hybridNavigation :: Navigation2D
hybridNavigation = N 2 doHybridNavigation
-- | Stores the configuration of directional navigation. The 'Default' instance
-- uses line navigation for the tiled layer and for navigation between screens,
-- and center navigation for the float layer. No custom navigation strategies
-- or rectangles for unmapped windows are defined for individual layouts.
data Navigation2DConfig = Navigation2DConfig
{ defaultTiledNavigation :: Navigation2D -- ^ default navigation strategy for the tiled layer
, floatNavigation :: Navigation2D -- ^ navigation strategy for the float layer
, screenNavigation :: Navigation2D -- ^ strategy for navigation between screens
, layoutNavigation :: [(String, Navigation2D)] -- ^ association list of customized navigation strategies
-- for different layouts in the tiled layer. Each pair
-- is of the form (\"layout description\", navigation
-- strategy). If there is no pair in this list whose first
-- component is the name of the current layout, the
-- 'defaultTiledNavigation' strategy is used.
, unmappedWindowRect :: [(String, Screen -> Window -> X (Maybe Rectangle))]
-- ^ list associating functions to calculate rectangles
-- for unmapped windows with layouts to which they are
-- to be applied. Each pair in this list is of
-- the form (\"layout description\", function), where the
-- function calculates a rectangle for a given unmapped
-- window from the screen it is on and its window ID.
-- See <#Finer_Points> for how to use this.
} deriving Typeable
-- | Shorthand for the tedious screen type
type Screen = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-- | Convenience function for enabling Navigation2D with typical keybindings.
-- Takes a Navigation2DConfig, an (up, left, down, right) tuple, a mapping from
-- modifier key to action, and a bool to indicate if wrapping should occur, and
-- returns a function from XConfig to XConfig.
-- Example:
--
-- > navigation2D def (xK_w, xK_a, xK_s, xK_d) [(mod4Mask, windowGo), (mod4Mask .|. shiftMask, windowSwap)] False myConfig
navigation2D :: Navigation2DConfig -> (KeySym, KeySym, KeySym, KeySym) -> [(ButtonMask, Direction2D -> Bool -> X ())] ->
Bool -> XConfig l -> XConfig l
navigation2D navConfig (u, l, d, r) modifiers wrap xconfig =
additionalNav2DKeys (u, l, d, r) modifiers wrap $
withNavigation2DConfig navConfig xconfig
-- | Convenience function for enabling Navigation2D with typical keybindings,
-- using the syntax defined in 'XMonad.Util.EZConfig.mkKeymap'. Takes a
-- Navigation2DConfig, an (up, left, down, right) tuple, a mapping from key
-- prefix to action, and a bool to indicate if wrapping should occur, and
-- returns a function from XConfig to XConfig. Example:
--
-- > navigation2DP def ("w", "a", "s", "d") [("M-", windowGo), ("M-S-", windowSwap)] False myConfig
navigation2DP :: Navigation2DConfig -> (String, String, String, String) -> [(String, Direction2D -> Bool -> X ())] ->
Bool -> XConfig l -> XConfig l
navigation2DP navConfig (u, l, d, r) modifiers wrap xconfig =
additionalNav2DKeysP (u, l, d, r) modifiers wrap $
withNavigation2DConfig navConfig xconfig
-- | Convenience function for adding keybindings. Takes an (up, left, down,
-- right) tuple, a mapping from key prefix to action, and a bool to indicate if
-- wrapping should occur, and returns a function from XConfig to XConfig.
-- Example:
--
-- > additionalNav2DKeys (xK_w, xK_a, xK_s, xK_d) [(mod4Mask, windowGo), (mod4Mask .|. shiftMask, windowSwap)] False myConfig
additionalNav2DKeys :: (KeySym, KeySym, KeySym, KeySym) -> [(ButtonMask, Direction2D -> Bool -> X ())] ->
Bool -> XConfig l -> XConfig l
additionalNav2DKeys (u, l, d, r) modifiers wrap =
flip additionalKeys [((modif, k), func dir wrap) | (modif, func) <- modifiers, (k, dir) <- dirKeys]
where dirKeys = [(u, U), (l, L), (d, D), (r, R)]
-- | Convenience function for adding keybindings, using the syntax defined in
-- 'XMonad.Util.EZConfig.mkKeymap'. Takes an (up, left, down, right) tuple, a
-- mapping from key prefix to action, and a bool to indicate if wrapping should
-- occur, and returns a function from XConfig to XConfig. Example:
--
-- > additionalNav2DKeysP def ("w", "a", "s", "d") [("M-", windowGo), ("M-S-", windowSwap)] False myConfig
additionalNav2DKeysP :: (String, String, String, String) -> [(String, Direction2D -> Bool -> X ())] ->
Bool -> XConfig l -> XConfig l
additionalNav2DKeysP (u, l, d, r) modifiers wrap =
flip additionalKeysP [(modif ++ k, func dir wrap) | (modif, func) <- modifiers, (k, dir) <- dirKeys]
where dirKeys = [(u, U), (l, L), (d, D), (r, R)]
-- So we can store the configuration in extensible state
instance ExtensionClass Navigation2DConfig where
initialValue = def
-- | Modifies the xmonad configuration to store the Navigation2D configuration
withNavigation2DConfig :: Navigation2DConfig -> XConfig a -> XConfig a
withNavigation2DConfig conf2d xconf = xconf { startupHook = startupHook xconf
>> XS.put conf2d
}
{-# DEPRECATED defaultNavigation2DConfig "Use def (from Data.Default, and re-exported from XMonad.Actions.Navigation2D) instead." #-}
defaultNavigation2DConfig :: Navigation2DConfig
defaultNavigation2DConfig = def
instance Default Navigation2DConfig where
def = Navigation2DConfig { defaultTiledNavigation = lineNavigation
, floatNavigation = centerNavigation
, screenNavigation = lineNavigation
, layoutNavigation = []
, unmappedWindowRect = []
}
-- | Switches focus to the closest window in the other layer (floating if the
-- current window is tiled, tiled if the current window is floating). Closest
-- means that the L1-distance between the centers of the windows is minimized.
switchLayer :: X ()
switchLayer = actOnLayer otherLayer
( \ _ cur wins -> windows
$ doFocusClosestWindow cur wins
)
( \ _ cur wins -> windows
$ doFocusClosestWindow cur wins
)
( \ _ _ _ -> return () )
False
-- | Moves the focus to the next window in the given direction and in the same
-- layer as the current window. The second argument indicates whether
-- navigation should wrap around (e.g., from the left edge of the leftmost
-- screen to the right edge of the rightmost screen).
windowGo :: Direction2D -> Bool -> X ()
windowGo dir wrap = actOnLayer thisLayer
( \ conf cur wins -> windows
$ doTiledNavigation conf dir W.focusWindow cur wins
)
( \ conf cur wins -> windows
$ doFloatNavigation conf dir W.focusWindow cur wins
)
( \ conf cur wspcs -> windows
$ doScreenNavigation conf dir W.view cur wspcs
)
wrap
-- | Swaps the current window with the next window in the given direction and in
-- the same layer as the current window. (In the floating layer, all that
-- changes for the two windows is their stacking order if they're on the same
-- screen. If they're on different screens, each window is moved to the other
-- window's screen but retains its position and size relative to the screen.)
-- The second argument indicates wrapping (see 'windowGo').
windowSwap :: Direction2D -> Bool -> X ()
windowSwap dir wrap = actOnLayer thisLayer
( \ conf cur wins -> windows
$ doTiledNavigation conf dir swap cur wins
)
( \ conf cur wins -> windows
$ doFloatNavigation conf dir swap cur wins
)
( \ _ _ _ -> return () )
wrap
-- | Moves the current window to the next screen in the given direction. The
-- second argument indicates wrapping (see 'windowGo').
windowToScreen :: Direction2D -> Bool -> X ()
windowToScreen dir wrap = actOnScreens ( \ conf cur wspcs -> windows
$ doScreenNavigation conf dir W.shift cur wspcs
)
wrap
-- | Moves the focus to the next screen in the given direction. The second
-- argument indicates wrapping (see 'windowGo').
screenGo :: Direction2D -> Bool -> X ()
screenGo dir wrap = actOnScreens ( \ conf cur wspcs -> windows
$ doScreenNavigation conf dir W.view cur wspcs
)
wrap
-- | Swaps the workspace on the current screen with the workspace on the screen
-- in the given direction. The second argument indicates wrapping (see
-- 'windowGo').
screenSwap :: Direction2D -> Bool -> X ()
screenSwap dir wrap = actOnScreens ( \ conf cur wspcs -> windows
$ doScreenNavigation conf dir W.greedyView cur wspcs
)
wrap
-- | Maps each window to a fullscreen rect. This may not be the same rectangle the
-- window maps to under the Full layout or a similar layout if the layout
-- respects statusbar struts. In such cases, it may be better to use
-- 'singleWindowRect'.
fullScreenRect :: Screen -> Window -> X (Maybe Rectangle)
fullScreenRect scr _ = return (Just . screenRect . W.screenDetail $ scr)
-- | Maps each window to the rectangle it would receive if it was the only
-- window in the layout. Useful, for example, for determining the default
-- rectangle for unmapped windows in a Full layout that respects statusbar
-- struts.
singleWindowRect :: Screen -> Window -> X (Maybe Rectangle)
singleWindowRect scr win = listToMaybe
. map snd
. fst
<$> runLayout ((W.workspace scr) { W.stack = W.differentiate [win] })
(screenRect . W.screenDetail $ scr)
----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
-- --
-- PRIVATE X ACTIONS --
-- --
----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
-- | Acts on the appropriate layer using the given action functions
actOnLayer :: ([WinRect] -> [WinRect] -> [WinRect]) -- ^ Chooses which layer to operate on, relative
-- to the current window (same or other layer)
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the tiled layer
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the float layer
-> (Navigation2DConfig -> WSRect -> [WSRect] -> X ()) -- ^ The action if the current workspace is empty
-> Bool -- ^ Should navigation wrap around screen edges?
-> X ()
actOnLayer choice tiledact floatact wsact wrap = withWindowSet $ \winset -> do
conf <- XS.get
(floating, tiled) <- navigableWindows conf wrap winset
let cur = W.peek winset
case cur of
Nothing -> actOnScreens wsact wrap
Just w | Just rect <- L.lookup w tiled -> tiledact conf (w, rect) (choice tiled floating)
| Just rect <- L.lookup w floating -> floatact conf (w, rect) (choice floating tiled)
| otherwise -> return ()
-- | Returns the list of windows on the currently visible workspaces
navigableWindows :: Navigation2DConfig -> Bool -> WindowSet -> X ([WinRect], [WinRect])
navigableWindows conf wrap winset = L.partition (\(win, _) -> M.member win (W.floating winset))
. addWrapping winset wrap
. catMaybes
. concat
<$>
( mapM ( \scr -> mapM (maybeWinRect scr)
$ W.integrate'
$ W.stack
$ W.workspace scr
)
. sortedScreens
) winset
where
maybeWinRect scr win = do
winrect <- windowRect win
rect <- case winrect of
Just _ -> return winrect
Nothing -> maybe (return Nothing)
(\f -> f scr win)
(L.lookup (description . W.layout . W.workspace $ scr) (unmappedWindowRect conf))
return ((,) win <$> rect)
-- | Returns the current rectangle of the given window, Nothing if the window isn't mapped
windowRect :: Window -> X (Maybe Rectangle)
windowRect win = withDisplay $ \dpy -> do
mp <- isMapped win
if mp then do (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win
return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw)
`catchX` return Nothing
else return Nothing
-- | Acts on the screens using the given action function
actOnScreens :: (Navigation2DConfig -> WSRect -> [WSRect] -> X ())
-> Bool -- ^ Should wrapping be used?
-> X ()
actOnScreens act wrap = withWindowSet $ \winset -> do
conf <- XS.get
let wsrects = visibleWorkspaces winset wrap
cur = W.tag . W.workspace . W.current $ winset
rect = fromJust $ L.lookup cur wsrects
act conf (cur, rect) wsrects
-- | Determines whether a given window is mapped
isMapped :: Window -> X Bool
isMapped win = withDisplay
$ \dpy -> io
$ (waIsUnmapped /=)
. wa_map_state
<$> getWindowAttributes dpy win
----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
-- --
-- PRIVATE PURE FUNCTIONS --
-- --
----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
-- | Finds the window closest to the given window and focuses it. Ties are
-- broken by choosing the first window in the window stack among the tied
-- windows. (The stack order is the one produced by integrate'ing each visible
-- workspace's window stack and concatenating these lists for all visible
-- workspaces.)
doFocusClosestWindow :: WinRect
-> [WinRect]
-> (WindowSet -> WindowSet)
doFocusClosestWindow (cur, rect) winrects
| null winctrs = id
| otherwise = W.focusWindow . fst $ L.foldl1' closer winctrs
where
ctr = centerOf rect
winctrs = filter ((cur /=) . fst)
$ map (\(w, r) -> (w, centerOf r)) winrects
closer wc1@(_, c1) wc2@(_, c2) | lDist ctr c1 > lDist ctr c2 = wc2
| otherwise = wc1
-- | Implements navigation for the tiled layer
doTiledNavigation :: Navigation2DConfig
-> Direction2D
-> (Window -> WindowSet -> WindowSet)
-> WinRect
-> [WinRect]
-> (WindowSet -> WindowSet)
doTiledNavigation conf dir act cur winrects winset
| Just win <- runNav nav dir cur winrects = act win winset
| otherwise = winset
where
layouts = map (description . W.layout . W.workspace)
$ W.screens winset
nav = maximum
$ map ( fromMaybe (defaultTiledNavigation conf)
. flip L.lookup (layoutNavigation conf)
)
$ layouts
-- | Implements navigation for the float layer
doFloatNavigation :: Navigation2DConfig
-> Direction2D
-> (Window -> WindowSet -> WindowSet)
-> WinRect
-> [WinRect]
-> (WindowSet -> WindowSet)
doFloatNavigation conf dir act cur winrects
| Just win <- runNav nav dir cur winrects = act win
| otherwise = id
where
nav = floatNavigation conf
-- | Implements navigation between screens
doScreenNavigation :: Navigation2DConfig
-> Direction2D
-> (WorkspaceId -> WindowSet -> WindowSet)
-> WSRect
-> [WSRect]
-> (WindowSet -> WindowSet)
doScreenNavigation conf dir act cur wsrects
| Just ws <- runNav nav dir cur wsrects = act ws
| otherwise = id
where
nav = screenNavigation conf
-- | Implements line navigation. For layouts without overlapping windows, there
-- is no need to break ties between equidistant windows. When windows do
-- overlap, even the best tie breaking rule cannot make line navigation feel
-- natural. Thus, we fairly arbtitrarily break ties by preferring the window
-- that comes first in the window stack. (The stack order is the one produced
-- by integrate'ing each visible workspace's window stack and concatenating
-- these lists for all visible workspaces.)
doLineNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
doLineNavigation dir (cur, rect) winrects
| null winrects' = Nothing
| otherwise = Just . fst $ L.foldl1' closer winrects'
where
-- The current window's center
ctr@(xc, yc) = centerOf rect
-- The list of windows that are candidates to receive focus.
winrects' = filter dirFilter
$ filter ((cur /=) . fst)
$ winrects
-- Decides whether a given window matches the criteria to be a candidate to
-- receive the focus.
dirFilter (_, r) = (dir == L && leftOf r rect && intersectsY yc r)
|| (dir == R && leftOf rect r && intersectsY yc r)
|| (dir == U && above r rect && intersectsX xc r)
|| (dir == D && above rect r && intersectsX xc r)
-- Decide whether r1 is left of/above r2.
leftOf r1 r2 = rect_x r1 + fi (rect_width r1) <= rect_x r2
above r1 r2 = rect_y r1 + fi (rect_height r1) <= rect_y r2
-- Check whether r's x-/y-range contains the given x-/y-coordinate.
intersectsX x r = rect_x r <= x && rect_x r + fi (rect_width r) >= x
intersectsY y r = rect_y r <= y && rect_y r + fi (rect_height r) >= y
-- Decides whether r1 is closer to the current window's center than r2
closer wr1@(_, r1) wr2@(_, r2) | dist ctr r1 > dist ctr r2 = wr2
| otherwise = wr1
-- Returns the distance of r from the point (x, y)
dist (x, y) r | dir == L = x - rect_x r - fi (rect_width r)
| dir == R = rect_x r - x
| dir == U = y - rect_y r - fi (rect_height r)
| otherwise = rect_y r - y
-- | Implements center navigation
doCenterNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
doCenterNavigation dir (cur, rect) winrects
| ((w, _):_) <- onCtr' = Just w
| otherwise = closestOffCtr
where
-- The center of the current window
(xc, yc) = centerOf rect
-- All the windows with their center points relative to the current
-- center rotated so the right cone becomes the relevant cone.
-- The windows are ordered in the order they should be preferred
-- when they are otherwise tied.
winctrs = map (\(w, r) -> (w, dirTransform . centerOf $ r))
$ stackTransform
$ winrects
-- Give preference to windows later in the stack for going left or up and to
-- windows earlier in the stack for going right or down. (The stack order
-- is the one produced by integrate'ing each visible workspace's window
-- stack and concatenating these lists for all visible workspaces.)
stackTransform | dir == L || dir == U = reverse
| otherwise = id
-- Transform a point into a difference to the current window center and
-- rotate it so that the relevant cone becomes the right cone.
dirTransform (x, y) | dir == R = ( x - xc , y - yc )
| dir == L = (-(x - xc), -(y - yc))
| dir == D = ( y - yc , x - xc )
| otherwise = (-(y - yc), -(x - xc))
-- Partition the points into points that coincide with the center
-- and points that do not.
(onCtr, offCtr) = L.partition (\(_, (x, y)) -> x == 0 && y == 0) winctrs
-- All the points that coincide with the current center and succeed it
-- in the (appropriately ordered) window stack.
onCtr' = L.tail $ L.dropWhile ((cur /=) . fst) onCtr
-- tail should be safe here because cur should be in onCtr
-- All the points that do not coincide with the current center and which
-- lie in the (rotated) right cone.
offCtr' = L.filter (\(_, (x, y)) -> x > 0 && y < x && y >= -x) offCtr
-- The off-center point closest to the center and
-- closest to the bottom ray of the cone. Nothing if no off-center
-- point is in the cone
closestOffCtr = if null offCtr' then Nothing
else Just $ fst $ L.foldl1' closest offCtr'
closest wp@(_, p@(_, yp)) wq@(_, q@(_, yq))
| lDist (0, 0) q < lDist (0, 0) p = wq -- q is closer than p
| lDist (0, 0) p < lDist (0, 0) q = wp -- q is farther away than p
| yq < yp = wq -- q is closer to the bottom ray than p
| otherwise = wp -- q is farther away from the bottom ray than p
-- or it has the same distance but comes later
-- in the window stack
-- | Implements Hybrid navigation. This attempts Line navigation first,
-- then falls back on Center navigation if it finds no suitable target window.
doHybridNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
doHybridNavigation = applyToBoth pickSomething doLineNavigation doCenterNavigation
where
applyToBoth f g h a b c = f (g a b c) (h a b c)
pickSomething Nothing b = b
pickSomething a _ = a
-- | Swaps the current window with the window given as argument
swap :: Window -> WindowSet -> WindowSet
swap win winset = W.focusWindow cur
$ L.foldl' (flip W.focusWindow) newwinset newfocused
where
-- The current window
cur = fromJust $ W.peek winset
-- All screens
scrs = W.screens winset
-- All visible workspaces
visws = map W.workspace scrs
-- The focused windows of the visible workspaces
focused = mapMaybe (\ws -> W.focus <$> W.stack ws) visws
-- The window lists of the visible workspaces
wins = map (W.integrate' . W.stack) visws
-- Update focused windows and window lists to reflect swap of windows.
newfocused = map swapWins focused
newwins = map (map swapWins) wins
-- Replaces the current window with the argument window and vice versa.
swapWins x | x == cur = win
| x == win = cur
| otherwise = x
-- Reconstruct the workspaces' window stacks to reflect the swap.
newvisws = zipWith (\ws wns -> ws { W.stack = W.differentiate wns }) visws newwins
newscrs = zipWith (\scr ws -> scr { W.workspace = ws }) scrs newvisws
newwinset = winset { W.current = head newscrs
, W.visible = tail newscrs
}
-- | Calculates the center of a rectangle
centerOf :: Rectangle -> (Position, Position)
centerOf r = (rect_x r + fi (rect_width r) `div` 2, rect_y r + fi (rect_height r) `div` 2)
-- | Shorthand for integer conversions
fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
-- | Functions to choose the subset of windows to operate on
thisLayer, otherLayer :: a -> a -> a
thisLayer = curry fst
otherLayer = curry snd
-- | Returns the list of visible workspaces and their screen rects
visibleWorkspaces :: WindowSet -> Bool -> [WSRect]
visibleWorkspaces winset wrap = addWrapping winset wrap
$ map ( \scr -> ( W.tag . W.workspace $ scr
, screenRect . W.screenDetail $ scr
)
)
$ sortedScreens winset
-- | Creates five copies of each (window/workspace, rect) pair in the input: the
-- original and four offset one desktop size (desktop = collection of all
-- screens) to the left, to the right, up, and down. Wrap-around at desktop
-- edges is implemented by navigating into these displaced copies.
addWrapping :: WindowSet -- ^ The window set, used to get the desktop size
-> Bool -- ^ Should wrapping be used? Do nothing if not.
-> [Rect a] -- ^ Input set of (window/workspace, rect) pairs
-> [Rect a]
addWrapping _ False wrects = wrects
addWrapping winset True wrects = [ (w, r { rect_x = rect_x r + fi x
, rect_y = rect_y r + fi y
}
)
| (w, r) <- wrects
, (x, y) <- [(0, 0), (-xoff, 0), (xoff, 0), (0, -yoff), (0, yoff)]
]
where
(xoff, yoff) = wrapOffsets winset
-- | Calculates the offsets for window/screen coordinates for the duplication
-- of windows/workspaces that implements wrap-around.
wrapOffsets :: WindowSet -> (Integer, Integer)
wrapOffsets winset = (max_x - min_x, max_y - min_y)
where
min_x = fi $ minimum $ map rect_x rects
min_y = fi $ minimum $ map rect_y rects
max_x = fi $ maximum $ map (\r -> rect_x r + (fi $ rect_width r)) rects
max_y = fi $ maximum $ map (\r -> rect_y r + (fi $ rect_height r)) rects
rects = map snd $ visibleWorkspaces winset False
-- | Returns the list of screens sorted primarily by their centers'
-- x-coordinates and secondarily by their y-coordinates.
sortedScreens :: WindowSet -> [Screen]
sortedScreens winset = L.sortBy cmp
$ W.screens winset
where
cmp s1 s2 | x1 < x2 = LT
| x1 > x2 = GT
| y1 < x2 = LT
| y1 > y2 = GT
| otherwise = EQ
where
(x1, y1) = centerOf (screenRect . W.screenDetail $ s1)
(x2, y2) = centerOf (screenRect . W.screenDetail $ s2)
-- | Calculates the L1-distance between two points.
lDist :: (Position, Position) -> (Position, Position) -> Int
lDist (x1, y1) (x2, y2) = abs (fi $ x1 - x2) + abs (fi $ y1 - y2)
Reference in New Issue View Git Blame Copy Permalink