{-# 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)
import Control.Arrow(first)
import Control.Applicative((<$>))
-- $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 = do
let preparedBorders = for wrs $ \wr -> (wr, prepareBorders wr)
mapM_ deleteBorder borders
newBorders <- forM preparedBorders $ \(wr, (b1, b2, b3, b4)) ->
first (++[wr]) . unzip <$> mapM createBorder [b1,b2,b3,b4]
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 _ <- fromMessage m :: Maybe LayoutMessages =
mapM_ deleteBorder borders >> return (Just $ BR [])
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, Just edge <- lookup ew borders =
case edge of
RightSideBorder hostWin (Rectangle hx hy _ hht) ->
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)
LeftSideBorder hostWin (Rectangle hx hy hwh hht) ->
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)
TopSideBorder hostWin (Rectangle hx hy hwh hht) ->
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)
BottomSideBorder hostWin (Rectangle hx hy hwh _) ->
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)
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
