----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.Place -- Copyright : Quentin Moser -- License : BSD-style (see LICENSE) -- -- Maintainer : Quentin Moser -- Stability : unstable -- Portability : unportable -- -- Automatic placement of floating and "WindowArranger" windows. -- ----------------------------------------------------------------------------- module XMonad.Hooks.Place ( -- * Usage -- $usage -- * Placement actions placeFocused , placeHook -- * Placement policies -- $placements , Placement , smart , simpleSmart , fixed , underMouse , inBounds , withGaps -- * Others , purePlaceWindow ) where import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.WindowArranger import XMonad.Actions.FloatKeys import qualified Data.Map as M import Data.List (sortBy, maximumBy) import Data.Maybe (maybe) import Data.Monoid (Endo(..)) import Control.Monad.Trans (lift, liftIO) -- $usage -- This module provides a ManageHook that automatically places -- floating windows at appropriate positions on the screen, as well -- as an X action to manually trigger repositioning. -- -- You can use this module by including the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Hooks.Place -- -- and adding 'placeHook' to your 'manageHook', for example: -- -- > main = xmonad $ defaultConfig { manageHook = placeHook simpleSmart -- > <+> manageHook defaultConfig } -- -- You can also define a key to manually trigger repositioning with 'placeFocused' by -- adding the following to your keys definition: -- -- > , ((modMask, xK_w), placeFocused simpleSmart) -- -- Both 'placeHook' and 'placeFocused' take a 'Placement' parameter, which specifies -- the placement policy to use (smart, under the mouse, fixed position, etc.). See -- 'Placement' for a list of available policies. {- Placement policies -} -- $placements -- #Placement policies# -- -- Placement policies determine how windows will be placed by 'placeFocused' and 'placeHook'. -- -- A few examples: -- -- * Basic smart placement -- -- > myPlacement = simpleSmart -- -- * Under the mouse (pointer at the top-left corner), but constrained -- inside of the screen area -- -- > myPlacement = inBounds (underMouse (0, 0)) -- -- * Smart placement with a preference for putting windows near -- the center of the screen, and with 16px gaps at the top and bottom -- of the screen where no window will be placed -- -- > myPlacement = withGaps (16,0,16,0) (smart (0.5,0.5)) -- | The type of placement policies data Placement = Smart (Rational, Rational) | Fixed (Rational, Rational) | UnderMouse (Rational, Rational) | Bounds (Dimension, Dimension, Dimension, Dimension) Placement deriving (Show, Read, Eq) -- | Try to place windows with as little overlap as possible smart :: (Rational, Rational) -- ^ Where the window should be placed inside -- the available area. See 'fixed'. -> Placement smart = Smart simpleSmart :: Placement simpleSmart = inBounds $ smart (0,0) -- | Place windows at a fixed position fixed :: (Rational, Rational) -- ^ Where windows should go. -- -- * (0,0) -> top left of the screen -- -- * (1,0) -> top right of the screen -- -- * etc -> Placement fixed = Fixed -- | Place windows under the mouse underMouse :: (Rational, Rational) -- ^ Where the pointer should be relative to -- the window's frame; see 'fixed'. -> Placement underMouse = UnderMouse -- | Apply the given placement policy, constraining the -- placed windows inside the screen boundaries. inBounds :: Placement -> Placement inBounds = Bounds (0,0,0,0) -- | Same as 'inBounds', but allows specifying gaps along the screen's edges withGaps :: (Dimension, Dimension, Dimension, Dimension) -- ^ top, right, bottom and left gaps -> Placement -> Placement withGaps = Bounds {- Placement functions -} -- | Repositions the focused window according to a placement policy. placeFocused :: Placement -> X () placeFocused p = withFocused $ \window -> do (s,r,rs,pointer) <- getNecessaryData window let r'@(Rectangle x' y' _ _) = purePlaceWindow p s rs pointer r fs <- getFloats case elem window fs of True -> keysMoveWindowTo (x', y') (0, 0) window False -> sendMessage $ SetGeometry r' -- | Hook to automatically place windows when they are created. placeHook :: Placement -> ManageHook placeHook p = do window <- ask (s,r,rs,pointer) <- Query $ lift (getNecessaryData window) let (Rectangle x' y' _ _) = purePlaceWindow p s rs pointer r d <- Query $ lift $ asks display liftIO $ moveWindow d window x' y' -- Move window at the X level, and -- hope both the standard floating -- system and WindowArranger layouts -- will pick it up correctly. -- I'm not really satisfied with this though. return $ Endo id -- | Compute the new position of a window according to a placement policy. purePlaceWindow :: Placement -- ^ The placement strategy -> Rectangle -- ^ The screen -> [Rectangle] -- ^ The other visible windows -> (Position, Position) -- ^ The pointer's position. -> Rectangle -- ^ The window to be placed -> Rectangle purePlaceWindow (Bounds (t,r,b,l) p') (Rectangle sx sy sw sh) rs p w = let s' = (Rectangle (sx + fi l) (sy + fi t) (sw - l - r) (sh - t - b)) in checkBounds s' $ purePlaceWindow p' s' rs p w purePlaceWindow (Fixed ratios) s _ _ w = placeRatio ratios s w purePlaceWindow (UnderMouse (rx, ry)) _ _ (px, py) (Rectangle _ _ w h) = Rectangle (px - truncate (rx * fi w)) (py - truncate (ry * fi h)) w h purePlaceWindow (Smart ratios) s rs _ w = placeSmart ratios s rs (rect_width w) (rect_height w) -- | Helper: Places a Rectangle at a fixed position indicated by two Rationals -- inside another, placeRatio :: (Rational, Rational) -> Rectangle -> Rectangle -> Rectangle placeRatio (rx, ry) (Rectangle x1 y1 w1 h1) (Rectangle _ _ w2 h2) = Rectangle (scale rx x1 (x1 + fi w1 - fi w2)) (scale ry y1 (y1 + fi h1 - fi h2)) w2 h2 -- | Helper: Ensures its second parameter is contained inside the first -- by possibly moving it. checkBounds :: Rectangle -> Rectangle -> Rectangle checkBounds (Rectangle x1 y1 w1 h1) (Rectangle x2 y2 w2 h2) = Rectangle (max x1 (min (x1 + fi w1 - fi w2) x2)) (max y1 (min (y1 + fi h1 - fi h2) y2)) w2 h2 {- Utilities -} scale :: (RealFrac a, Integral b) => a -> b -> b -> b scale r n1 n2 = truncate $ r * fi n2 + (1 - r) * fi n1 fi :: (Integral a, Num b) => a -> b fi = fromIntegral {- Querying stuff -} getScreenRect :: X Rectangle getScreenRect = gets $ screenRect . S.screenDetail . S.current . windowset getLayoutWindows :: X [Window] getLayoutWindows = gets $ maybe [] S.integrate . S.stack . S.workspace . S.current . windowset getWindowRectangle :: Window -> X Rectangle getWindowRectangle window = do d <- asks display (_, x, y, w, h, _, _) <- io $ getGeometry d window -- We can't use the border width returned by -- getGeometry because it will be 0 if the -- window isn't mapped yet. b <- asks $ borderWidth . config return $ Rectangle x y (w + 2*b) (h + 2*b) getFloats :: X [Window] getFloats = gets $ M.keys . S.floating . windowset getPointer :: Window -> X (Position, Position) getPointer window = do d <- asks display (_,_,_,x,y,_,_,_) <- io $ queryPointer d window return (fi x,fi y) -- | Return values are, in order: screen's rectangle, window's rectangle, -- other windows' rectangles and pointer's coordinates. getNecessaryData :: Window -> X (Rectangle, Rectangle, [Rectangle], (Position, Position)) getNecessaryData window = do s <- getScreenRect r <- getWindowRectangle window -- The window to be place may or may not -- have a border depending on whether it -- is already mapped. layoutRects <- fmap (filter (/= window)) getLayoutWindows >>= mapM getWindowRectangle floatRects <- fmap (filter (/= window)) getFloats >>= mapM getWindowRectangle let rs = reverse $ floatRects ++ layoutRects -- Clients inside of the layout -- will be ignored first when -- using smart placement. -- We also reverse the list because it seems -- the clients most recently added are at the front. pointer <- getPointer window return (s, r, rs, pointer) {- Smart placement algorithm -} -- | Alternate representation for rectangles. data SmartRectangle a = SR { sr_x0, sr_y0 :: a -- ^ Top left coordinates, inclusive , sr_x1, sr_y1 :: a -- ^ Bottom right coorsinates, exclusive } deriving (Show, Eq) r2sr :: Rectangle -> SmartRectangle Position r2sr (Rectangle x y w h) = SR x y (x + fi w) (y + fi h) sr2r :: SmartRectangle Position -> Rectangle sr2r (SR x0 y0 x1 y1) = Rectangle x0 y0 (fi $ x1 - x0) (fi $ y1 - y0) width :: Num a => SmartRectangle a -> a width r = sr_x1 r - sr_x0 r height :: Num a => SmartRectangle a -> a height r = sr_y1 r - sr_y0 r isEmpty :: Real a => SmartRectangle a -> Bool isEmpty r = (width r <= 0) || (height r <= 0) contains :: Real a => SmartRectangle a -> SmartRectangle a -> Bool contains r1 r2 = sr_x0 r1 <= sr_x0 r2 && sr_y0 r1 <= sr_y0 r2 && sr_x1 r1 >= sr_x1 r2 && sr_y1 r1 >= sr_y1 r2 -- | Main placement function placeSmart :: (Rational, Rational) -- ^ point of the screen where windows -- should be placed first, if possible. -> Rectangle -- ^ screen -> [Rectangle] -- ^ other clients -> Dimension -- ^ width -> Dimension -- ^ height -> Rectangle placeSmart (rx, ry) s@(Rectangle sx sy sw sh) rs w h = let free = map sr2r $ findSpace (r2sr s) (map r2sr rs) (fi w) (fi h) in position free (scale rx sx (sx + fi sw - fi w)) (scale ry sy (sy + fi sh - fi h)) w h -- | Second part of the algorithm: -- Chooses the best position in which to place a window, -- according to a list of free areas and an ideal position for -- the top-left corner. -- We can't use semi-open surfaces for this, so we go back to -- X11 Rectangles/Positions/etc instead. position :: [Rectangle] -- ^ Free areas -> Position -> Position -- ^ Ideal coordinates -> Dimension -> Dimension -- ^ Width and height of the window -> Rectangle position rs x y w h = maximumBy distanceOrder $ map closest rs where distanceOrder r1 r2 = compare (distance (rect_x r1,rect_y r1) (x,y) :: Dimension) (distance (rect_x r2,rect_y r2) (x,y) :: Dimension) distance (x1,y1) (x2,y2) = truncate $ (sqrt :: Double -> Double) $ fi $ (x1 - x2)^(2::Int) + (y1 - y2)^(2::Int) closest r = checkBounds r (Rectangle x y w h) -- | First part of the algorithm: -- Tries to find an area in which to place a new -- rectangle so that it overlaps as little as possible with -- other rectangles aready present. The first rectangles in -- the list will be overlapped first. findSpace :: Real a => SmartRectangle a -- ^ The total available area -> [SmartRectangle a] -- ^ The parts aready in use -> a -- ^ Width of the rectangle to place -> a -- ^ Height of the rectangle to place -> [SmartRectangle a] findSpace total [] _ _ = [total] findSpace total rs@(_:rs') w h = case filter largeEnough $ cleanup $ substractRects total rs of [] -> findSpace total rs' w h as -> as where largeEnough r = width r >= w && height r >= h -- | Substracts smaller rectangles from a total rectangle -- , returning a list of remaining rectangular areas. substractRects :: Real a => SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a] substractRects total [] = [total] substractRects total (r:rs) = do total' <- substractRects total rs filter (not . isEmpty) [ total' {sr_y1 = min (sr_y1 total') (sr_y0 r)} -- Above , total' {sr_x0 = max (sr_x0 total') (sr_x1 r)} -- Right , total' {sr_y0 = max (sr_y0 total') (sr_y1 r)} -- Below , total' {sr_x1 = min (sr_x1 total') (sr_x0 r)} -- Left ] -- | "Nubs" a list of rectangles, dropping all those that are -- already contained in another rectangle of the list. cleanup :: Real a => [SmartRectangle a] -> [SmartRectangle a] cleanup rs = foldr dropIfContained [] $ sortBy sizeOrder rs sizeOrder :: Real a => SmartRectangle a -> SmartRectangle a -> Ordering sizeOrder r1 r2 | w1 < w2 = LT | w1 == w2 && h1 < h2 = LT | w1 == w2 && h1 == h2 = EQ | otherwise = GT where w1 = width r1 w2 = width r2 h1 = height r1 h2 = height r2 dropIfContained :: Real a => SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a] dropIfContained r rs = if any (`contains` r) rs then rs else r:rs