1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
{-# 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
|
