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
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
|
{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable
{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.WindowArranger
-- Copyright : (c) Andrea Rossato 2007
-- License : BSD-style (see xmonad/LICENSE)
--
-- Maintainer : andrea.rossato@unibz.it
-- Stability : unstable
-- Portability : unportable
--
-- This is a pure layout modifier that will let you move and resize
-- windows with the keyboard in any layout.
-----------------------------------------------------------------------------
module XMonad.Layout.WindowArranger
( -- * Usage
-- $usage
windowArrange
, windowArrangeAll
, WindowArrangerMsg (..)
, WindowArranger
, memberFromList
, listFromList
, diff
) where
import XMonad
import qualified XMonad.StackSet as S
import XMonad.Layout.LayoutModifier
import XMonad.Util.XUtils (fi)
import Control.Arrow
import Data.List
import Data.Maybe
-- $usage
-- You can use this module with the following in your
-- @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.WindowArranger
-- > myLayout = layoutHook defaultConfig
-- > main = xmonad defaultConfig { layoutHook = windowArrange myLayout }
--
-- or
--
-- > main = xmonad defaultConfig { layoutHook = windowArrangeAll myLayout }
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
--
-- You may also want to define some key binding to move or resize
-- windows. These are good defaults:
--
-- > , ((modMask x .|. controlMask , xK_s ), sendMessage Arrange )
-- > , ((modMask x .|. controlMask .|. shiftMask, xK_s ), sendMessage DeArrange )
-- > , ((modMask x .|. controlMask , xK_Left ), sendMessage (MoveLeft 1))
-- > , ((modMask x .|. controlMask , xK_Right), sendMessage (MoveRight 1))
-- > , ((modMask x .|. controlMask , xK_Down ), sendMessage (MoveDown 1))
-- > , ((modMask x .|. controlMask , xK_Up ), sendMessage (MoveUp 1))
-- > , ((modMask x .|. shiftMask, xK_Left ), sendMessage (IncreaseLeft 1))
-- > , ((modMask x .|. shiftMask, xK_Right), sendMessage (IncreaseRight 1))
-- > , ((modMask x .|. shiftMask, xK_Down ), sendMessage (IncreaseDown 1))
-- > , ((modMask x .|. shiftMask, xK_Up ), sendMessage (IncreaseUp 1))
-- > , ((modMask x .|. controlMask .|. shiftMask, xK_Left ), sendMessage (DecreaseLeft 1))
-- > , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage (DecreaseRight 1))
-- > , ((modMask x .|. controlMask .|. shiftMask, xK_Down ), sendMessage (DecreaseDown 1))
-- > , ((modMask x .|. controlMask .|. shiftMask, xK_Up ), sendMessage (DecreaseUp 1))
--
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- | A layout modifier to float the windows in a workspace
windowArrange :: l a -> ModifiedLayout WindowArranger l a
windowArrange = ModifiedLayout (WA True False [])
-- | A layout modifier to float all the windows in a workspace
windowArrangeAll :: l a -> ModifiedLayout WindowArranger l a
windowArrangeAll = ModifiedLayout (WA True True [])
data WindowArrangerMsg = DeArrange
| Arrange
| IncreaseLeft Int
| IncreaseRight Int
| IncreaseUp Int
| IncreaseDown Int
| DecreaseLeft Int
| DecreaseRight Int
| DecreaseUp Int
| DecreaseDown Int
| MoveLeft Int
| MoveRight Int
| MoveUp Int
| MoveDown Int
| SetGeometry Rectangle
deriving ( Typeable )
instance Message WindowArrangerMsg
data ArrangedWindow a = WR (a, Rectangle)
| AWR (a, Rectangle)
deriving (Read, Show)
type ArrangeAll = Bool
data WindowArranger a = WA Bool ArrangeAll [ArrangedWindow a] deriving (Read, Show)
instance (Show a, Read a, Eq a) => LayoutModifier WindowArranger a where
pureModifier (WA True b []) _ _ wrs = arrangeWindows b wrs
pureModifier (WA True b awrs) _ (S.Stack w _ _) wrs = curry process wrs awrs
where
wins = map fst *** map awrWin
update (a,r) = mkNewAWRs b a *** removeAWRs r >>> uncurry (++)
process = wins &&& id >>> first diff >>> uncurry update >>>
replaceWR wrs >>> putOnTop w >>> map fromAWR &&& Just . WA True b
pureModifier _ _ _ wrs = (wrs, Nothing)
pureMess (WA True b (wr:wrs)) m
-- increase the window's size
| Just (IncreaseRight i) <- fm, (win, Rectangle x y w h) <- fa = res win x y (w + fi i) h
| Just (IncreaseLeft i) <- fm, (win, Rectangle x y w h) <- fa = res win (x - fi i) y (w + fi i) h
| Just (IncreaseUp i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y - fi i) w (h + fi i)
| Just (IncreaseDown i) <- fm, (win, Rectangle x y w h) <- fa = res win x y w (h + fi i)
-- decrease the window's size
| Just (DecreaseRight i) <- fm, (win, Rectangle x y w h) <- fa = res win (x + fi i) y (chk w i) h
| Just (DecreaseLeft i) <- fm, (win, Rectangle x y w h) <- fa = res win x y (chk w i) h
| Just (DecreaseUp i) <- fm, (win, Rectangle x y w h) <- fa = res win x y w (chk h i)
| Just (DecreaseDown i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y + fi i) w (chk h i)
--move the window around
| Just (MoveRight i) <- fm, (win, Rectangle x y w h) <- fa = res win (x + fi i) y w h
| Just (MoveLeft i) <- fm, (win, Rectangle x y w h) <- fa = res win (x - fi i) y w h
| Just (MoveUp i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y - fi i) w h
| Just (MoveDown i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y + fi i) w h
where res wi x y w h = Just . WA True b $ AWR (wi,Rectangle x y w h):wrs
fm = fromMessage m
fa = fromAWR wr
chk x y = fi $ max 1 (fi x - y)
pureMess (WA t b (wr:wrs)) m
| Just (SetGeometry r) <- fromMessage m, (w,_) <- fromAWR wr = Just . WA t b $ AWR (w,r):wrs
pureMess (WA _ b l) m
| Just DeArrange <- fromMessage m = Just $ WA False b l
| Just Arrange <- fromMessage m = Just $ WA True b l
| otherwise = Nothing
arrangeWindows :: ArrangeAll -> [(a,Rectangle)] -> ([(a, Rectangle)], Maybe (WindowArranger a))
arrangeWindows b wrs = (wrs, Just $ WA True b (map t wrs))
where t = if b then AWR else WR
fromAWR :: ArrangedWindow a -> (a, Rectangle)
fromAWR (WR x) = x
fromAWR (AWR x) = x
awrWin :: ArrangedWindow a -> a
awrWin = fst . fromAWR
getAWR :: Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a]
getAWR = memberFromList awrWin (==)
getWR :: Eq a => a -> [(a,Rectangle)] -> [(a,Rectangle)]
getWR = memberFromList fst (==)
mkNewAWRs :: Eq a => ArrangeAll -> [a] -> [(a,Rectangle)] -> [ArrangedWindow a]
mkNewAWRs b w wrs = map t . concatMap (flip getWR wrs) $ w
where t = if b then AWR else WR
removeAWRs :: Eq a => [a] -> [ArrangedWindow a] -> [ArrangedWindow a]
removeAWRs = listFromList awrWin notElem
putOnTop :: Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a]
putOnTop w awrs = awr ++ nawrs
where awr = getAWR w awrs
nawrs = filter ((/=w) . awrWin) awrs
replaceWR :: Eq a => [(a, Rectangle)] -> [ArrangedWindow a] -> [ArrangedWindow a]
replaceWR wrs = foldr r []
where r x xs
| WR wr <- x = case fst wr `elemIndex` map fst wrs of
Just i -> (WR $ wrs !! i):xs
Nothing -> x:xs
| otherwise = x:xs
-- | Given a function to be applied to each member of a list, and a
-- function to check a condition by processing this transformed member
-- with the members of a list, you get the list of members that
-- satisfy the condition.
listFromList :: (b -> c) -> (c -> [a] -> Bool) -> [a] -> [b] -> [b]
listFromList f g l = foldr (h l) []
where h x y ys = if g (f y) x then y:ys else ys
-- | Given a function to be applied to each member of ta list, and a
-- function to check a condition by processing this transformed member
-- with something, you get the first member that satisfy the condition,
-- or an empty list.
memberFromList :: (b -> c) -> (c -> a -> Bool) -> a -> [b] -> [b]
memberFromList f g l = foldr (h l) []
where h x y ys = if g (f y) x then [y] else ys
-- | Get the list of elements to be deleted and the list ef elements to
-- be added to the first list in order to get the second list.
diff :: Eq a => ([a],[a]) -> ([a],[a])
diff (x,y) = (x \\ y, y \\ x)
|
