[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