home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / mwm-placements.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  3KB  |  118 lines
  1.  
  2. ;;File: mwm-placements.gwm -- functions to automatically place mwm windows on screen
  3. ;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
  4. ;;Author: Frederic CHARTON
  5. ;;Author: Glen WHITNEY
  6. ;;Revision: 1.1 -- June 26 1989
  7. ;;Revision: "Mapping closed windows" bug fixed -- 30 November 1992
  8. ;;State: Exp
  9. ;;GWM Version: 1.7l
  10.  
  11. ; PLACEMENTS
  12. ; ==========
  13.  
  14. (df place-window-in-screen ()
  15.   (with (x (window-x)
  16.      y (window-y)
  17.      xe (+ x (window-width))
  18.          ye (+ y (window-height)))
  19.     (if (< x 0) (move-window 0 y))
  20.     (if (< y 0) (move-window x 0))
  21.     (if (> xe screen-width) (move-window (- screen-width
  22.                         (window-width)) y))
  23.     (if (> ye screen-height) (move-window x (- screen-height
  24.                            (window-height))))))
  25.  
  26. (defun obscuring-something (windough)
  27.   (with (result nil window windough myx window-x myy window-y)
  28.     (for window (list-of-windows)
  29.      (if (and (not (= window windough))
  30.           (dist-below window-x window-y myx myy tooClose))
  31.          (: result t)))
  32.     result))
  33.  
  34. (defun dist-below (x1 y1 x2 y2 threshold)
  35.   (< (+ (square (- x2 x1)) (square (- y2 y1))) (square threshold)))
  36. (defun square (num)
  37.   (* num num))
  38.  
  39. (de mwm-window-placement (flag)
  40.     (if flag
  41.     (progn
  42.       (if (and (not window-was-on-screen) 
  43.            (not window-starts-iconic)
  44.            (not window-is-transient-for)
  45.            interactivePlacement
  46.            (not (and window-user-set-position
  47.                  (= window-status 'window))))
  48.           (progn (: l (current-mouse-position))
  49.              (if (member 'placement showFeedback)
  50.              (progn
  51.                (meter-open-in-place)
  52.                (meter-update    (+ "( " (itoa window-x) " , "
  53.                            (itoa window-y) ")    "
  54.                            (itoa window-width) " x "
  55.                            (itoa window-height)))))
  56.              (: x (# 0 l))
  57.              (: y (# 1 l))
  58.              (with (move-meter 1) (move-window x y))
  59.              (process-exposes)
  60.              (: new-window window)
  61.              (with (cursor place-cursor) (move-window))
  62.              (if (member 'placement showFeedback) (meter-close))
  63.              )
  64.         (progn ; else
  65. ;              (if positionIsFrame 
  66. ;        (move-window (+ window-x window-client-x) 
  67. ;                 (+ window-y window-client-y)))
  68.           (if positionOnScreen (place-window-in-screen))
  69.           (if clientAutoPlace
  70.           (with (oldx window-x oldy window-y try t)
  71.             (while (and (obscuring-something window) try)
  72.               (move-window (+ window-x clientAutoXOffset)
  73.                        (+ window-y clientAutoYOffset))
  74.               (if positionOnScreen (place-window-in-screen))
  75.               (if (and (= window-x oldx) (= window-y oldy))
  76.                   {(move-window 0 0) (: try ())})
  77.               (: oldx window-x)
  78.               (: oldy window-y)))))
  79.         )
  80.       (map-window))
  81.       ))
  82.  
  83. (defun meter-open-in-place ()
  84.   (with (position (meter 'x 0 'y 0))
  85.     (meter-open (nth 1 position) (nth 3 position) " ")))
  86.  
  87. ; Icon Placement :
  88. ; --------------
  89. (defun mwm-icon-placement (flag)
  90.  (if iconAutoPlace
  91.     (if flag                ; open new window
  92.     (if (member window (list-of-windows))
  93.         (with (thePlace (auto-get-place)
  94.                 X (# 0 thePlace)
  95.                 Y (# 1 thePlace)
  96.                 )
  97.           (## 'X window X)
  98.           (## 'Y window Y)
  99.           (eval (+ '(move-window) (XY-to-xy X Y)))
  100.           (set-icon-of-array X Y window)
  101.           ))
  102.     ; close managed window
  103.     (with (X (# 'X window-property) 
  104.            Y (# 'Y window-property)
  105.           )
  106.      (if X (set-icon-of-array X Y ()))
  107.     )
  108.     )
  109.   (with (window window-window)
  110.    (move-window window-icon (+ window-x window-client-x)
  111.         (+ window-y window-client-y))
  112.    )))
  113.  
  114.  
  115.  
  116.  
  117.     
  118.