home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / move-opaque.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  3KB  |  99 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;; MoveOpaque functions for gwm. Needs at least gwm v1.5c
  3. ;;; by Colas Nahaboo (colas@mirsa.inria.fr).
  4. ;;; Modified:  Gary Oberbrunner (garyo@think.com), Aug. 10, 1989
  5. ;;; Modified:  Richard Hess (..!uunet!cimshop!rhess), Dec. 12, 1989
  6. ;;; Modified:  Colas Nahaboo (colas@mirsa.inria.fr), Feb. 28, 1990
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8.  
  9. ;; user-settable parameters
  10.  
  11. (defaults-to
  12.   move-opaque.condition  '(< (* window-width window-height)
  13.                  move-opaque.cutoff-area)
  14.   move-opaque.cutoff-area 250000)
  15.  
  16.  
  17. ; do not re-set the old value twice
  18. (if (not (boundp 'move-opaque.original-move-window))
  19.     (setq move-opaque.original-move-window move-window))
  20.  
  21. (defun >> (val shift)
  22.   (while (> shift 0)
  23.     (setq val (/ val 2))
  24.     (setq shift (- shift 1))
  25.     )
  26.   val)
  27.  
  28. (defun << (val shift)
  29.   (while (> shift 0)
  30.     (setq val (* val 2))
  31.     (setq shift (- shift 1))
  32.     )
  33.   val)
  34.  
  35. (defun button-to-mask (b)
  36.   (* (<< 1 (- b 1))
  37.      with-button-1))
  38.  
  39. (setq button-masks
  40.       (list 0 (button-to-mask 1)(button-to-mask 2)(button-to-mask 3)))
  41.  
  42. (defun opaque-window-move ()
  43.   (if (not (= 0 (current-event-code)))        ; we come from button
  44.       (with (wob window
  45.          mouse-pos ()
  46.          pressed-button (# (current-event-code) button-masks)
  47.          button-state (bitwise-and pressed-button
  48.                        (current-event-modifier))
  49.          window-coords (current-event-window-coords)
  50.          dx (+ (# 4 window-coords) wob-borderwidth)
  51.          dy (+ (# 5 window-coords) wob-borderwidth)
  52.          last-x (+ dx window-x)
  53.          last-y (+ dy window-y)
  54.          wx 0 wy 0
  55.          maxx (- screen-width window-width (* 2 wob-borderwidth))
  56.          maxy (- screen-height window-height (* 2 wob-borderwidth))
  57.          )
  58.     (allow-event-processing)    ; un-freeze click-to-type wms
  59.     (tag button-released
  60.          (while t
  61.            (setq mouse-pos (current-mouse-position))
  62.            (process-exposes)
  63.            (if (= (bitwise-and pressed-button (# 2 mouse-pos))
  64.               button-state)
  65.            (exit button-released)
  66.          (if (not (and (= last-x (# 0 mouse-pos))
  67.                    (= last-y (# 1 mouse-pos))))
  68.              (if (= 0 confine-windows)
  69.              (move-opaque.original-move-window
  70.                      (- (setq last-x (# 0 mouse-pos)) dx)
  71.                      (- (setq last-y (# 1 mouse-pos)) dy))
  72.                (progn
  73.              (: wx (- (: last-x (# 0 mouse-pos)) dx))
  74.              (: wy (- (: last-y (# 1 mouse-pos)) dy))
  75.              (if (< wx 0) (: wx 0)
  76.                (< maxx wx) (: wx maxx))
  77.              (if (< wy 0) (: wy 0)
  78.                (< maxy wy) (: wy maxy))
  79.              (move-opaque.original-move-window wx wy)
  80.              )))))))
  81.  
  82.     (move-opaque.original-move-window)    ; we do not come from button:
  83.                     ; just use outline to see something
  84.                     ; with user-positioning
  85.     ))
  86.  
  87. ;; now we redefine move-window.
  88. ;; If there are any args, we just call the old move-window.
  89. ;; if no args, it's interactive, so we decide based on window area how
  90. ;; to move it.
  91. (defunq move-window args
  92.   (if (> (length args) 0)
  93.       (eval (+ '(move-opaque.original-move-window) args))
  94.       (if (eval move-opaque.condition)
  95.       (opaque-window-move)
  96.       (move-opaque.original-move-window)
  97.       )))
  98.  
  99.