mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 11:30:22 -07:00
Module for automatic placement of floating windows
This commit is contained in:
quentin.moser
parent
1b82ccd21f
commit
43edb3a151
413
XMonad/Hooks/Place.hs
Normal file
413
XMonad/Hooks/Place.hs
Normal file
@ -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
|
||||
@ -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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user