From b9fb7f750e00e35363832fdd398366621eabb2d3 Mon Sep 17 00:00:00 2001 From: Lukas Mai Date: Sat, 5 Apr 2008 00:05:58 +0200 Subject: update contrib for applySizeHints changes darcs-hash:20080404220558-462cf-2d7837b574aec854a158213d45a34cca75e38438.gz --- XMonad/Actions/ConstrainedResize.hs | 2 +- XMonad/Actions/FlexibleManipulate.hs | 2 +- XMonad/Actions/FlexibleResize.hs | 2 +- XMonad/Actions/FloatKeys.hs | 4 ++-- XMonad/Layout/HintedGrid.hs | 15 +++++---------- XMonad/Layout/HintedTile.hs | 23 +++++------------------ XMonad/Layout/LayoutHints.hs | 17 +++++------------ 7 files changed, 20 insertions(+), 45 deletions(-) diff --git a/XMonad/Actions/ConstrainedResize.hs b/XMonad/Actions/ConstrainedResize.hs index a0a412c..8e79ffc 100644 --- a/XMonad/Actions/ConstrainedResize.hs +++ b/XMonad/Actions/ConstrainedResize.hs @@ -53,5 +53,5 @@ mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do y = ey - fromIntegral (wa_y wa) sz = if c then (max x y, max x y) else (x,y) io $ resizeWindow d w `uncurry` - applySizeHints sh sz) + applySizeHintsContents sh sz) (float w) diff --git a/XMonad/Actions/FlexibleManipulate.hs b/XMonad/Actions/FlexibleManipulate.hs index 083b661..0966818 100644 --- a/XMonad/Actions/FlexibleManipulate.hs +++ b/XMonad/Actions/FlexibleManipulate.hs @@ -92,7 +92,7 @@ mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do npos = wpos + offset * atl nbr = (wpos + wsize) + offset * abr ntl = minP (nbr - (32, 32)) npos --minimum size - nwidth = applySizeHints sh $ mapP (round :: Double -> Integer) (nbr - ntl) + nwidth = applySizeHintsContents sh $ mapP (round :: Double -> Integer) (nbr - ntl) moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth return ()) (float w) diff --git a/XMonad/Actions/FlexibleResize.hs b/XMonad/Actions/FlexibleResize.hs index cc99dcf..534bcaf 100644 --- a/XMonad/Actions/FlexibleResize.hs +++ b/XMonad/Actions/FlexibleResize.hs @@ -53,7 +53,7 @@ mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do let [px, py] = map (fromIntegral . ($ wa')) [wa_x, wa_y] io $ moveResizeWindow d w (fx px (fromIntegral ex)) (fy py (fromIntegral ey)) - `uncurry` applySizeHints sh (gx $ fromIntegral ex, gy $ fromIntegral ey)) + `uncurry` applySizeHintsContents sh (gx $ fromIntegral ex, gy $ fromIntegral ey)) (float w) where firstHalf :: CInt -> Position -> Bool diff --git a/XMonad/Actions/FloatKeys.hs b/XMonad/Actions/FloatKeys.hs index 5e38b7e..c2343bf 100644 --- a/XMonad/Actions/FloatKeys.hs +++ b/XMonad/Actions/FloatKeys.hs @@ -94,7 +94,7 @@ keysAbsResizeWindow = keysMoveResize keysAbsResizeWindow' keysAbsResizeWindow' :: SizeHints -> P -> D -> D -> D -> (P,D) keysAbsResizeWindow' sh (x,y) (w,h) (dx,dy) (ax, ay) = ((round nx, round ny), (nw, nh)) where - (nw, nh) = applySizeHints sh (w + dx, h + dy) + (nw, nh) = applySizeHintsContents sh (w + dx, h + dy) nx :: Rational nx = fromIntegral (ax * w + nw * (fromIntegral x - ax)) / fromIntegral w ny :: Rational @@ -103,7 +103,7 @@ keysAbsResizeWindow' sh (x,y) (w,h) (dx,dy) (ax, ay) = ((round nx, round ny), (n keysResizeWindow' :: SizeHints -> P -> D -> D -> G -> (P,D) keysResizeWindow' sh (x,y) (w,h) (dx,dy) (gx, gy) = ((nx, ny), (nw, nh)) where - (nw, nh) = applySizeHints sh (w + dx, h + dy) + (nw, nh) = applySizeHintsContents sh (w + dx, h + dy) nx = round $ fromIntegral x + gx * fromIntegral w - gx * fromIntegral nw ny = round $ fromIntegral y + gy * fromIntegral h - gy * fromIntegral nh diff --git a/XMonad/Layout/HintedGrid.hs b/XMonad/Layout/HintedGrid.hs index 731af89..3b14b08 100644 --- a/XMonad/Layout/HintedGrid.hs +++ b/XMonad/Layout/HintedGrid.hs @@ -23,7 +23,7 @@ module XMonad.Layout.HintedGrid ( import Prelude hiding ((.)) -import XMonad hiding (windows) +import XMonad import XMonad.StackSet import Control.Monad.State @@ -55,9 +55,6 @@ data Grid a = Grid Bool deriving (Read, Show) instance LayoutClass Grid Window where doLayout (Grid m) r w = flip (,) Nothing . arrange m r (integrate w) -adjBorders :: Dimension -> D -> D -adjBorders b (w, h) = (w + 2 * b, h + 2 * b) - replicateS :: Int -> (a -> (b, a)) -> a -> ([b], a) replicateS n = runState . replicateM n . State @@ -96,15 +93,13 @@ doRect height = doR -- | The internal function for computing the grid layout. arrange :: Bool -> Rectangle -> [Window] -> X [(Window, Rectangle)] -arrange mirror (Rectangle rx ry rw rh) windows = do - dpy <- asks display - hints <- mapM (io . getWMNormalHints dpy) windows - borders <- mapM (io . fmap (fromIntegral . wa_border_width) . getWindowAttributes dpy) windows +arrange mirror (Rectangle rx ry rw rh) wins = do + proto <- mapM mkAdjust wins let - adjs = zipWith (\h b -> twist . adjBorders b . applySizeHints h . adjBorders (negate b) . twist) hints borders + adjs = map (\f -> twist . f . twist) proto rs = arrange' (twist (rw, rh)) adjs rs' = map (\(Rectangle x y w h) -> uncurry (uncurry Rectangle (twist (x, y))) (twist (w, h))) rs - return . zip windows . map (\r -> r{ rect_x = rect_x r + rx, rect_y = rect_y r + ry }) $ rs' + return . zip wins . map (\r -> r{ rect_x = rect_x r + rx, rect_y = rect_y r + ry }) $ rs' where twist | mirror = \(a, b) -> (b, a) diff --git a/XMonad/Layout/HintedTile.hs b/XMonad/Layout/HintedTile.hs index f71bf0a..34f0898 100644 --- a/XMonad/Layout/HintedTile.hs +++ b/XMonad/Layout/HintedTile.hs @@ -23,7 +23,6 @@ module XMonad.Layout.HintedTile ( import XMonad hiding (Tall(..)) import qualified XMonad.StackSet as W -import Control.Applicative ((<$>)) import Control.Monad -- $usage @@ -55,7 +54,7 @@ data Alignment = TopLeft | Center | BottomRight instance LayoutClass HintedTile Window where doLayout (HintedTile { orientation = o, nmaster = nm, frac = f, alignment = al }) r w' = do - bhs <- mapM getHints w + bhs <- mapM mkAdjust w let (masters, slaves) = splitAt nm bhs return (zip w (tiler masters slaves), Nothing) where @@ -73,39 +72,27 @@ instance LayoutClass HintedTile Window where description l = show (orientation l) -adjBorder :: Dimension -> Dimension -> D -> D -adjBorder n b (w, h) = (w + n * 2 * b, h + n * 2 * b) - --- | Transform a function on dimensions into one without regard for borders -hintsUnderBorder :: (Dimension, SizeHints) -> D -> D -hintsUnderBorder (bW, h) = adjBorder bW 1 . applySizeHints h . adjBorder bW (-1) - -getHints :: Window -> X (Dimension, SizeHints) -getHints w = withDisplay $ \d -> io $ liftM2 (,) - (fromIntegral . wa_border_width <$> getWindowAttributes d w) - (getWMNormalHints d w) - align :: Alignment -> Position -> Dimension -> Dimension -> Position align TopLeft p _ _ = p align Center p a b = p + fromIntegral (a - b) `div` 2 align BottomRight p a b = p + fromIntegral (a - b) -- Divide the screen vertically (horizontally) into n subrectangles -divide :: Alignment -> Orientation -> [(Dimension, SizeHints)] -> Rectangle -> [Rectangle] +divide :: Alignment -> Orientation -> [D -> D] -> Rectangle -> [Rectangle] divide _ _ [] _ = [] divide al _ [bh] (Rectangle sx sy sw sh) = [Rectangle (align al sx sw w) (align al sy sh h) w h] where - (w, h) = hintsUnderBorder bh (sw, sh) + (w, h) = bh (sw, sh) divide al Tall (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle (align al sx sw w) sy w h) : (divide al Tall bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h))) where - (w, h) = hintsUnderBorder bh (sw, sh `div` fromIntegral (1 + (length bhs))) + (w, h) = bh (sw, sh `div` fromIntegral (1 + (length bhs))) divide al Wide (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx (align al sy sh h) w h) : (divide al Wide bhs (Rectangle (sx + fromIntegral w) sy (sw - w) sh)) where - (w, h) = hintsUnderBorder bh (sw `div` fromIntegral (1 + (length bhs)), sh) + (w, h) = bh (sw `div` fromIntegral (1 + (length bhs)), sh) -- Split the screen into two rectangles, using a rational to specify the ratio split :: Orientation -> Rational -> Rectangle -> (Rectangle -> [Rectangle]) diff --git a/XMonad/Layout/LayoutHints.hs b/XMonad/Layout/LayoutHints.hs index f8aa47b..ca139ed 100644 --- a/XMonad/Layout/LayoutHints.hs +++ b/XMonad/Layout/LayoutHints.hs @@ -42,22 +42,15 @@ import XMonad.Layout.Decoration ( isInStack ) layoutHints :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHints l a layoutHints = ModifiedLayout LayoutHints --- | Expand a size by the given multiple of the border width. The --- multiple is most commonly 1 or -1. -adjBorders :: Dimension -> Dimension -> D -> D -adjBorders bW mult (w,h) = (w+2*mult*bW, h+2*mult*bW) - data LayoutHints a = LayoutHints deriving (Read, Show) instance LayoutModifier LayoutHints Window where modifierDescription _ = "Hinted" redoLayout _ _ s xs = do - bW <- asks (borderWidth . config) - xs' <- mapM (applyHint bW) xs + xs' <- mapM applyHint xs return (xs', Nothing) where - applyHint bW (w,r@(Rectangle a b c d)) = - withDisplay $ \disp -> do - sh <- io $ getWMNormalHints disp w - let (c',d') = adjBorders 1 bW . applySizeHints sh . adjBorders bW (-1) $ (c,d) - return (w, if isInStack s w then Rectangle a b c' d' else r) + applyHint (w,r@(Rectangle a b c d)) = do + adj <- mkAdjust w + let (c',d') = adj (c,d) + return (w, if isInStack s w then Rectangle a b c' d' else r) -- cgit v1.2.3