1
;; grow-pack.jl -- window resize and movement
2
;; $Id: grow-pack.jl,v 1.12 2001/03/09 20:06:05 jsh Exp $
3
;; Id: grow-pack.jl,v 1.9 2000/08/04 16:42:43 grossjoh Exp
5
;; Copyright (C) 2000 Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
7
;; This file is free software; you can redistribute it and/or modify it
8
;; under the terms of the GNU General Public License as published by
9
;; the Free Software Foundation; either version 2, or (at your option)
12
;; sawmill is distributed in the hope that it will be useful, but
13
;; WITHOUT ANY WARRANTY; without even the implied warranty of
14
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
;; GNU General Public License for more details.
17
;; You should have received a copy of the GNU General Public License
18
;; along with sawmill; see the file COPYING. If not, write to
19
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23
;; This package provides functions to `grow' or `pack' a window in
24
;; four directions. `Growing' means to grow the window in the
25
;; indicated direction until it `bumps into' another window.
26
;; `Packing' means to move the window in the indicated direction until
27
;; it `bumps into' another window.
29
;; Copy this file into a directory which is on your load-path, then
30
;; use it. I installed this package by placing the following into my
33
;; (require 'grow-pack)
35
;; (setq window-ops-menu
36
;; (append window-ops-menu
37
;; (list (cons "Grow/pack" grow-pack-menu))))
39
(define-structure sawfish.wm.commands.grow-pack ()
46
sawfish.wm.state.maximize
47
sawfish.wm.state.iconify
51
sawfish.wm.util.stacking)
53
(define-structure-alias grow-pack sawfish.wm.commands.grow-pack)
57
(defcustom grow-window-repeat t
58
"Whether growing an already grown window grows it again."
60
:group (min-max maximize))
62
(defcustom grow-is-maximize t
63
"Whether growing is considered to be maximization. When you turn
64
this on, you can use `unmaximize-window' or something similar to get
65
back to the original size."
67
:group (min-max maximize))
69
(defcustom pack-warp-pointer 'maybe
70
"Whether and how to move the pointer when packing windows.
72
`maybe' means that the pointer is moved along with the window, if the
73
pointer was within the window area before packing.
75
`always' warps the pointer to the center of the window if it isn't
76
already in the window, then does like `maybe'.
78
`never' means not to warp the pointer."
79
:type (choice maybe always never)
84
(defun grow-window-left (w)
85
"Grows window to the left until it `bumps into' another window."
86
(grow-window w 'left))
88
(defun grow-window-right (w)
89
"Grows window to the right until it `bumps into' another window."
90
(grow-window w 'right))
92
(defun grow-window-up (w)
93
"Grows window upwards until it `bumps into' another window."
96
(defun grow-window-down (w)
97
"Grows window downwards until it `bumps into' another window."
98
(grow-window w 'down))
100
(defun pack-window-left (w)
101
"Moves window to the left until it `bumps into' another window."
102
(pack-window w 'left))
104
(defun pack-window-right (w)
105
"Moves window to the right until it `bumps into' another window."
106
(pack-window w 'right))
108
(defun pack-window-up (w)
109
"Moves window upwards until it `bumps into' another window."
112
(defun pack-window-down (w)
113
"Moves window downwards until it `bumps into' another window."
114
(pack-window w 'down))
119
(define-command 'grow-window-left grow-window-left #:spec "%W")
120
(define-command 'grow-window-right grow-window-right #:spec "%W")
121
(define-command 'grow-window-up grow-window-up #:spec "%W")
122
(define-command 'grow-window-down grow-window-down #:spec "%W")
123
(define-command 'pack-window-left pack-window-left #:spec "%W")
124
(define-command 'pack-window-right pack-window-right #:spec "%W")
125
(define-command 'pack-window-up pack-window-up #:spec "%W")
126
(define-command 'pack-window-down pack-window-down #:spec "%W")
128
;; Convenience variable.
130
(defvar grow-pack-menu
131
'(("Grow left" grow-window-left)
132
("Grow right" grow-window-right)
133
("Grow up" grow-window-up)
134
("Grow down" grow-window-down)
135
("Pack left" pack-window-left)
136
("Pack right" pack-window-right)
137
("Pack up" pack-window-up)
138
("Pack down" pack-window-down))
139
"Menu of grow and pack operations.")
141
;; Implementation part.
143
(defun gp-avoid-windows (w direction)
144
"Returns list of windows to avoid when growing/filling window W in DIRECTION."
145
(let* ((wpos (window-position w))
146
(wdim (window-frame-dimensions w))
149
(wright (+ wleft (car wdim)))
150
(wbottom (+ wtop (cdr wdim)))
155
(szhints (window-size-hints w))
156
(winc (or (cdr (assq 'width-inc szhints)) 1))
157
(hinc (or (cdr (assq 'height-inc szhints)) 1)))
158
(when (eq direction 'left)
160
(when grow-window-repeat
161
(setq wleft (max (- wleft winc) 0))))
162
(when (eq direction 'right)
163
(setq nright (screen-width))
164
(when grow-window-repeat
165
(setq wright (min (+ wright winc) (screen-width)))))
166
(when (eq direction 'up)
168
(when grow-window-repeat
169
(setq wtop (max (- wtop hinc) 0))))
170
(when (eq direction 'down)
171
(setq nbottom (screen-height))
172
(when grow-window-repeat
173
(setq wbottom (min (+ wbottom hinc) (screen-height)))))
176
(let* ((xpos (window-position x))
177
(xdim (window-frame-dimensions x))
180
(xright (+ xleft (car xdim)))
181
(xbottom (+ xtop (cdr xdim))))
182
;; If window does not overlap W but does overlap the
183
;; larger W, then we need to avoid this window.
184
(and (window-mapped-p x)
185
(not (window-iconified-p x))
186
(window-appears-in-workspace-p x current-workspace)
187
(<= (rect-2d-overlap* (list xleft xtop xright xbottom)
188
(list wleft wtop wright wbottom)) 0)
189
(> (rect-2d-overlap* (list xleft xtop xright xbottom)
190
(list nleft ntop nright nbottom)) 0)))))))
192
(defun gp-surrounding-rect (wlist)
193
"Returns the rectangle surrounding all given windows."
195
(let* ((w (car wlist))
197
(wpos (window-position w))
198
(wdim (window-frame-dimensions w))
201
(rright (+ rleft (car wdim)))
202
(rbottom (+ rtop (cdr wdim))))
205
(let* ((xpos (window-position x))
206
(xdim (window-frame-dimensions x))
209
(xright (+ xleft (car xdim)))
210
(xbottom (+ xtop (cdr xdim))))
211
(when (< xleft rleft) (setq rleft xleft))
212
(when (< xtop rtop) (setq rtop xtop))
213
(when (> xright rright) (setq rright xright))
214
(when (> xbottom rbottom) (setq rbottom xbottom))))
216
(list rleft rtop rright rbottom))
217
(list (screen-width) (screen-height) 0 0)))
219
(defun grow-window (w direction)
220
"Grows window W in DIRECTION."
221
(let* ((avoid-wins (gp-avoid-windows w direction))
222
(surround (gp-surrounding-rect avoid-wins))
223
(wpos (window-position w))
224
(wdim (window-dimensions w))
225
(fdim (window-frame-dimensions w))
232
(sleft (nth 0 surround))
233
(stop (nth 1 surround))
234
(sright (nth 2 surround))
235
(sbottom (nth 3 surround)))
236
(when (eq direction 'left)
237
(setq nwidth (- (+ wleft wwidth) sright)))
238
(when (eq direction 'up)
239
(setq nheight (- (+ wtop wheight) sbottom)))
240
(when (eq direction 'right)
241
(setq nwidth (- sleft wleft (- (car fdim) wwidth))))
242
(when (eq direction 'down)
243
(setq nheight (- stop wtop (- (cdr fdim) wheight))))
245
((tem (cons nwidth nheight)))
246
(maximize-truncate-dims w tem) ;truncate to column/row increments
247
(setq nwidth (car tem))
248
(setq nheight (cdr tem)))
249
(when (eq direction 'left)
250
(setq wleft (- wleft (- nwidth wwidth))))
251
(when (eq direction 'up)
252
(setq wtop (- wtop (- nheight wheight))))
253
(when grow-is-maximize
254
(unless (window-get w 'unmaximized-geometry)
255
(window-put w 'unmaximized-geometry (list (car wpos) (cdr wpos)
256
(car wdim) (cdr wdim))))
257
(if (memq direction '(left right))
258
(window-put w 'maximized-horizontally t)
259
(window-put w 'maximzed-vertically t)))
260
(move-resize-window-to w wleft wtop nwidth nheight)
261
(when maximize-raises (raise-window* w))
262
(when grow-is-maximize
263
(call-window-hook 'window-maximized-hook w
264
(list (if (member direction '(left right))
265
'horizontal 'vertical)))
266
(call-window-hook 'window-state-change-hook w (list '(maximized))))))
268
(defun pack-window (w direction)
269
(let* ((avoid-wins (gp-avoid-windows w direction))
270
(surround (gp-surrounding-rect avoid-wins))
271
(wpos (window-position w))
272
(wdim (window-frame-dimensions w))
277
(sleft (nth 0 surround))
278
(stop (nth 1 surround))
279
(sright (nth 2 surround))
280
(sbottom (nth 3 surround))
281
(wpointer (query-pointer-window))
282
(xpointer (car (query-pointer)))
283
(ypointer (cdr (query-pointer)))
284
(xoffset (- xpointer wleft))
285
(yoffset (- ypointer wtop)))
286
(when (eq direction 'left) (setq wleft sright))
287
(when (eq direction 'up) (setq wtop sbottom))
288
(when (eq direction 'right) (setq wleft (- sleft wwidth)))
289
(when (eq direction 'down) (setq wtop (- stop wheight)))
290
(move-window-to w wleft wtop)
291
(cond ((eq pack-warp-pointer 'always)
292
(warp-cursor-to-window w))
293
((eq pack-warp-pointer 'maybe)
294
(when (equal wpointer w)
295
(warp-cursor (+ wleft xoffset) (+ wtop yoffset)))))
296
(call-window-hook 'after-move-hook w
297
(list (list (if (memq direction '(left right))
298
'horizontal 'vertical)))))))
299
;; grow-pack.jl ends here.
added
removed
lisp/sawfish/wm/commands/grow-pack.jl
