aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad
diff options
context:
space:
mode:
authorquentin.moser <quentin.moser@unifr.ch>2009-04-15 20:45:50 +0200
committerquentin.moser <quentin.moser@unifr.ch>2009-04-15 20:45:50 +0200
commit1cd2c1e9e5a068720a56692ea55d4b1b154ce12f (patch)
treed06472fcbeef03d026cab093e61c5d7d2c83443f /XMonad
parent8835e1f4502ae48e02c67708e320119ad6dda855 (diff)
downloadXMonadContrib-1cd2c1e9e5a068720a56692ea55d4b1b154ce12f.tar.gz
XMonadContrib-1cd2c1e9e5a068720a56692ea55d4b1b154ce12f.tar.xz
XMonadContrib-1cd2c1e9e5a068720a56692ea55d4b1b154ce12f.zip
Improve composability of X.H.Place, drop simple(st)Float support
Ignore-this: 8a0fb64aa0db27b242b7ad4bcba1a3ca darcs-hash:20090415184550-5ccef-fcc9d4152b7d181a9380121af147d1a0782b192c.gz
Diffstat (limited to 'XMonad')
-rw-r--r--XMonad/Hooks/Place.hs167
1 files changed, 107 insertions, 60 deletions
diff --git a/XMonad/Hooks/Place.hs b/XMonad/Hooks/Place.hs
index af2b3b8..c0b92ee 100644
--- a/XMonad/Hooks/Place.hs
+++ b/XMonad/Hooks/Place.hs
@@ -8,7 +8,7 @@
-- Stability : unstable
-- Portability : unportable
--
--- Automatic placement of floating and "WindowArranger" windows.
+-- Automatic placement of floating windows.
--
-----------------------------------------------------------------------------
@@ -40,15 +40,17 @@ import XMonad.Layout.WindowArranger
import XMonad.Actions.FloatKeys
import qualified Data.Map as M
-import Data.List (sortBy, minimumBy)
-import Data.Maybe (maybe)
+import Data.Ratio ((%))
+import Data.List (sortBy, minimumBy, partition)
+import Data.Maybe (maybe, fromMaybe, catMaybes)
import Data.Monoid (Endo(..))
-import Control.Monad.Trans (lift, liftIO)
+import Control.Monad (guard, join)
+import Control.Monad.Trans (lift)
-- $usage
--- This module provides a ManageHook that automatically places
+-- 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.
+-- as an 'X' action to manually trigger repositioning.
--
-- You can use this module by including the following in your @~\/.xmonad\/xmonad.hs@:
--
@@ -59,6 +61,10 @@ import Control.Monad.Trans (lift, liftIO)
-- > main = xmonad $ defaultConfig { manageHook = placeHook simpleSmart
-- > <+> manageHook defaultConfig }
--
+-- Note that 'placeHook' should be applied after most other hooks, especially hooks
+-- such as 'doFloat' and 'doShift'. Since hooks combined with '<+>' are applied from
+-- right to left, this means that 'placeHook' should be the /first/ hook in your chain.
+--
-- You can also define a key to manually trigger repositioning with 'placeFocused' by
-- adding the following to your keys definition:
--
@@ -73,8 +79,6 @@ import Control.Monad.Trans (lift, liftIO)
{- Placement policies -}
-- $placements
--- #Placement policies#
---
-- Placement policies determine how windows will be placed by 'placeFocused' and 'placeHook'.
--
-- A few examples:
@@ -146,20 +150,22 @@ withGaps = Bounds
-
-
{- Placement functions -}
--- | Repositions the focused window according to a placement policy.
+-- | Repositions the focused window according to a placement policy. Works for
+-- both \"real\" floating windows and windows in a 'WindowArranger'-based
+-- layout.
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
+ info <- gets $ screenInfo . S.current . windowset
+ floats <- gets $ M.keys . S.floating . windowset
+
+ r'@(Rectangle x' y' _ _) <- placeWindow p window info floats
+
+ -- use X.A.FloatKeys if the window is floating, send
+ -- a WindowArranger message otherwise.
+ case elem window floats of
True -> keysMoveWindowTo (x', y') (0, 0) window
False -> sendMessage $ SetGeometry r'
@@ -167,19 +173,47 @@ placeFocused p = withFocused $ \window -> do
-- | 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
+ r <- Query $ lift $ getWindowRectangle window
+ allRs <- Query $ lift $ getAllRectangles
+ pointer <- Query $ lift $ getPointer window
+
+ return $ Endo $ \theWS -> fromMaybe theWS $
+ do let currentRect = screenRect $ S.screenDetail $ S.current theWS
+ floats = M.keys $ S.floating theWS
+
+ guard(window `elem` floats )
+
+ -- Look for the workspace(s) on which the window is to be
+ -- spawned. Each of them also needs an associated screen
+ -- rectangle; for hidden workspaces, we use the current
+ -- workspace's screen.
+ let infos = filter ((window `elem`) . stackContents . S.stack . fst)
+ $ [screenInfo $ S.current theWS]
+ ++ (map screenInfo $ S.visible theWS)
+ ++ zip (S.hidden theWS) (repeat currentRect)
+
+ guard(not $ null infos)
+
+ let (workspace, screen) = head infos
+ rs = catMaybes $ map (flip M.lookup allRs)
+ $ organizeClients workspace window floats
+ r' = purePlaceWindow p screen rs pointer r
+ newRect = r2rr screen r'
+ newFloats = M.insert window newRect (S.floating theWS)
+
+ return $ theWS { S.floating = newFloats }
+
+
+placeWindow :: Placement -> Window
+ -> (S.Workspace WorkspaceId (Layout Window) Window, Rectangle)
+ -- ^ The workspace with reference to which the window should be placed,
+ -- and the screen's geometry.
+ -> [Window]
+ -- ^ The list of floating windows.
+ -> X Rectangle
+placeWindow p window (ws, s) floats
+ = do (r, rs, pointer) <- getNecessaryData window ws floats
+ return $ purePlaceWindow p s rs pointer r
-- | Compute the new position of a window according to a placement policy.
@@ -202,7 +236,7 @@ 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
+-- | 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)
@@ -231,19 +265,22 @@ scale r n1 n2 = truncate $ r * fi n2 + (1 - r) * fi n1
fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
-
+r2rr :: Rectangle -> Rectangle -> S.RationalRect
+r2rr (Rectangle x0 y0 w0 h0) (Rectangle x y w h)
+ = S.RationalRect ((fi x-fi x0) % fi w0)
+ ((fi y-fi y0) % fi h0)
+ (fi w % fi w0)
+ (fi h % fi h0)
{- Querying stuff -}
-getScreenRect :: X Rectangle
-getScreenRect = gets $ screenRect . S.screenDetail
- . S.current . windowset
+stackContents :: Maybe (S.Stack w) -> [w]
+stackContents = maybe [] S.integrate
-getLayoutWindows :: X [Window]
-getLayoutWindows = gets $ maybe [] S.integrate . S.stack
- . S.workspace . S.current . windowset
+screenInfo :: S.Screen i l a sid ScreenDetail -> (S.Workspace i l a, Rectangle)
+screenInfo (S.Screen { S.workspace = ws, S.screenDetail = (SD s)}) = (ws, s)
getWindowRectangle :: Window -> X Rectangle
getWindowRectangle window
@@ -257,38 +294,48 @@ getWindowRectangle window
return $ Rectangle x y (w + 2*b) (h + 2*b)
-getFloats :: X [Window]
-getFloats = gets $ M.keys . S.floating . windowset
+getAllRectangles :: X (M.Map Window Rectangle)
+getAllRectangles = do ws <- gets windowset
+ let allWindows = join $ map (stackContents . S.stack)
+ $ (S.workspace . S.current) ws
+ : (map S.workspace . S.visible) ws
+ ++ S.hidden ws
+ allRects <- mapM getWindowRectangle allWindows
+
+ return $ M.fromList $ zip allWindows allRects
+
+organizeClients :: S.Workspace a b Window -> Window -> [Window] -> [Window]
+organizeClients ws w floats
+ = let (floatCs, layoutCs) = partition (`elem` floats) $ filter (/= w)
+ $ stackContents $ S.stack ws
+ in reverse layoutCs ++ reverse floatCs
+ -- About the ordering: the smart algorithm will overlap windows
+ -- starting ith the head of the list. So:
+ -- - we put the non-floating windows first since they'll
+ -- probably be below the floating ones,
+ -- - we reverse the lists, since the newer/more important
+ -- windows are usually near the head.
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,
+-- | Return values are, in order: 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.
+getNecessaryData :: Window
+ -> S.Workspace WorkspaceId (Layout Window) Window
+ -> [Window]
+ -> X (Rectangle, [Rectangle], (Position, Position))
+getNecessaryData window ws floats
+ = do r <- getWindowRectangle window
- 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.
+ rs <- return (organizeClients ws window floats)
+ >>= mapM getWindowRectangle
+
pointer <- getPointer window
- return (s, r, rs, pointer)
-
+ return (r, rs, pointer)