diff options
| -rw-r--r-- | XMonad/Hooks/Place.hs | 413 | ||||
| -rw-r--r-- | xmonad-contrib.cabal | 1 |
2 files changed, 414 insertions, 0 deletions
diff --git a/XMonad/Hooks/Place.hs b/XMonad/Hooks/Place.hs new file mode 100644 index 0000000..5c42b3f --- /dev/null +++ b/XMonad/Hooks/Place.hs @@ -0,0 +1,413 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.Place +-- Copyright : Quentin Moser <quentin.moser@unifr.ch> +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Quentin Moser <quentin.moser@unifr.ch> +-- 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 diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index 5c224c2..ff7027f 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -125,6 +125,7 @@ library XMonad.Hooks.FloatNext XMonad.Hooks.ManageDocks XMonad.Hooks.ManageHelpers + XMonad.Hooks.Place XMonad.Hooks.Script XMonad.Hooks.SetWMName XMonad.Hooks.ServerMode |