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
Devin Mullins c648a3959b X.A.Navigation2D: add convenience functions for setting config & keybindings 
1. Added 'additionalNav2DKeys' which adds keybindings for the cartesian product
   of direction keys and (modifier, action) pairs given.
2. Added 'navigation2D' which combines that with 'withNavigation2DConfig'.
3. Added 'additionalNav2DKeysP' and 'navigation2DP' which do the same, but use
   the 'additionalKeysP' syntax.
2014-10-02 07:57:57 +00:00

869 lines
43 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
, 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. 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
-- | 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
-- | 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