407 lines
11 KiB
Plaintext
407 lines
11 KiB
Plaintext
; PLACEMENTS
|
|
; ==========
|
|
|
|
;;File: placements.gwm -- functions to automatically place windows on screen
|
|
;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
|
|
;;Revision: 2.0 -- Nov 24 1989
|
|
;;State: Exp
|
|
;;GWM Version: 1.5
|
|
|
|
; asks the user to place window if geometry wasn't specified
|
|
|
|
(de user-positioning (flag)
|
|
(if flag
|
|
(if (not (or window-was-on-screen
|
|
window-starts-iconic
|
|
(and window-user-set-position
|
|
(= window-status 'window))
|
|
window-is-transient-for
|
|
))
|
|
(progn (: l (current-mouse-position))
|
|
(meter-open-in-place)
|
|
(meter-update (+ "Window: "
|
|
(window-client-class) "."
|
|
(window-client-name) "."
|
|
(window-name) "@"
|
|
(window-machine-name)))
|
|
(: x (# 0 l))
|
|
(: y (# 1 l))
|
|
(move-window x y)
|
|
(process-exposes)
|
|
(: new-window window)
|
|
(move-window)
|
|
(meter-close))
|
|
(if (< window-y 0)(move-window window-x 0))
|
|
))))))
|
|
|
|
(defun meter-open-in-place ()
|
|
(with (position (meter 'x 0 'y 0))
|
|
(meter-open (nth 1 position) (nth 3 position) " ")))
|
|
|
|
; placed lists package required
|
|
|
|
(if (not (boundp 'Dlists)) (load "dlists.gwm")))))
|
|
|
|
; rows package
|
|
; struct row:
|
|
; 0 dlist
|
|
; 1 start of list [coords]
|
|
; 2 func: coords from cur window [() -> coords]
|
|
; 3 func: move window at coords [(x y) ->()]
|
|
; 4 separator [int]
|
|
; 5 flag t if horiz
|
|
; 6 end of list [first coord]
|
|
; 7 func: "width" of current window
|
|
; 8 func: sorting function
|
|
; 9 atom: row name
|
|
|
|
(setq rows.length 10)
|
|
|
|
;
|
|
; all functions must have current row in var "row"
|
|
; rows:
|
|
|
|
(defname 'top-left screen.)
|
|
(defname 'top-right screen.)
|
|
(defname 'right-top screen.)
|
|
(defname 'right-down screen.)
|
|
(defname 'down-right screen.)
|
|
(defname 'down-left screen.)
|
|
(defname 'left-down screen.)
|
|
(defname 'left-top screen.)
|
|
|
|
(defname 'rows.top-left screen.
|
|
'(list (Dlists.make top-left)
|
|
'(0 0)
|
|
(lambda () (list (+ window-x window-width (wbw) (# 4 row))
|
|
window-y))
|
|
(lambda (x y) (rows.move x y))
|
|
0
|
|
t
|
|
screen-width
|
|
(lambda () (+ window-y window-height (wbw)))
|
|
()
|
|
'rows.top-left
|
|
)))
|
|
|
|
(defname 'rows.top-right screen.
|
|
'(list (Dlists.make top-right)
|
|
'(0 0)
|
|
(lambda () (list (+ screen-width (# 4 row) (- window-x)) window-y))
|
|
(lambda (x y) (rows.move (- screen-width x window-width (wbw)) y))
|
|
0
|
|
t
|
|
screen-width
|
|
(lambda () (+ window-y window-height (wbw)))
|
|
()
|
|
'rows.top-right
|
|
)))
|
|
|
|
(defname 'rows.right-top screen.
|
|
'(list (Dlists.make right-top)
|
|
'(0 0)
|
|
(lambda () (list (+ window-y window-height (wbw) (# 4 row))
|
|
(- screen-width window-x window-width (wbw))))
|
|
(lambda (x y) (rows.move (- screen-width y window-width (wbw)) x))
|
|
0
|
|
()
|
|
screen-height
|
|
(lambda () (- screen-width window-x))
|
|
()
|
|
'rows.right-top
|
|
)))
|
|
|
|
(defname 'rows.right-down screen.
|
|
'(list (Dlists.make right-down)
|
|
'(0 0)
|
|
(lambda () (list (+ screen-height (# 4 row) (- window-y))
|
|
(- screen-width window-x window-width (wbw))))
|
|
(lambda (x y) (rows.move (- screen-width y window-width (wbw))
|
|
(- screen-height x window-height (wbw))))
|
|
0
|
|
()
|
|
screen-height
|
|
(lambda () (- screen-width window-x))
|
|
()
|
|
'rows.right-down
|
|
)))
|
|
|
|
(defname 'rows.down-right screen.
|
|
'(list (Dlists.make down-right)
|
|
'(0 0)
|
|
(lambda () (list (+ screen-width (# 4 row) (- window-x))
|
|
(- screen-height window-y window-height (wbw))))
|
|
(lambda (x y) (rows.move (- screen-width x window-width (wbw))
|
|
(- screen-height y window-height (wbw))))
|
|
0
|
|
t
|
|
screen-width
|
|
(lambda () (- screen-height window-y))
|
|
()
|
|
'rows.down-right
|
|
)))
|
|
|
|
(defname 'rows.down-left screen.
|
|
'(list (Dlists.make down-left)
|
|
'(0 0)
|
|
(lambda () (list (+ window-x window-width (wbw) (# 4 row))
|
|
(- screen-height window-y window-height (wbw))))
|
|
(lambda (x y) (rows.move x (- screen-height y window-height (wbw))))
|
|
0
|
|
t
|
|
screen-width
|
|
(lambda () (- screen-height window-y))
|
|
()
|
|
'rows.down-left
|
|
)))
|
|
|
|
(defname 'rows.left-down screen.
|
|
'(list (Dlists.make left-down)
|
|
'(0 0)
|
|
(lambda () (list (+ screen-height (# 4 row) (- window-y)) window-x))
|
|
(lambda (x y) (rows.move y (- screen-height x window-height (wbw))))
|
|
0
|
|
()
|
|
screen-height
|
|
(lambda () (+ window-x window-width (wbw)))
|
|
()
|
|
'rows.left-down
|
|
)))
|
|
|
|
(defname 'rows.left-top screen.
|
|
'(list (Dlists.make left-top)
|
|
'(0 0)
|
|
(lambda () (list (+ window-y window-height (wbw) (# 4 row)) window-x))
|
|
(lambda (x y) (rows.move y x))
|
|
0
|
|
()
|
|
screen-height
|
|
(lambda () (+ window-x window-width (wbw)))
|
|
()
|
|
'rows.left-top
|
|
)))
|
|
|
|
(defun rows.top-left.placement (f) (rows.placement rows.top-left f))
|
|
(defun rows.top-right.placement (f) (rows.placement rows.top-right f))
|
|
(defun rows.right-top.placement (f) (rows.placement rows.right-top f))
|
|
(defun rows.right-down.placement (f) (rows.placement rows.right-down f))
|
|
(defun rows.down-right.placement (f) (rows.placement rows.down-right f))
|
|
(defun rows.down-left.placement (f) (rows.placement rows.down-left f))
|
|
(defun rows.left-down.placement (f) (rows.placement rows.left-down f))
|
|
(defun rows.left-top.placement (f) (rows.placement rows.left-top f))
|
|
|
|
(defun rows.pack args
|
|
(if (not args)
|
|
(: args (list rows.top-left rows.top-right rows.right-top
|
|
rows.right-down rows.down-right rows.down-left
|
|
rows.left-down rows.left-top )))
|
|
(for row args
|
|
(rows.update row 0)))
|
|
|
|
(defun rows.placement (row flag)
|
|
(if flag
|
|
(progn ; open new
|
|
(Dlists.append (# 0 row) window)
|
|
(## 'update-placement
|
|
window
|
|
(list 'rows.update (# 9 row) 0))
|
|
(## 'row window row)
|
|
(rows.update row (- (length (eval (# 0 row))) 1)))
|
|
(with (index-win (Dlists.remove (# 0 row) window)) ; close win
|
|
(rows.update row index-win))))
|
|
|
|
; place all windows in row from index i
|
|
|
|
(defun rows.update (row i)
|
|
(with (dlist (eval (# 0 row))
|
|
dummy (if (# 8 row) ; sort list
|
|
(progn
|
|
(setq i 0)
|
|
(sort dlist (# 8 row))))
|
|
last+1 (length dlist)
|
|
coords (if (= i 0) (# 1 row)
|
|
(with (wob (# (- i 1) dlist))
|
|
((# 2 row))))
|
|
)
|
|
(while (< i last+1)
|
|
(with (wob (# i dlist))
|
|
(setq coords (rows.place row coords i)))
|
|
(: i (+ i 1))
|
|
)))))
|
|
|
|
; place new (current) window at coords, moves it there and returns new coords
|
|
|
|
(defun rows.place (row coords i)
|
|
(with (new-coord (+ (# 0 coords) (# 4 row)
|
|
(if (# 5 row) window-width window-height))
|
|
)
|
|
(if (> new-coord (# 6 row))
|
|
(setq coords (rows.fold-row i)))
|
|
(eval (+ (list (# 3 row)) coords))
|
|
((# 2 row))
|
|
)))))
|
|
|
|
(defun rows.move (x y)
|
|
(if (not (and (= x window-x) (= y window-y)))
|
|
(move-window x y))))))
|
|
|
|
(defunq wbw () (* 2 wob-borderwidth))))
|
|
|
|
; update
|
|
|
|
(defun rows.limits args
|
|
(with (row (# 0 args)
|
|
i 1)
|
|
(if (or (< (length args) 1)
|
|
(not (= (type row) 'list))
|
|
(not (= (length row) rows.length)))
|
|
(trigger-error "rows.limit: first arg must be a row, was " row))
|
|
(while (< i (length args))
|
|
(if (= 'separator (# i args))
|
|
(## 4 row (# (+ i 1) args))
|
|
(= 'start (# i args))
|
|
(## 0 (# 1 row) (# (+ i 1) args))
|
|
(= 'offset (# i args))
|
|
(## 1 (# 1 row) (# (+ i 1) args))
|
|
(= 'end (# i args))
|
|
(## 6 row (# (+ i 1) args))
|
|
(= 'sort (# i args))
|
|
(## 8 row (# (+ i 1) args))
|
|
(trigger-error "rows.limit: unknown key " (# i args)))
|
|
(: i (+ i 2))
|
|
)
|
|
))))
|
|
|
|
; starts a new row (modifies "coords")
|
|
|
|
(defun rows.fold-row (index)
|
|
(with (i 0
|
|
new-offset 0
|
|
tmp 0
|
|
window window)
|
|
(while (< i index)
|
|
(window (# i (# 0 row)))
|
|
(if (> (: tmp ((# 7 row))) new-offset)
|
|
(: new-offset tmp))
|
|
(: i (+ 1 i))
|
|
)
|
|
(list (# 0 (# 1 row)) (+ new-offset (# 4 row)))
|
|
)))))
|
|
|
|
; backwards compatibility
|
|
|
|
(: right-placement rows.right-top.placement)
|
|
|
|
; evaluates the function needed to clean window
|
|
|
|
(defun update-placements ()
|
|
(eval (# 'update-placement window)))
|
|
|
|
; an example of a sorting function:
|
|
; sort-icon will look in a icon-order list for a "weight" of a class
|
|
; Class will be sorted in ascending weight orders,
|
|
; and windows of same class will be sorted by name
|
|
|
|
(setq icon-order '(Xmh 10 XPostit 5 XRn 20 XClock 2 XBiff 1 XLoad 20))
|
|
(setq icon-order-default 100)
|
|
|
|
(defun sort-icons (w1 w2)
|
|
(with (a1 (atom (progn (: window w1) window-client-class))
|
|
n1 window-name
|
|
a2 (atom (progn (: window w2) window-client-class))
|
|
n2 window-name
|
|
res (compare (or (# a1 icon-order) icon-order-default)
|
|
(or (# a2 icon-order) icon-order-default)))
|
|
(if (= 0 res)
|
|
(compare n1 n2)
|
|
res)))
|
|
|
|
;;=============================================================================
|
|
;; a better icon sorter, weigths given by customize
|
|
;;=============================================================================
|
|
|
|
(setq pack-icons-default 100)
|
|
|
|
(defun pack-icons (w1 w2)
|
|
(with (wob w1
|
|
weight1 ()
|
|
weight2 ()
|
|
n1 window-icon-name
|
|
)
|
|
(setq weight1 (# 'weight (std-resource-get 'PackIcons 'pack-icons)))
|
|
(if (not weight1) (setq weight1 pack-icons-default))
|
|
(setq wob w2)
|
|
(setq weight2 (# 'weight (std-resource-get 'PackIcons 'pack-icons)))
|
|
(if (not weight2) (setq weight2 pack-icons-default))
|
|
|
|
(if (= weight1 weight2)
|
|
(compare n1 window-icon-name)
|
|
(compare weight1 weight2)
|
|
)))
|
|
|
|
(if (boundp 'customize) ;otherwise we dont know how to do it
|
|
(customize pack-icons any any weight pack-icons-default)
|
|
)
|
|
|
|
(rows.limits rows.right-top 'sort pack-icons)
|
|
|
|
;; my personal weights
|
|
|
|
;; (customize pack-icons any Xmh weight 10)
|
|
;; (customize pack-icons any XPostit weight 5)
|
|
;; (customize pack-icons any XRn weight 20)
|
|
;; (customize pack-icons any XClock weight 2)
|
|
;; (customize pack-icons any Clock weight 2)
|
|
;; (customize pack-icons any XBiff weight 1)
|
|
;; (customize pack-icons any XLoad weight 20)
|
|
;; (customize pack-icons any XTerm weight 90)
|
|
;; (customize pack-icons any Emacs weight 30)
|
|
;; (customize pack-icons any XDvi weight 250)
|
|
;; (customize pack-icons any XCal weight 1000)
|
|
;; (customize pack-icons any Zircon weight 15)
|
|
;; (customize pack-icons any Tk.zircon weight 15)
|
|
|
|
;;=============================================================================
|
|
;; other placements by Michael A. Patton <MAP@BBN.COM>
|
|
;;=============================================================================
|
|
|
|
;;Sample "diagonal" definitions
|
|
|
|
; Diagonal from upper left, overlapping
|
|
(defname 'rows.diag-ul screen.
|
|
'(list (Dlists.make diag-ul)
|
|
'(0 0)
|
|
(lambda () (list (+ window-x (# 4 row))
|
|
(+ window-y (# 4 row))))
|
|
(lambda (x y) (rows.move x y))
|
|
10
|
|
t
|
|
screen-height
|
|
(lambda () (+ window-x window-width (wbw)))
|
|
()
|
|
'rows.diag-ul
|
|
))
|
|
(defun rows.diag-ul.placement (f)
|
|
(rows.placement rows.diag-ul f)
|
|
)
|
|
|
|
; Diagonal from upper right, overlapping
|
|
(defname 'rows.diag-ur screen.
|
|
'(list (Dlists.make diag-ur)
|
|
'(0 0)
|
|
(lambda () (list (- (+ screen-width (# 4 row))
|
|
window-x window-width (wbw))
|
|
(+ window-y (# 4 row))))
|
|
(lambda (x y) (rows.move (- screen-width x window-width (wbw))
|
|
y))
|
|
10
|
|
t
|
|
9999999
|
|
(lambda () (+ window-x window-width (wbw)))
|
|
()
|
|
'rows.diag-ur
|
|
))
|
|
(defun rows.diag-ur.placement (f)
|
|
(rows.placement rows.diag-ur f)
|
|
)
|