[xmonad] darcs patch: X.A.Navigation2D
Brent Yorgey
byorgey at seas.upenn.edu
Sun Dec 11 14:57:35 CET 2011
Great work!! I have wanted this for a while now. My poor brain cannot
keep two different and incompatible window-switching modes straight.
...woah, and there's a PDF! With diagrams!
...and *proofs*!
My hat is off to you.
-Brent
On Sat, Dec 10, 2011 at 12:24:44AM -0400, Norbert Zeh wrote:
> Finally, Wirt and I think this is ready to be shared with the broader xmonad
> community. Wirt certainly deserves credit for lots of useful feedback and lots
> of thorough testing I wouldn't have had the patience to do.
>
> 1 patch for repository http://code.haskell.org/XMonadContrib:
>
> Thu Dec 8 16:58:42 AST 2011 Norbert Zeh <nzeh at cs.dal.ca>
> * X.A.Navigation2D
>
> This is a new module to support directional navigation across multiple screens.
> As such it is related to X.A.WindowNavigation and X.L.WindowNavigation, but it
> is more general. For a detailed discussion of the differences, see
> http://www.cs.dal.ca/~nzeh/xmonad/Navigation2D.pdf.
>
>
> New patches:
>
> [X.A.Navigation2D
> Norbert Zeh <nzeh at cs.dal.ca>**20111208205842
> Ignore-this: 3860cc71bfc08d99bd8279c2e0945186
>
> This is a new module to support directional navigation across multiple screens.
> As such it is related to X.A.WindowNavigation and X.L.WindowNavigation, but it
> is more general. For a detailed discussion of the differences, see
> http://www.cs.dal.ca/~nzeh/xmonad/Navigation2D.pdf.
> ] {
> addfile ./XMonad/Actions/Navigation2D.hs
> hunk ./XMonad/Actions/Navigation2D.hs 1
> +{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, PatternGuards, RankNTypes, TypeSynonymInstances #-}
> +
> +-----------------------------------------------------------------------------
> +-- |
> +-- Module : XMonad.Layout.Navigation2D
> +-- Copyright : (c) 2011 Norbert Zeh <nzeh at cs.dal.ca>
> +-- License : BSD3-style (see LICENSE)
> +--
> +-- Maintainer : Norbert Zeh <nzeh at 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#
> +
> + withNavigation2DConfig
> + , Navigation2DConfig(..)
> + , 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.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 edit your keybindings:
> +--
> +-- > -- Switch between layers
> +-- > , ((modm, xK_space), switchLayers)
> +-- >
> +-- > -- 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)
> +--
> +-- and add the configuration of the module to your main function:
> +--
> +-- > main = xmonad $ withNavigation2DConfig defaultNavigation2DConfig
> +-- > $ defaultConfig
> +--
> +-- 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 = defaultNavigation2DConfig { layoutNavigation = [("Full", centerNavigation)] }
> +-- >
> +-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig
> +-- > $ defaultConfig
> +--
> +-- 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 = defaultNavigation2DConfig { layoutNavigation = [("Full", centerNavigation)]
> +-- > , unmappedWindowRect = [("Full", singleWindowRect)]
> +-- > }
> +-- >
> +-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig
> +-- > $ defaultConfig
> +--
> +-- 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
> +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
> +
> +-- So we can store the configuration in extensible state
> +instance ExtensionClass Navigation2DConfig where
> + initialValue = defaultNavigation2DConfig
> +
> +-- | 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
> + }
> +
> +-- | Default navigation configuration. It 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.
> +defaultNavigation2DConfig :: Navigation2DConfig
> +defaultNavigation2DConfig = 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)
> hunk ./xmonad-contrib.cabal 108
> XMonad.Actions.MessageFeedback
> XMonad.Actions.MouseGestures
> XMonad.Actions.MouseResize
> + XMonad.Actions.Navigation2D
> XMonad.Actions.NoBorders
> XMonad.Actions.OnScreen
> XMonad.Actions.PerWorkspaceKeys
> }
>
> Context:
>
> [P.Shell documentation and add missing unsafePrompt export
> Adam Vogt <vogt.adam at gmail.com>**20111207163951
> Ignore-this: a03992ffdc9c1a0f5bfa6dafc453b587
>
> Haddock (version 2.9.2 at least) does not attach documentation to any of a b or
> c when given:
>
> -- | documentation
> a,b,c :: X
>
> ]
> [Paste: 3 more escaped characters from alistra
> gwern0 at gmail.com**20111129160335
> Ignore-this: 46f5b86a25bcd2b26d2e07ed33ffad68
> ]
> [unfuck X.U.Paste
> Daniel Wagner <daniel at wagner-home.com>**20111129032331
> Ignore-this: d450e23ca026143bb6ca9d744dcdd906
> ]
> [XMonad.Util.Paste: +alistra's patch for fixing his pasting of things like email address (@)
> gwern0 at gmail.com**20111128215648
> Ignore-this: 4af1af27637fe056792aa4f3bb0403eb
> ]
> [XMonad.Util.Paste: rm myself from maintainer field; I don't know how to fix any of it even if I wanted
> gwern0 at gmail.com**20111128213001
> Ignore-this: 87a4996aaa5241428ccb13851c5eb455
> ]
> [XMonad.Prompt.Shell: improve 'env' documentation to cover goodgrue's problem
> gwern0 at gmail.com**20111127231507
> Ignore-this: 7b652a280960cbdf99c236496ca091b0
> ]
> [Fix spelling 'prefered' -> 'preferred'.
> Erik de Castro Lopo <erikd at mega-nerd.com>**20111125010229
> Ignore-this: f2eac1728b5e023399188becf867a14d
> ]
> [Restore TrackFloating behavior to an earlier version.
> Adam Vogt <vogt.adam at gmail.com>**20111120045538
> Ignore-this: 1a1367b4171c3ad23b0553766021629f
>
> Thanks for liskni_si for pressing the matter: without this change it is very
> broken, with the patch it is still not perfect but still useful.
> ]
> [Explicitly list test files in .cabal
> Adam Vogt <vogt.adam at gmail.com>**20111118232511
> Ignore-this: ac48a0d388293cc6c771d676aaf142e3
>
> In the future, require Cabal >= 1.6 to be able to just write tests/*.hs
> ]
> [TAG 0.10
> Adam Vogt <vogt.adam at gmail.com>**20111118225640
> Ignore-this: 8f81b175b902e985d584160fc41ab7d1
> ]
> Patch bundle hash:
> c2698f6d3f3b866be35e8b17bc448446d3910daa
> _______________________________________________
> xmonad mailing list
> xmonad at haskell.org
> http://www.haskell.org/mailman/listinfo/xmonad
More information about the xmonad
mailing list