131 lines
4.5 KiB
Plaintext
131 lines
4.5 KiB
Plaintext
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;; MoveOpaque functions for gwm. Needs at least gwm v1.5c
|
|
;;; by Colas Nahaboo (colas@mirsa.inria.fr).
|
|
;;; Modified: Gary Oberbrunner (garyo@think.com), Aug. 10, 1989
|
|
;;; Modified: Richard Hess (..!uunet!cimshop!rhess), Dec. 12, 1989
|
|
;;; Modified: Colas Nahaboo (colas@mirsa.inria.fr), Feb. 28, 1990
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; user-settable parameters
|
|
|
|
(defaults-to
|
|
move-opaque.condition '(< (* window-width window-height)
|
|
move-opaque.cutoff-area)
|
|
move-opaque.cutoff-area 250000
|
|
move-opaque.feedback-hook ())
|
|
|
|
|
|
; do not re-set the old value twice
|
|
(if (not (boundp 'move-opaque.original-move-window))
|
|
(setq move-opaque.original-move-window move-window))
|
|
|
|
(defun >> (val shift)
|
|
(while (> shift 0)
|
|
(setq val (/ val 2))
|
|
(setq shift (- shift 1))
|
|
)
|
|
val)
|
|
|
|
(defun << (val shift)
|
|
(while (> shift 0)
|
|
(setq val (* val 2))
|
|
(setq shift (- shift 1))
|
|
)
|
|
val)
|
|
|
|
(defun button-to-mask (b)
|
|
(* (<< 1 (- b 1))
|
|
with-button-1))
|
|
|
|
(setq button-masks
|
|
(list 0 (button-to-mask 1)(button-to-mask 2)(button-to-mask 3)))
|
|
|
|
(defun opaque-window-move ()
|
|
(if (not (= 0 (current-event-code))) ; we come from button
|
|
(with (wob window
|
|
mouse-pos ()
|
|
pressed-button (# (current-event-code) button-masks)
|
|
button-state (bitwise-and pressed-button
|
|
(current-event-modifier))
|
|
window-coords (current-event-window-coords)
|
|
dx (+ (# 4 window-coords) wob-borderwidth)
|
|
dy (+ (# 5 window-coords) wob-borderwidth)
|
|
last-x (+ dx window-x)
|
|
last-y (+ dy window-y)
|
|
wx 0 wy 0
|
|
maxx (- screen-width window-width (* 2 wob-borderwidth))
|
|
maxy (- screen-height window-height (* 2 wob-borderwidth))
|
|
)
|
|
(allow-event-processing) ; un-freeze click-to-type wms
|
|
(tag button-released
|
|
(while t
|
|
(setq mouse-pos (current-mouse-position))
|
|
(process-exposes)
|
|
(if (= (bitwise-and pressed-button (# 2 mouse-pos))
|
|
button-state)
|
|
(exit button-released)
|
|
(if (not (and (= last-x (# 0 mouse-pos))
|
|
(= last-y (# 1 mouse-pos))))
|
|
(if (= 0 confine-windows)
|
|
(progn
|
|
(move-opaque.original-move-window
|
|
(- (setq last-x (# 0 mouse-pos)) dx)
|
|
(- (setq last-y (# 1 mouse-pos)) dy))
|
|
(eval move-opaque.feedback-hook))
|
|
(progn
|
|
(: wx (- (: last-x (# 0 mouse-pos)) dx))
|
|
(: wy (- (: last-y (# 1 mouse-pos)) dy))
|
|
(if (< wx 0) (: wx 0)
|
|
(< maxx wx) (: wx maxx))
|
|
(if (< wy 0) (: wy 0)
|
|
(< maxy wy) (: wy maxy))
|
|
(move-opaque.original-move-window wx wy)
|
|
(eval move-opaque.feedback-hook)
|
|
)))))))
|
|
|
|
(move-opaque.original-move-window) ; we do not come from button:
|
|
; just use outline to see something
|
|
; with user-positioning
|
|
))
|
|
|
|
;; now we redefine move-window.
|
|
;; If there are any args, we just call the old move-window.
|
|
;; if no args, it's interactive, so we decide based on window area how
|
|
;; to move it.
|
|
(defunq move-window args
|
|
(if (> (length args) 0)
|
|
(eval (+ '(move-opaque.original-move-window) args))
|
|
(if (eval move-opaque.condition)
|
|
(opaque-window-move)
|
|
(move-opaque.original-move-window)
|
|
)))
|
|
|
|
|
|
(defun move-opaque-virtual-pan (x y)
|
|
(if (and (= 0 confine-windows)
|
|
(or (= x 0) (= x (- screen-width 1))
|
|
(= y 0) (= y (- screen-height 1))))
|
|
(with (xdir (if (< x pan-corner-width) 1
|
|
(> x (- screen-width pan-corner-width 1)) -1
|
|
0)
|
|
ydir (if (< y pan-corner-width) 1
|
|
(> y (- screen-height pan-corner-width 1)) -1
|
|
0)
|
|
xstep (if pan-on-click virtual-horizontal-step pan-x-step)
|
|
ystep (if pan-on-click virtual-vertical-step pan-y-step))
|
|
(virtual-move-windows (* xstep xdir) (* ystep ydir))
|
|
(if pan-warp-wrapped
|
|
(warp-pointer (* (- xstep pan-warp-step) xdir)
|
|
(* (- ystep pan-warp-step) ydir))
|
|
(progn
|
|
(warp-pointer (* pan-warp-step xdir)
|
|
(* pan-warp-step ydir))
|
|
(setq mouse-pos (current-mouse-position))
|
|
(move-opaque.original-move-window
|
|
(- (setq last-x (# 0 mouse-pos)) dx)
|
|
(- (setq last-y (# 1 mouse-pos)) dy)))))))
|
|
|
|
(setq move-opaque.feedback-hook '(if (eval (boundp 'show-pan-lists))
|
|
(move-opaque-virtual-pan last-x last-y)))
|
|
|
|
|