home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / placements.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  11KB  |  405 lines
  1. ; PLACEMENTS
  2. ; ==========
  3.  
  4. ;;File: placements.gwm -- functions to automatically place windows on screen
  5. ;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
  6. ;;Revision: 2.0 -- Nov 24 1989
  7. ;;State: Exp
  8. ;;GWM Version: 1.5
  9.  
  10. ; asks the user to place window if geometry wasn't specified
  11.  
  12. (de user-positioning (flag)
  13.     (if flag
  14.     (if (not (or window-was-on-screen
  15.              window-starts-iconic
  16.              (and window-user-set-position
  17.               (= window-status 'window))
  18.              window-is-transient-for
  19.              ))
  20.         (progn (: l (current-mouse-position))
  21.            (meter-open-in-place)
  22.            (meter-update    (+ "Window: " 
  23.                        (window-client-class) "."
  24.                        (window-client-name) "."
  25.                        (window-name) "@"
  26.                        (window-machine-name)))
  27.            (: x (# 0 l))
  28.            (: y (# 1 l))
  29.            (move-window x y)
  30.            (process-exposes)
  31.            (: new-window window)
  32.            (move-window)
  33.            (meter-close))
  34.       (if (< window-y 0)(move-window window-x 0))
  35.       ))))))
  36.  
  37. (defun meter-open-in-place ()
  38.   (with (position (meter 'x 0 'y 0))
  39.     (meter-open (nth 1 position) (nth 3 position) " ")))
  40.  
  41. ; placed lists package required
  42.  
  43. (if (not (boundp 'Dlists)) (load "dlists.gwm")))))
  44.  
  45. ; rows package
  46. ; struct row:
  47. ;   0 dlist
  48. ;   1 start of list [coords]
  49. ;   2 func: coords from cur window [() -> coords]
  50. ;   3 func: move window at coords [(x y) ->()]
  51. ;   4 separator [int]
  52. ;   5 flag t if horiz
  53. ;   6 end of list [first coord]
  54. ;   7 func: "width" of current window
  55. ;   8 func: sorting function
  56. ;   9 atom: row name
  57.  
  58. (setq rows.length 10)
  59.  
  60. ;
  61. ; all functions must have current row in var "row"
  62. ; rows:
  63.  
  64. (defname 'top-left screen.)
  65. (defname 'top-right screen.)
  66. (defname 'right-top screen.)
  67. (defname 'right-down screen.)
  68. (defname 'down-right screen.)
  69. (defname 'down-left screen.)
  70. (defname 'left-down screen.)
  71. (defname 'left-top screen.)
  72.  
  73. (defname 'rows.top-left screen.
  74.   '(list (Dlists.make top-left)
  75.      '(0 0)
  76.      (lambda () (list (+ window-x window-width (wbw) (# 4 row))
  77.               window-y))
  78.      (lambda (x y) (rows.move x y))
  79.      0
  80.      t
  81.      screen-width
  82.      (lambda () (+ window-y window-height (wbw)))
  83.      ()
  84.      'rows.top-left
  85.      )))
  86.  
  87. (defname 'rows.top-right screen.
  88.   '(list (Dlists.make top-right)
  89.      '(0 0)
  90.      (lambda () (list (+ screen-width (# 4 row) (- window-x)) window-y))
  91.      (lambda (x y) (rows.move (- screen-width x window-width (wbw)) y))
  92.      0
  93.      t
  94.      screen-width
  95.      (lambda () (+ window-y window-height (wbw)))
  96.      ()
  97.      'rows.top-right
  98.      )))
  99.  
  100. (defname 'rows.right-top screen.
  101.   '(list (Dlists.make right-top)
  102.      '(0 0)
  103.      (lambda () (list (+ window-y window-height (wbw) (# 4 row))
  104.               (- screen-width window-x window-width (wbw))))
  105.      (lambda (x y) (rows.move (- screen-width y window-width (wbw)) x))
  106.      0
  107.      ()
  108.      screen-height
  109.      (lambda () (- screen-width window-x))
  110.      ()
  111.      'rows.right-top
  112.      )))
  113.  
  114. (defname 'rows.right-down screen.
  115.   '(list (Dlists.make right-down)
  116.      '(0 0)
  117.      (lambda () (list (+ screen-height (# 4 row) (- window-y))
  118.               (- screen-width window-x window-width (wbw))))
  119.      (lambda (x y) (rows.move (- screen-width y window-width (wbw))
  120.                 (- screen-height x window-height (wbw))))
  121.      0
  122.      ()
  123.      screen-height
  124.      (lambda () (- screen-width window-x))
  125.      ()
  126.      'rows.right-down
  127.      )))
  128.  
  129. (defname 'rows.down-right screen.
  130.   '(list (Dlists.make down-right)
  131.      '(0 0)
  132.      (lambda () (list (+ screen-width (# 4 row) (- window-x))
  133.               (- screen-height window-y window-height (wbw))))
  134.      (lambda (x y) (rows.move (- screen-width x window-width (wbw))
  135.                 (- screen-height y window-height (wbw))))
  136.      0
  137.      t
  138.      screen-width
  139.      (lambda () (- screen-height window-y))
  140.      ()
  141.      'rows.down-right
  142.      )))
  143.  
  144. (defname 'rows.down-left screen.
  145.   '(list (Dlists.make down-left)
  146.      '(0 0)
  147.      (lambda () (list (+ window-x window-width (wbw) (# 4 row))
  148.               (- screen-height window-y window-height (wbw))))
  149.      (lambda (x y) (rows.move x (- screen-height y window-height (wbw))))
  150.      0
  151.      t
  152.      screen-width
  153.      (lambda () (- screen-height window-y))
  154.      ()
  155.      'rows.down-left
  156.      )))
  157.  
  158. (defname 'rows.left-down screen.
  159.   '(list (Dlists.make left-down)
  160.      '(0 0)
  161.      (lambda () (list (+ screen-height (# 4 row) (- window-y)) window-x))
  162.      (lambda (x y) (rows.move y (- screen-height x window-height (wbw))))
  163.      0
  164.      ()
  165.      screen-height
  166.      (lambda () (+ window-x window-width (wbw)))
  167.      ()
  168.      'rows.left-down
  169.      )))
  170.  
  171. (defname 'rows.left-top screen.
  172.   '(list (Dlists.make left-top)
  173.      '(0 0)
  174.      (lambda () (list (+ window-y window-height (wbw) (# 4 row)) window-x))
  175.      (lambda (x y) (rows.move y x))
  176.      0
  177.      ()
  178.      screen-height
  179.      (lambda () (+ window-x window-width (wbw)))
  180.      ()
  181.      'rows.left-top
  182.      )))
  183.  
  184. (defun rows.top-left.placement (f) (rows.placement rows.top-left f))
  185. (defun rows.top-right.placement (f) (rows.placement rows.top-right f))
  186. (defun rows.right-top.placement (f) (rows.placement rows.right-top f))
  187. (defun rows.right-down.placement (f) (rows.placement rows.right-down f))
  188. (defun rows.down-right.placement (f) (rows.placement rows.down-right f))
  189. (defun rows.down-left.placement (f) (rows.placement rows.down-left f))
  190. (defun rows.left-down.placement (f) (rows.placement rows.left-down f))
  191. (defun rows.left-top.placement (f) (rows.placement rows.left-top f))
  192.  
  193. (defun rows.pack args
  194.   (if (not args)
  195.       (: args (list rows.top-left rows.top-right rows.right-top
  196.             rows.right-down rows.down-right rows.down-left
  197.             rows.left-down rows.left-top )))
  198.   (for row args
  199.        (rows.update row 0)))
  200.  
  201. (defun rows.placement (row flag)
  202.   (if flag      
  203.       (progn                ; open new
  204.     (Dlists.append (# 0 row) window)
  205.     (## 'update-placement
  206.         window
  207.         (list 'rows.update (# 9 row) 0))
  208.     (## 'row window row)
  209.     (rows.update row (- (length (eval (# 0 row))) 1)))
  210.     (with (index-win (Dlists.remove (# 0 row) window)) ; close win
  211.       (rows.update row index-win))))
  212.  
  213. ; place all windows in row from index i
  214.  
  215. (defun rows.update (row i)
  216.   (with (dlist (eval (# 0 row))
  217.            dummy (if (# 8 row)    ; sort list
  218.              (progn
  219.                (setq i 0)
  220.                (sort dlist (# 8 row))))
  221.            last+1 (length dlist)
  222.            coords (if (= i 0) (# 1 row)
  223.             (with (wob (# (- i 1) dlist))
  224.                   ((# 2 row))))
  225.            )
  226.     (while (< i last+1)
  227.       (with (wob (# i dlist))
  228.         (setq coords (rows.place row coords i)))
  229.       (: i (+ i 1))
  230.     )))))
  231.  
  232. ; place new (current) window at coords, moves it there and returns new coords
  233.  
  234. (defun rows.place (row coords i)
  235.   (with (new-coord (+ (# 0 coords) (# 4 row)
  236.               (if (# 5 row) window-width window-height))
  237.            )
  238.     (if (> new-coord (# 6 row))
  239.         (setq coords (rows.fold-row i)))
  240.     (eval (+ (list (# 3 row)) coords))
  241.     ((# 2 row))
  242.     )))))
  243.  
  244. (defun rows.move (x y)
  245.     (if (not (and (= x window-x) (= y window-y)))
  246.       (move-window x y))))))
  247.  
  248. (defunq wbw () (* 2 wob-borderwidth))))
  249.  
  250. ; update 
  251.  
  252. (defun rows.limits args
  253.   (with (row (# 0 args)
  254.          i 1)
  255.     (if (or (< (length args) 1)
  256.         (not (= (type row) 'list))
  257.         (not (= (length row) rows.length)))
  258.         (trigger-error "rows.limit: first arg must be a row, was " row))
  259.     (while (< i (length args))
  260.       (if (= 'separator (# i args))
  261.           (## 4 row (# (+ i 1) args))
  262.         (= 'start (# i args))
  263.         (## 0 (# 1 row) (# (+ i 1) args))
  264.         (= 'offset (# i args))
  265.         (## 1 (# 1 row) (# (+ i 1) args))
  266.         (= 'end (# i args))
  267.         (## 6 row (# (+ i 1) args))
  268.         (= 'sort (# i args))
  269.         (## 8 row (# (+ i 1) args))
  270.         (trigger-error "rows.limit: unknown key " (# i args)))
  271.       (: i (+ i 2))
  272.       )
  273. ))))
  274.                      
  275. ; starts a new row (modifies "coords")
  276.  
  277. (defun rows.fold-row (index)
  278.   (with (i 0
  279.        new-offset 0
  280.        tmp 0
  281.        window window)
  282.     (while (< i index)
  283.       (window (# i (# 0 row)))
  284.       (if (> (: tmp ((# 7 row))) new-offset)
  285.           (: new-offset tmp))
  286.       (: i (+ 1 i))
  287.       )
  288.     (list (# 0 (# 1 row)) (+ new-offset (# 4 row)))
  289. )))))
  290.  
  291. ; backwards compatibility
  292.  
  293. (: right-placement rows.right-top.placement)
  294.  
  295. ; evaluates the function needed to clean window
  296.  
  297. (defun update-placements ()
  298.   (eval (# 'update-placement window)))
  299.  
  300. ; an example of a sorting function:
  301. ; sort-icon will look in a icon-order list for a "weight" of a class
  302. ; Class will be sorted in ascending weight orders,
  303. ; and windows of same class will be sorted by name
  304.  
  305. (setq icon-order '(Xmh 10 XPostit 5 XRn 20 XClock 2 XBiff 1 XLoad 20))
  306. (setq icon-order-default 100)
  307.  
  308. (defun sort-icons (w1 w2)
  309.   (with (a1 (atom (progn (: window w1) window-client-class))
  310.         n1 window-name
  311.         a2 (atom (progn (: window w2) window-client-class))
  312.         n2 window-name
  313.         res (compare (or (# a1 icon-order) icon-order-default)
  314.              (or (# a2 icon-order) icon-order-default)))
  315.     (if (= 0 res)
  316.     (compare n1 n2)
  317.       res)))
  318.  
  319. ;;=============================================================================
  320. ;;                    a better icon sorter, weigths given by customize
  321. ;;=============================================================================
  322.  
  323. (setq pack-icons-default 100)
  324.  
  325. (defun pack-icons (w1 w2)
  326.   (with (wob w1 
  327.       weight1 () 
  328.       weight2 () 
  329.       n1 window-icon-name
  330.     )
  331.     (setq weight1 (# 'weight (std-resource-get 'PackIcons 'pack-icons)))
  332.     (if (not weight1) (setq weight1 pack-icons-default))
  333.     (setq wob w2)
  334.     (setq weight2 (# 'weight (std-resource-get 'PackIcons 'pack-icons)))
  335.     (if (not weight2) (setq weight2 pack-icons-default))
  336.     
  337.     (if (= weight1 weight2)
  338.       (compare n1 window-icon-name)
  339.       (compare weight1 weight2)
  340. )))
  341.  
  342. (customize pack-icons any any weight pack-icons-default)
  343.  
  344. (rows.limits rows.right-top 'sort pack-icons)
  345.  
  346. ;; my personal weights
  347.  
  348. ;; (customize pack-icons any Xmh weight 10)
  349. ;; (customize pack-icons any XPostit weight 5)
  350. ;; (customize pack-icons any XRn weight 20)
  351. ;; (customize pack-icons any XClock weight 2)
  352. ;; (customize pack-icons any Clock weight 2)
  353. ;; (customize pack-icons any XBiff weight 1)
  354. ;; (customize pack-icons any XLoad weight 20)
  355. ;; (customize pack-icons any XTerm weight 90)
  356. ;; (customize pack-icons any Emacs weight 30)
  357. ;; (customize pack-icons any XDvi weight 250)
  358. ;; (customize pack-icons any XCal weight 1000)
  359. ;; (customize pack-icons any Zircon weight 15)
  360. ;; (customize pack-icons any Tk.zircon weight 15)
  361.  
  362. ;;=============================================================================
  363. ;;                    other placements by Michael A. Patton <MAP@BBN.COM>
  364. ;;=============================================================================
  365.  
  366. ;;Sample "diagonal" definitions
  367.  
  368. ; Diagonal from upper left, overlapping
  369. (defname 'rows.diag-ul screen.
  370.   '(list (Dlists.make diag-ul)
  371.      '(0 0)
  372.      (lambda () (list (+ window-x (# 4 row))
  373.               (+ window-y (# 4 row))))
  374.      (lambda (x y) (rows.move x y))
  375.      10
  376.      t
  377.      screen-height
  378.      (lambda () (+ window-x window-width (wbw)))
  379.      ()
  380.      'rows.diag-ul
  381.      ))
  382. (defun rows.diag-ul.placement (f)
  383.   (rows.placement rows.diag-ul f)
  384.   )
  385.  
  386. ; Diagonal from upper right, overlapping
  387. (defname 'rows.diag-ur screen.
  388.   '(list (Dlists.make diag-ur)
  389.      '(0 0)
  390.      (lambda () (list (- (+ screen-width (# 4 row))
  391.                  window-x window-width (wbw))
  392.               (+ window-y (# 4 row))))
  393.      (lambda (x y) (rows.move (- screen-width x window-width (wbw))
  394.                 y))
  395.      10
  396.      t
  397.      9999999
  398.      (lambda () (+ window-x window-width (wbw)))
  399.      ()
  400.      'rows.diag-ur
  401.      ))
  402. (defun rows.diag-ur.placement (f)
  403.   (rows.placement rows.diag-ur f)
  404.   )
  405.