home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / near-mouse.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  1KB  |  43 lines
  1. ;; User contribution: A window placement policy function.
  2. ;; ======================================================
  3. ;;Date: Wed, 10 Apr 91 13:18:17 met
  4. ;;From: Eyvind Ness <eyvind@hrp.no>
  5. ;;    |Eyvind Ness            |Internet Email: eyvind@hrp.no
  6. ;;    |Researcher            |Phone: +47 9 183100
  7. ;;    |Control Room Systems Division    |Fax: +47 9 187109
  8. ;;    |OECD Halden Reactor Project    |
  9. ;;    |Norway                |
  10.  
  11. ;; Here is a little tidbit for GWM hackers. This function makes small
  12. ;; windows pop up near the mouse, 
  13. ;; use by telling (set-placement MyWindow near-mouse)
  14.  
  15. ;; (GWM Lisp has no floating point arithmetic.)
  16. (defname 'max-ww screen. '(/ (* screen-width 3) 4))
  17. (defname 'max-wh screen. '(/ (* screen-height 3) 4))
  18.  
  19. (defun near-mouse (just-created-p)
  20.   (if just-created-p
  21.     (if (and (not window-was-on-screen) 
  22.     (not window-starts-iconic)
  23.     (not (and window-user-set-position
  24.         (= window-status 'window)))
  25.     (not (or (> window-width max-ww) (> window-height max-wh))))
  26.       (progn
  27.     (setq here-list (current-mouse-position))
  28.     (setq mouse-x (# 0 here-list))
  29.     (setq mouse-y (# 1 here-list))
  30.     
  31.     (move-window
  32.       (max
  33.         0
  34.         (min
  35.           (- screen-width window-width)
  36.           (- mouse-x (/ window-width 2))))
  37.       (max
  38.         0
  39.         (min
  40.           (- screen-height window-height)
  41.           (- mouse-y (/ window-height 2)))))))))
  42.  
  43.