From 06998efa455034b245948b4ecd381ee3c56ae373 Mon Sep 17 00:00:00 2001
From: Jan Vornberger <jan.vornberger@informatik.uni-oldenburg.de>
Date: Sun, 11 Oct 2009 22:22:14 +0000
Subject: [PATCH] Layout modifier to resize windows by dragging their borders
with the mouse
---
XMonad/Layout/BorderResize.hs | 170 ++++++++++++++++++++++++++++++++++
xmonad-contrib.cabal | 1 +
2 files changed, 171 insertions(+)
create mode 100644 XMonad/Layout/BorderResize.hs
diff --git a/XMonad/Layout/BorderResize.hs b/XMonad/Layout/BorderResize.hs
new file mode 100644
index 00000000..2fd42f8a
--- /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 d8ee1954..e589eeb3 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