home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / vtwm-zoom.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  6KB  |  137 lines
  1. ;; vtwm-zoom.gwm --- Window zooming functions for the VTWM profile
  2. ;;
  3. ;; Author: Anders Holst  (aho@sans.kth.se)  
  4. ;; Copyright (C) 1995  Anders Holst
  5. ;; Version: vtwm-1.0
  6. ;; Last change: 17/6 1995
  7. ;;
  8. ;; This file is copyrighted under the same terms as the rest of GWM
  9. ;; (see the X Inc license for details). There is no warranty that it
  10. ;; works. 
  11. ;;
  12. ;; --------------------------------------------------------------------- 
  13. ;;
  14. ;; The original zoom code came from Jay Berkenbilt. This is just an
  15. ;; adaption of it to the VTWM profile, with several different ways of
  16. ;; zooming added.
  17. ;;
  18.  
  19. ;;
  20. ;;    USER CUSTOMIZABLE VARIABLES
  21. ;;    ---------------------------  
  22. ;;    Adjust these in your own profile
  23. ;;
  24. (defaults-to
  25.   zoom-offset 3                        ; Minimum distance to screen edge.
  26.   zoom-window-method-list ()           ; List of (wind-type zoom-func) specs.
  27.        ; This is to make zoom-window use different zoom methods for different
  28.        ; types of windows.
  29. )
  30.  
  31.  
  32. ;; You can use this to define several further zooming functions, as below.
  33. (defun zoom-window-aux (name method)
  34.   (pop-to-window)
  35.   (with (zoomed (# 'zoom window)
  36.          old-pos (# 'zpos window)         ;; virtual screen is tricky
  37.          old-x (if old-pos (if (virtual-nailed) (# 0 old-pos)
  38.                              (- (virtual-x (- (# 0 old-pos))))))
  39.          old-y (if old-pos (if (virtual-nailed) (# 1 old-pos)
  40.                              (- (virtual-y (- (# 1 old-pos))))))
  41.          db (* (with (wob window) wob-borderwidth) 2))
  42.     (if (= zoomed name)
  43.         (progn                            ;; unzoom window
  44.           (## 'zoom window ())
  45.           (move-window old-x old-y)
  46.           (resize-window (+ (# 2 old-pos) db) (+ (# 3 old-pos) db)))
  47.         (not zoomed)
  48.         (progn                            ;; zoom window
  49.           (## 'zoom window name)
  50.           (## 'zpos window (list (if (virtual-nailed) window-x
  51.                                    (virtual-x window-x))
  52.                                  (if (virtual-nailed) window-y
  53.                                    (virtual-y window-y))
  54.                                  window-width window-height))
  55.           (method window-x window-y (+ window-width db) (+ window-height db)))
  56.         (progn                            ;; rezoom window
  57.           (## 'zoom window name)
  58.           (method old-x old-y (+ (# 2 old-pos) db) (+ (# 3 old-pos) db))))))
  59.  
  60. (defun zoom-window-full ()
  61.   (zoom-window-aux 'zoom-window-full
  62.                    (lambda (x y w h)
  63.                      (move-window zoom-offset zoom-offset)
  64.                      (resize-window (- screen-width (* zoom-offset 2))
  65.                                     (- screen-height (* zoom-offset 2))))))
  66.  
  67. (defun zoom-window-vert ()
  68.   (zoom-window-aux 'zoom-window-vert
  69.                    (lambda (x y w h)
  70.                      (move-window x zoom-offset)
  71.                      (resize-window w
  72.                                     (- screen-height (* zoom-offset 2))))))
  73.  
  74. (defun zoom-window-horiz ()
  75.   (zoom-window-aux 'zoom-window-horiz
  76.                    (lambda (x y w h)
  77.                      (move-window zoom-offset y)
  78.                      (resize-window (- screen-width (* zoom-offset 2))
  79.                                     h))))
  80.  
  81. (defun zoom-window-left ()
  82.   (zoom-window-aux 'zoom-window-left
  83.                    (lambda (x y w h)
  84.                      (with (zoffh (/ (+ zoom-offset 1) 2))
  85.                        (move-window zoom-offset zoom-offset)
  86.                        (resize-window (- (/ screen-width 2) zoom-offset zoffh)
  87.                                       (- screen-height (* zoom-offset 2)))))))
  88.  
  89. (defun zoom-window-right ()
  90.   (zoom-window-aux 'zoom-window-right
  91.                    (lambda (x y w h)
  92.                      (with (zoffh (/ (+ zoom-offset 1) 2))
  93.                        (move-window (+ (/ screen-width 2) zoffh) zoom-offset)
  94.                        (resize-window (- (/ screen-width 2) zoom-offset zoffh)
  95.                                       (- screen-height (* zoom-offset 2)))))))
  96.  
  97. (defun zoom-window-top ()
  98.   (zoom-window-aux 'zoom-window-top
  99.                    (lambda (x y w h)
  100.                      (with (zoffh (/ (+ zoom-offset 1) 2))
  101.                        (move-window zoom-offset zoom-offset)
  102.                        (resize-window (- screen-width (* zoom-offset 2))
  103.                                       (- (/ screen-height 2) zoom-offset zoffh))))))
  104.  
  105. (defun zoom-window-bottom ()
  106.   (zoom-window-aux 'zoom-window-bottom
  107.                    (lambda (x y w h)
  108.                      (with (zoffh (/ (+ zoom-offset 1) 2))
  109.                        (move-window zoom-offset (+ (/ screen-height 2) zoffh))
  110.                        (resize-window (- screen-width (* zoom-offset 2))
  111.                                       (- (/ screen-height 2) zoom-offset zoffh))))))
  112.  
  113. (defun zoom-window-prop ()
  114.   (zoom-window-aux 'zoom-window-prop
  115.                    (lambda (x y w h)
  116.                      (with (bw (with (wob window) wob-borderwidth)
  117.                             wbs (+ (- window-width window-client-width) (* 2 bw))
  118.                             hbs (+ (- window-height window-client-height) (* 2 bw))
  119.                             prop (min (/ (* (- screen-width wbs (* zoom-offset 2))
  120.                                             1000) (- w wbs))
  121.                                       (/ (* (- screen-height hbs (* zoom-offset 2))
  122.                                             1000) (- h hbs)))
  123.                             neww (+ (/ (* (- w wbs) prop) 1000) wbs)
  124.                             newh (+ (/ (* (- h hbs) prop) 1000) hbs)
  125.                             newx (/ (- screen-width neww) 2)
  126.                             newy (/ (- screen-height newh) 2))
  127.                         (move-window newx newy)
  128.                         (resize-window neww newh)))))
  129.  
  130. (defun zoom-window ()
  131.   (with (method (matches-cond zoom-window-method-list))
  132.     (if method
  133.         (eval method)
  134.       (zoom-window-full))))
  135.  
  136.  
  137.