twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-05-19 11:30:22 -07:00
Code Issues Packages Projects Releases Wiki Activity

Cleanup L.BorderResize

Browse Source
This commit is contained in:
Adam Vogt 2009-10-12 05:55:32 +00:00
parent 06998efa45
commit 1edc2752c7
1 changed files with 46 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

98
XMonad/Layout/BorderResize.hs
View File

@ -11,7 +11,7 @@
-- --
-- This layout modifier will allow to resize windows by dragging their -- This layout modifier will allow to resize windows by dragging their
-- borders with the mouse. However, it only works in layouts or modified -- borders with the mouse. However, it only works in layouts or modified
-- layouts that react to the SetGeometry message. -- layouts that react to the 'SetGeometry' message.
-- "XMonad.Layout.WindowArranger" can be used to create such a setup. -- "XMonad.Layout.WindowArranger" can be used to create such a setup.
-- BorderResize is probably most useful in floating layouts. -- BorderResize is probably most useful in floating layouts.
-- --
@ -29,6 +29,8 @@ import XMonad.Layout.Decoration
import XMonad.Layout.WindowArranger import XMonad.Layout.WindowArranger
import XMonad.Util.XUtils import XMonad.Util.XUtils
import Control.Monad(when,forM) import Control.Monad(when,forM)
import Control.Arrow(first)
import Control.Applicative((<$>))
-- $usage -- $usage
-- You can use this module with the following in your -- You can use this module with the following in your
@ -68,32 +70,25 @@ borderResize = ModifiedLayout (BR [])
instance LayoutModifier BorderResize Window where instance LayoutModifier BorderResize Window where
redoLayout _ _ Nothing wrs = return (wrs, Nothing) redoLayout _ _ Nothing wrs = return (wrs, Nothing)
redoLayout (BR borders) _ _ wrs = redoLayout (BR borders) _ _ wrs = do
let preparedBorders = for wrs $ \wr -> (wr, prepareBorders wr) let preparedBorders = for wrs $ \wr -> (wr, prepareBorders wr)
in do mapM_ deleteBorder borders
mapM_ deleteBorder borders newBorders <- forM preparedBorders $ \(wr, (b1, b2, b3, b4)) ->
newBorders <- forM preparedBorders $ \(wr, (b1, b2, b3, b4)) -> do first (++[wr]) . unzip <$> mapM createBorder [b1,b2,b3,b4]
(b1WR, b1BWW) <- createBorder b1 let wrs' = concat $ map fst newBorders
(b2WR, b2BWW) <- createBorder b2 newBordersSerialized = concat $ map snd newBorders
(b3WR, b3BWW) <- createBorder b3 return (wrs', Just $ BR newBordersSerialized)
(b4WR, b4BWW) <- createBorder b4 -- What we return is the original wrs with the new border
return ([b1WR, b2WR, b3WR, b4WR, wr], -- windows inserted at the correct positions - this way, the core
[b1BWW, b2BWW, b3BWW, b4BWW]) -- will restack the borders correctly.
let wrs' = concat $ map fst newBorders -- We also return information about our borders, so that we
newBordersSerialized = concat $ map snd newBorders -- can handle events that they receive and destroy them when
return (wrs', Just $ BR newBordersSerialized) -- they are no longer needed.
-- 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 handleMess (BR borders) m
| Just e <- fromMessage m :: Maybe Event = handleResize borders e >> return Nothing | Just e <- fromMessage m :: Maybe Event = handleResize borders e >> return Nothing
| Just Hide <- fromMessage m = releaseResources >> return (Just $ BR []) | Just _ <- fromMessage m :: Maybe LayoutMessages =
| Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ BR []) mapM_ deleteBorder borders >> return (Just $ BR [])
where releaseResources = mapM_ deleteBorder borders
handleMess _ _ = return Nothing handleMess _ _ = return Nothing
prepareBorders :: (Window, Rectangle) -> (BorderWithRect, BorderWithRect, BorderWithRect, BorderWithRect) prepareBorders :: (Window, Rectangle) -> (BorderWithRect, BorderWithRect, BorderWithRect, BorderWithRect)
@ -106,35 +101,34 @@ prepareBorders (w, r@(Rectangle x y wh ht)) =
handleResize :: [BorderWithWin] -> Event -> X () handleResize :: [BorderWithWin] -> Event -> X ()
handleResize borders ButtonEvent { ev_window = ew, ev_event_type = et } handleResize borders ButtonEvent { ev_window = ew, ev_event_type = et }
| et == buttonPress = do | et == buttonPress, Just edge <- lookup ew borders =
case (lookup ew borders) of case edge of
Just (RightSideBorder hostWin (Rectangle hx hy _ hht)) -> do RightSideBorder hostWin (Rectangle hx hy _ hht) ->
mouseDrag (\x _ -> do mouseDrag (\x _ -> do
let nwh = max 1 $ fi (x - hx) let nwh = max 1 $ fi (x - hx)
rect = Rectangle hx hy nwh hht rect = Rectangle hx hy nwh hht
focus hostWin focus hostWin
when (x - hx > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) when (x - hx > 0) $ sendMessage (SetGeometry rect)) (focus hostWin)
Just (LeftSideBorder hostWin (Rectangle hx hy hwh hht)) -> do LeftSideBorder hostWin (Rectangle hx hy hwh hht) ->
mouseDrag (\x _ -> do mouseDrag (\x _ -> do
let nx = max 0 $ min (hx + fi hwh) $ x let nx = max 0 $ min (hx + fi hwh) $ x
nwh = max 1 $ hwh + fi (hx - x) nwh = max 1 $ hwh + fi (hx - x)
rect = Rectangle nx hy nwh hht rect = Rectangle nx hy nwh hht
focus hostWin focus hostWin
when (x < hx + fi hwh) $ sendMessage (SetGeometry rect)) (focus hostWin) when (x < hx + fi hwh) $ sendMessage (SetGeometry rect)) (focus hostWin)
Just (TopSideBorder hostWin (Rectangle hx hy hwh hht)) -> do TopSideBorder hostWin (Rectangle hx hy hwh hht) ->
mouseDrag (\_ y -> do mouseDrag (\_ y -> do
let ny = max 0 $ min (hy + fi hht) $ y let ny = max 0 $ min (hy + fi hht) $ y
nht = max 1 $ hht + fi (hy - y) nht = max 1 $ hht + fi (hy - y)
rect = Rectangle hx ny hwh nht rect = Rectangle hx ny hwh nht
focus hostWin focus hostWin
when (y < hy + fi hht) $ sendMessage (SetGeometry rect)) (focus hostWin) when (y < hy + fi hht) $ sendMessage (SetGeometry rect)) (focus hostWin)
Just (BottomSideBorder hostWin (Rectangle hx hy hwh _)) -> do BottomSideBorder hostWin (Rectangle hx hy hwh _) ->
mouseDrag (\_ y -> do mouseDrag (\_ y -> do
let nht = max 1 $ fi (y - hy) let nht = max 1 $ fi (y - hy)
rect = Rectangle hx hy hwh nht rect = Rectangle hx hy hwh nht
focus hostWin focus hostWin
when (y - hy > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) when (y - hy > 0) $ sendMessage (SetGeometry rect)) (focus hostWin)
Nothing -> return ()
handleResize _ _ = return () handleResize _ _ = return ()
createBorder :: BorderWithRect -> X (((Window, Rectangle), BorderWithWin)) createBorder :: BorderWithRect -> X (((Window, Rectangle), BorderWithWin))