1
;; move-resize.jl -- interactive moving and resizing of windows
2
;; $Id: move-resize.jl,v 1.85 2001/06/05 03:20:34 jsh Exp $
4
;; Copyright (C) 1999 John Harper <john@dcs.warwick.ac.uk>
6
;; This file is part of sawmill.
8
;; sawmill is free software; you can redistribute it and/or modify it
9
;; under the terms of the GNU General Public License as published by
10
;; the Free Software Foundation; either version 2, or (at your option)
13
;; sawmill is distributed in the hope that it will be useful, but
14
;; WITHOUT ANY WARRANTY; without even the implied warranty of
15
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16
;; GNU General Public License for more details.
18
;; You should have received a copy of the GNU General Public License
19
;; along with sawmill; see the file COPYING. If not, write to
20
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
22
(define-structure sawfish.wm.commands.move-resize
24
(export move-window-interactively
25
resize-window-interactively
27
resize-selected-window)
35
sawfish.wm.state.maximize
40
sawfish.wm.util.stacking
41
sawfish.wm.util.edges)
43
(define-structure-alias move-resize sawfish.wm.commands.move-resize)
45
;; we bind to disable-auto-raise
46
(eval-when-compile (require 'sawfish.wm.ext.auto-raise))
49
;; * obey the aspect ratio size hints
51
(defcustom move-outline-mode 'opaque
52
"How windows being moved are animated: \\w"
58
(defcustom resize-outline-mode 'opaque
59
"How windows being resized are animated: \\w"
65
(defcustom move-resize-raise-window nil
66
"Raise windows when they are moved or resized."
70
(defcustom move-show-position nil
71
"Show current position of windows while moving."
75
(defcustom resize-show-dimensions t
76
"Show current dimensions of windows while resizing."
80
(defcustom resize-edge-mode 'border
81
"How to choose window edges when resizing: \\w"
82
:type (choice region border grab border-grab)
86
(defcustom move-snap-edges t
87
"Snap window position to edges of other windows while moving."
91
(defcustom move-snap-epsilon 8
92
"Proximity in pixels before snapping to a window edge."
94
:depends move-snap-edges
98
(defcustom move-snap-mode 'resistance
99
"How to snap together window edges: \\w"
101
:depends move-snap-edges
102
:type (choice magnetism resistance attraction)
105
(defcustom move-snap-ignored-windows nil
106
"Snap to otherwise-ignored windows."
108
:depends move-snap-edges
112
(defcustom move-resize-inhibit-configure nil
113
"Only update window contents after it has stopped moving."
118
(defvar move-resize-map (bind-keys (make-keymap)
119
"Any-Off" (lambda () (finished))
120
"Any-Move" (lambda () (motion))
121
"Any-ESC" (lambda () (cancel))
122
"Any-RET" (lambda () (finished))
124
"Down" 'move-cursor-down
125
"Left" 'move-cursor-left
126
"Right" 'move-cursor-right
127
"S-Up" 'move-cursor-up-fine
128
"S-Down" 'move-cursor-down-fine
129
"S-Left" 'move-cursor-left-fine
130
"S-Right" 'move-cursor-right-fine))
132
(define fp-edges-alist '((top-border top)
135
(bottom-border bottom)
136
(top-left-corner top left)
137
(top-right-corner top right)
138
(bottom-left-corner bottom left)
139
(bottom-right-corner bottom right)))
141
(defvar move-cursor-shape (default-cursor))
142
(defvar resize-cursor-shape (default-cursor))
144
;; specials, should make these fluids (external users?)
145
(defvar move-resize-window nil)
146
(defvar move-resize-function nil)
147
(defvar move-resize-x nil)
148
(defvar move-resize-y nil)
149
(defvar move-resize-width nil)
150
(defvar move-resize-height nil)
151
(defvar move-resize-old-x nil)
152
(defvar move-resize-old-y nil)
153
(defvar move-resize-old-width nil)
154
(defvar move-resize-old-height nil)
155
(defvar move-resize-old-ptr-x nil)
156
(defvar move-resize-old-ptr-y nil)
157
(defvar move-resize-last-ptr nil)
158
(defvar move-resize-snap-state nil)
159
(defvar move-resize-mode nil)
160
(defvar move-resize-hints nil)
161
(defvar move-resize-frame nil)
162
(defvar move-resize-edges nil)
163
(defvar move-resize-last-outline nil)
164
(defvar move-resize-moving-edges nil)
165
(defvar move-resize-directions nil)
167
(define (delete-unmovable-directions directions)
168
(when move-lock-when-maximized
169
(when (window-maximized-vertically-p move-resize-window)
170
(setq directions (delq 'vertical directions)))
171
(when (window-maximized-horizontally-p move-resize-window)
172
(setq directions (delq 'horizontal directions))))
175
(define (delete-unresizable-edges edges)
176
(when move-lock-when-maximized
177
(when (window-maximized-vertically-p move-resize-window)
178
(setq edges (delq 'top (delq 'bottom edges))))
179
(when (window-maximized-horizontally-p move-resize-window)
180
(setq edges (delq 'left (delq 'right edges)))))
183
;; called to initiate a move or resize on window W. FUNCTION is either
184
;; `move' or `resize'
185
(define (do-move-resize w function)
186
(if (eq function 'move)
187
(call-window-hook 'before-move-hook w)
188
(call-window-hook 'before-resize-hook w))
189
(let* ((from-motion-event (and (current-event)
190
(string-match "-Move$" (event-name
192
(override-keymap move-resize-map)
193
;; don't want any complications..
194
(unbound-key-hook nil)
195
(disable-auto-raise t)
196
(move-resize-window w)
197
(move-resize-function function)
198
(move-resize-old-x (car (window-position w)))
199
(move-resize-old-y (cdr (window-position w)))
200
(move-resize-old-width (car (window-dimensions w)))
201
(move-resize-old-height (cdr (window-dimensions w)))
202
(move-resize-x move-resize-old-x)
203
(move-resize-y move-resize-old-y)
204
(move-resize-width move-resize-old-width)
205
(move-resize-height move-resize-old-height)
206
(move-resize-last-ptr (if from-motion-event
207
(query-button-press-pointer)
209
(move-resize-snap-state (cons))
210
(move-resize-old-ptr-x (car move-resize-last-ptr))
211
(move-resize-old-ptr-y (cdr move-resize-last-ptr))
212
(move-resize-hints (window-size-hints w))
213
(move-resize-frame (cons (- (car (window-frame-dimensions w))
214
move-resize-old-width)
215
(- (cdr (window-frame-dimensions w))
216
move-resize-old-height)))
217
(move-resize-mode (if (eq function 'move)
219
resize-outline-mode))
220
(move-resize-edges nil)
221
(move-resize-last-outline nil)
222
(move-resize-moving-edges move-resize-moving-edges)
223
(move-resize-directions move-resize-directions)
224
(old-frame-draw-mutex
225
(frame-draw-mutex (not (eq move-resize-mode 'opaque))))
226
(old-frame-state-mutex (frame-state-mutex 'clicked))
227
(old-synthetic-configure-mutex
228
(synthetic-configure-mutex move-resize-inhibit-configure))
232
(when (and move-resize-raise-window (eq move-resize-mode 'opaque))
233
;; only raise window initially if the display will get updated
237
(unless (eq move-resize-mode 'opaque)
238
(require 'sawfish.wm.util.window-outline)
239
;; prevent any other programs drawing on the display
241
(setq server-grabbed t))
243
(add-hook 'enter-workspace-hook update-edges)
244
(add-hook 'viewport-moved-hook update-edges)
247
(allow-events 'async-pointer)
248
;; ensure that we catch _all_ mouse events
250
nil (if (eq move-resize-function 'move)
251
move-cursor-shape resize-cursor-shape))
254
(grab-keyboard w) ;this may fail
255
(unless (eq move-resize-mode 'opaque)
256
(setq move-resize-last-outline
257
(list move-resize-mode
258
move-resize-x move-resize-y
260
(car move-resize-frame))
261
(+ move-resize-height
262
(cdr move-resize-frame)))))
263
(if (eq move-resize-function 'resize)
264
(unless (eq resize-edge-mode 'grab)
267
(when (viable-move-resize-p)
268
(unless (eq move-resize-mode 'opaque)
269
(apply draw-window-outline move-resize-last-outline))
271
(catch 'move-resize-done
272
(when from-motion-event
280
(display-message nil)
281
(frame-draw-mutex old-frame-draw-mutex)
282
(frame-state-mutex old-frame-state-mutex)
283
(synthetic-configure-mutex old-synthetic-configure-mutex)
284
(remove-hook 'enter-workspace-hook update-edges)
285
(remove-hook 'viewport-moved-hook update-edges))
287
(when (and move-resize-raise-window (not (eq move-resize-mode 'opaque)))
289
(if (eq function 'move)
290
(call-window-hook 'after-move-hook w
291
(list move-resize-directions
292
#:successful was-successful))
293
(call-window-hook 'after-resize-hook w
294
(list move-resize-moving-edges
295
#:successful was-successful)))))
297
(define (update-edges)
298
(setq move-resize-edges
301
(get-visible-window-edges
302
#:with-ignored-windows move-snap-ignored-windows
303
#:windows-to-ignore (list move-resize-window)
304
#:include-heads t)))))
306
;; called each pointer motion event during move/resize
308
(let* ((this-ptr (query-pointer))
309
(ptr-x (car this-ptr))
310
(ptr-y (cdr this-ptr))
311
logical-width logical-height)
312
(unless (eq move-resize-mode 'opaque)
313
(apply erase-window-outline move-resize-last-outline))
314
(cond ((eq move-resize-function 'move)
315
(when (memq 'horizontal move-resize-directions)
316
(setq move-resize-x (+ move-resize-old-x
317
(- ptr-x move-resize-old-ptr-x))))
318
(when (memq 'vertical move-resize-directions)
319
(setq move-resize-y (+ move-resize-old-y
320
(- ptr-y move-resize-old-ptr-y))))
321
(when move-snap-edges
323
((coords (snap-window-position-to-edges
324
move-resize-window (cons move-resize-x
326
(cons (- ptr-x (car move-resize-last-ptr))
327
(- ptr-y (cdr move-resize-last-ptr)))
328
move-resize-snap-state move-snap-epsilon
329
move-resize-edges move-snap-mode)))
330
(setq move-resize-x (car coords))
331
(setq move-resize-y (cdr coords)))))
332
((eq move-resize-function 'resize)
334
((x-base (or (cdr (or (assq 'base-width move-resize-hints)
335
(assq 'min-width move-resize-hints))) 1))
336
(x-inc (or (cdr (assq 'width-inc move-resize-hints)) 1))
337
(y-base (or (cdr (or (assq 'base-height move-resize-hints)
338
(assq 'min-height move-resize-hints))) 1))
339
(y-inc (or (cdr (assq 'height-inc move-resize-hints)) 1)))
340
(when (memq resize-edge-mode '(grab border-grab))
341
(add-edges ptr-x ptr-y))
343
((memq 'right move-resize-moving-edges)
344
(setq move-resize-width
345
(constrain-dimension-to-hints
346
(+ move-resize-old-width
347
(- ptr-x move-resize-old-ptr-x))
348
'x move-resize-hints)))
349
((memq 'left move-resize-moving-edges)
350
(setq move-resize-width
351
(constrain-dimension-to-hints
352
(+ move-resize-old-width
353
(- move-resize-old-ptr-x ptr-x))
354
'x move-resize-hints))
355
(setq move-resize-x (- move-resize-old-x
357
move-resize-old-width)))))
359
((memq 'bottom move-resize-moving-edges)
360
(setq move-resize-height
361
(constrain-dimension-to-hints
362
(+ move-resize-old-height
363
(- ptr-y move-resize-old-ptr-y))
364
'y move-resize-hints)))
365
((memq 'top move-resize-moving-edges)
366
(setq move-resize-height
367
(constrain-dimension-to-hints
368
(+ move-resize-old-height
369
(- move-resize-old-ptr-y ptr-y))
370
'y move-resize-hints))
371
(setq move-resize-y (- move-resize-old-y
372
(- move-resize-height
373
move-resize-old-height)))))
374
(setq logical-width (quotient (- move-resize-width
376
(setq logical-height (quotient (- move-resize-height
378
(call-window-hook (if (eq move-resize-function 'move)
380
'while-resizing-hook) move-resize-window)
381
(cond ((and (eq move-resize-function 'resize) resize-show-dimensions)
382
(display-message (format nil "%dx%d"
383
;; XXX broken if while-resizing-hook
384
;; XXX changes dimensions..
385
logical-width logical-height)))
386
((and (eq move-resize-function 'move) move-show-position)
387
(display-message (format nil "%+d%+d"
388
move-resize-x move-resize-y))))
389
(if (eq move-resize-mode 'opaque)
391
(let ((m-dim-x (+ move-resize-width (car move-resize-frame)))
392
(m-dim-y (+ move-resize-height (cdr move-resize-frame))))
393
(setq move-resize-last-outline (list move-resize-mode
394
move-resize-x move-resize-y
396
(apply draw-window-outline move-resize-last-outline)))
397
(setq move-resize-last-ptr this-ptr)))
399
;; called when the move/resize finished (i.e. button-release event)
401
(unless (eq move-resize-mode 'opaque)
402
(apply erase-window-outline move-resize-last-outline))
404
(throw 'move-resize-done t))
407
(if (eq move-resize-mode 'opaque)
408
(move-resize-window-to move-resize-window
409
move-resize-old-x move-resize-old-y
410
move-resize-old-width move-resize-old-height)
411
(apply erase-window-outline move-resize-last-outline))
412
(throw 'move-resize-done nil))
414
;; commit the current state of the move or resize
415
(define (apply-changes)
417
((>= move-resize-x (screen-width))
418
(setq move-resize-x (1- (screen-width))))
419
((<= move-resize-x (- (+ move-resize-width (car move-resize-frame))))
420
(setq move-resize-x (1+ (- (+ move-resize-width
421
(car move-resize-frame)))))))
423
((>= move-resize-y (screen-height))
424
(setq move-resize-y (1- (screen-height))))
425
((<= move-resize-y (- (+ move-resize-height (cdr move-resize-frame))))
426
(setq move-resize-y (1+ (- (+ move-resize-height
427
(cdr move-resize-frame)))))))
428
(move-resize-window-to move-resize-window
429
move-resize-x move-resize-y
430
move-resize-width move-resize-height))
432
;; called when moving, tries to decide which edges to move, which to stick
433
(define (infer-anchor)
434
(unless move-resize-moving-edges
436
(if (and (memq resize-edge-mode '(border border-grab))
438
(setq tem (frame-part-get (clicked-frame-part) 'class))
439
(setq tem (cdr (assq tem fp-edges-alist))))
440
(setq move-resize-moving-edges (copy-sequence tem))
441
(cond ((<= (- move-resize-old-ptr-x move-resize-old-x)
442
(/ move-resize-old-width 3))
443
(setq move-resize-moving-edges
444
(cons 'left move-resize-moving-edges)))
445
((>= (- move-resize-old-ptr-x move-resize-old-x)
446
(* (/ move-resize-old-width 3) 2))
447
(setq move-resize-moving-edges
448
(cons 'right move-resize-moving-edges))))
449
(cond ((<= (- move-resize-old-ptr-y move-resize-old-y)
450
(/ move-resize-old-height 3))
451
(setq move-resize-moving-edges
452
(cons 'top move-resize-moving-edges)))
453
((>= (- move-resize-old-ptr-y move-resize-old-y)
454
(* (/ move-resize-old-height 3) 2))
455
(setq move-resize-moving-edges
456
(cons 'bottom move-resize-moving-edges)))))))
457
(when (null move-resize-moving-edges)
458
(setq move-resize-moving-edges '(bottom right)))
459
(setq move-resize-moving-edges (delete-unresizable-edges
460
move-resize-moving-edges)))
462
(define (add-edges ptr-x ptr-y)
463
(unless (or (and move-lock-when-maximized
464
(window-maximized-horizontally-p move-resize-window))
465
(memq 'left move-resize-moving-edges)
466
(memq 'right move-resize-moving-edges))
467
(cond ((< ptr-x move-resize-x)
468
(setq move-resize-moving-edges
469
(cons 'left move-resize-moving-edges))
470
(setq move-resize-old-ptr-x move-resize-x))
471
((> ptr-x (+ move-resize-x move-resize-width
472
(car move-resize-frame)))
473
(setq move-resize-moving-edges
474
(cons 'right move-resize-moving-edges))
475
(setq move-resize-old-ptr-x (+ move-resize-x move-resize-width
476
(car move-resize-frame))))))
477
(unless (or (and move-lock-when-maximized
478
(window-maximized-vertically-p move-resize-window))
479
(memq 'top move-resize-moving-edges)
480
(memq 'bottom move-resize-moving-edges))
481
(cond ((< ptr-y move-resize-y)
482
(setq move-resize-moving-edges
483
(cons 'top move-resize-moving-edges))
484
(setq move-resize-old-ptr-y move-resize-y))
485
((> ptr-y (+ move-resize-y move-resize-height
486
(cdr move-resize-frame)))
487
(setq move-resize-moving-edges
488
(cons 'bottom move-resize-moving-edges))
489
(setq move-resize-old-ptr-y (+ move-resize-y move-resize-height
490
(cdr move-resize-frame)))))))
492
(define (infer-directions)
493
(unless move-resize-directions
494
(setq move-resize-directions
495
(if (window-get move-resize-window 'fixed-position)
497
(list 'vertical 'horizontal))))
498
(setq move-resize-directions (delete-unmovable-directions
499
move-resize-directions)))
501
(define (viable-move-resize-p)
502
(if (eq move-resize-function 'move)
503
(not (null (delete-unmovable-directions
504
(copy-sequence move-resize-directions))))
505
(not (null (delete-unresizable-edges
506
(if (memq resize-edge-mode '(region border))
508
(copy-sequence move-resize-moving-edges)
509
(list 'top 'bottom 'left 'right)))))))
514
(define (lost-window w)
515
(when (eq move-resize-window w)
518
(add-hook 'unmap-notify-hook lost-window t)
519
(add-hook 'destroy-notify-hook lost-window t)
524
(define (move-window-interactively w)
525
"Move the window interactively using the mouse."
526
(do-move-resize w 'move))
528
(define (resize-window-interactively w)
529
"Resize the window interactively using the mouse."
530
(do-move-resize w 'resize))
532
(define (move-selected-window)
533
"Wait for the user to select a window, then interactively move that window."
534
(let ((w (select-window)))
536
(move-window-interactively w))))
538
(define (resize-selected-window)
539
"Wait for the user to select a window, then interactively resize that window."
540
(let ((w (select-window)))
542
(resize-window-interactively w))))
545
(define-command 'move-window-interactively
546
move-window-interactively #:spec "%W")
547
(define-command 'resize-window-interactively
548
resize-window-interactively #:spec "%W")
549
(define-command 'move-selected-window move-selected-window)
550
(define-command 'resize-selected-window resize-selected-window))
added
removed
lisp/sawfish/wm/commands/move-resize.jl
