diff options
| -rw-r--r-- | XMonad/Layout/BorderResize.hs | 170 | ||||
| -rw-r--r-- | xmonad-contrib.cabal | 1 |
2 files changed, 171 insertions, 0 deletions
diff --git a/XMonad/Layout/BorderResize.hs b/XMonad/Layout/BorderResize.hs new file mode 100644 index 0000000..2fd42f8 --- /dev/null +++ b/XMonad/Layout/BorderResize.hs @@ -0,0 +1,170 @@ +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-} +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.BorderResize +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- This layout modifier will allow to resize windows by dragging their +-- borders with the mouse. However, it only works in layouts or modified +-- layouts that react to the SetGeometry message. +-- "XMonad.Layout.WindowArranger" can be used to create such a setup. +-- BorderResize is probably most useful in floating layouts. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.BorderResize + ( -- * Usage + -- $usage + borderResize + , BorderResize (..) + ) where + +import XMonad +import XMonad.Layout.Decoration +import XMonad.Layout.WindowArranger +import XMonad.Util.XUtils +import Control.Monad(when,forM) + +-- $usage +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.BorderResize +-- > myLayout = borderResize (... layout setup that reacts to SetGeometry ...) +-- > main = xmonad defaultConfig { layoutHook = myLayout } +-- + +data BorderInfo = RightSideBorder Window Rectangle + | LeftSideBorder Window Rectangle + | TopSideBorder Window Rectangle + | BottomSideBorder Window Rectangle + deriving (Show, Read, Eq) +type BorderWithRect = (Rectangle, Rectangle, Glyph, BorderInfo) +type BorderWithWin = (Window, BorderInfo) + +data BorderResize a = BR [BorderWithWin] deriving (Show, Read) + +brBorderOffset :: Position +brBorderOffset = 5 +brBorderSize :: Dimension +brBorderSize = 10 + +brCursorRightSide :: Glyph +brCursorRightSide = 96 +brCursorLeftSide :: Glyph +brCursorLeftSide = 70 +brCursorTopSide :: Glyph +brCursorTopSide = 138 +brCursorBottomSide :: Glyph +brCursorBottomSide = 16 + +borderResize :: l a -> ModifiedLayout BorderResize l a +borderResize = ModifiedLayout (BR []) + +instance LayoutModifier BorderResize Window where + redoLayout _ _ Nothing wrs = return (wrs, Nothing) + redoLayout (BR borders) _ _ wrs = + let preparedBorders = for wrs $ \wr -> (wr, prepareBorders wr) + in do + mapM_ deleteBorder borders + newBorders <- forM preparedBorders $ \(wr, (b1, b2, b3, b4)) -> do + (b1WR, b1BWW) <- createBorder b1 + (b2WR, b2BWW) <- createBorder b2 + (b3WR, b3BWW) <- createBorder b3 + (b4WR, b4BWW) <- createBorder b4 + return ([b1WR, b2WR, b3WR, b4WR, wr], + [b1BWW, b2BWW, b3BWW, b4BWW]) + let wrs' = concat $ map fst newBorders + newBordersSerialized = concat $ map snd newBorders + return (wrs', Just $ BR newBordersSerialized) + -- What we return is the original wrs with the new border + -- windows inserted at the correct positions - this way, the core + -- will restack the borders correctly. + -- We also return information about our borders, so that we + -- can handle events that they receive and destroy them when + -- they are no longer needed. + + handleMess (BR borders) m + | Just e <- fromMessage m :: Maybe Event = handleResize borders e >> return Nothing + | Just Hide <- fromMessage m = releaseResources >> return (Just $ BR []) + | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ BR []) + where releaseResources = mapM_ deleteBorder borders + handleMess _ _ = return Nothing + +prepareBorders :: (Window, Rectangle) -> (BorderWithRect, BorderWithRect, BorderWithRect, BorderWithRect) +prepareBorders (w, r@(Rectangle x y wh ht)) = + ((r, (Rectangle (x + fi wh - brBorderOffset) y brBorderSize ht) , brCursorRightSide , RightSideBorder w r), + (r, (Rectangle (x - brBorderOffset) y brBorderSize ht) , brCursorLeftSide , LeftSideBorder w r), + (r, (Rectangle x (y - brBorderOffset) wh brBorderSize) , brCursorTopSide , TopSideBorder w r), + (r, (Rectangle x (y + fi ht - brBorderOffset) wh brBorderSize) , brCursorBottomSide , BottomSideBorder w r) + ) + +handleResize :: [BorderWithWin] -> Event -> X () +handleResize borders ButtonEvent { ev_window = ew, ev_event_type = et } + | et == buttonPress = do + case (lookup ew borders) of + Just (RightSideBorder hostWin (Rectangle hx hy _ hht)) -> do + mouseDrag (\x _ -> do + let nwh = max 1 $ fi (x - hx) + rect = Rectangle hx hy nwh hht + focus hostWin + when (x - hx > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) + Just (LeftSideBorder hostWin (Rectangle hx hy hwh hht)) -> do + mouseDrag (\x _ -> do + let nx = max 0 $ min (hx + fi hwh) $ x + nwh = max 1 $ hwh + fi (hx - x) + rect = Rectangle nx hy nwh hht + focus hostWin + when (x < hx + fi hwh) $ sendMessage (SetGeometry rect)) (focus hostWin) + Just (TopSideBorder hostWin (Rectangle hx hy hwh hht)) -> do + mouseDrag (\_ y -> do + let ny = max 0 $ min (hy + fi hht) $ y + nht = max 1 $ hht + fi (hy - y) + rect = Rectangle hx ny hwh nht + focus hostWin + when (y < hy + fi hht) $ sendMessage (SetGeometry rect)) (focus hostWin) + Just (BottomSideBorder hostWin (Rectangle hx hy hwh _)) -> do + mouseDrag (\_ y -> do + let nht = max 1 $ fi (y - hy) + rect = Rectangle hx hy hwh nht + focus hostWin + when (y - hy > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) + Nothing -> return () +handleResize _ _ = return () + +createBorder :: BorderWithRect -> X (((Window, Rectangle), BorderWithWin)) +createBorder (_, borderRect, borderCursor, borderInfo) = do + borderWin <- createInputWindow borderCursor borderRect + return ((borderWin, borderRect), (borderWin, borderInfo)) + +deleteBorder :: BorderWithWin -> X () +deleteBorder (borderWin, _) = deleteWindow borderWin + +createInputWindow :: Glyph -> Rectangle -> X Window +createInputWindow cursorGlyph r = withDisplay $ \d -> do + win <- mkInputWindow d r + io $ selectInput d win (exposureMask .|. buttonPressMask) + cursor <- io $ createFontCursor d cursorGlyph + io $ defineCursor d win cursor + io $ freeCursor d cursor + showWindow win + return win + +mkInputWindow :: Display -> Rectangle -> X Window +mkInputWindow d (Rectangle x y w h) = do + rw <- asks theRoot + let screen = defaultScreenOfDisplay d + visual = defaultVisualOfScreen screen + attrmask = cWOverrideRedirect + io $ allocaSetWindowAttributes $ + \attributes -> do + set_override_redirect attributes True + createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes + +for :: [a] -> (a -> b) -> [b] +for = flip map diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index d8ee195..e589eeb 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -135,6 +135,7 @@ library XMonad.Hooks.XPropManage XMonad.Layout.Accordion XMonad.Layout.AutoMaster + XMonad.Layout.BorderResize XMonad.Layout.BoringWindows XMonad.Layout.CenteredMaster XMonad.Layout.Circle |