|
0
|
1 ;;; Tools to configure your GNU Emacs windows
|
|
|
2 ;;; Copyright (C) 1991, 1993, 1994, 1995 Kyle E. Jones
|
|
|
3 ;;;
|
|
|
4 ;;; This program is free software; you can redistribute it and/or modify
|
|
|
5 ;;; it under the terms of the GNU General Public License as published by
|
|
|
6 ;;; the Free Software Foundation; either version 1, or (at your option)
|
|
|
7 ;;; any later version.
|
|
|
8 ;;;
|
|
|
9 ;;; This program is distributed in the hope that it will be useful,
|
|
|
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
12 ;;; GNU General Public License for more details.
|
|
|
13 ;;;
|
|
|
14 ;;; A copy of the GNU General Public License can be obtained from this
|
|
|
15 ;;; program's author (send electronic mail to kyle@uunet.uu.net) or from
|
|
|
16 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
|
|
|
17 ;;; 02139, USA.
|
|
|
18 ;;;
|
|
|
19 ;;; Send bug reports to kyle@uunet.uu.net.
|
|
|
20
|
|
|
21 (provide 'tapestry)
|
|
|
22
|
|
|
23 (defvar tapestry-version "1.07")
|
|
|
24
|
|
|
25 (defun tapestry (&optional frame-list)
|
|
|
26 "Returns a list containing complete information about the current
|
|
|
27 configuration of Emacs frames, windows, buffers and cursor
|
|
|
28 positions. Call the function set-tapestry with the list that this function
|
|
|
29 returns to restore the configuration.
|
|
|
30
|
|
|
31 Optional first arg FRAME-LIST should be a list of frames; only
|
|
|
32 configuration information about these frames will be returned.
|
|
|
33
|
|
|
34 The configuration information is returned in a form that can be saved and
|
|
|
35 restored across multiple Emacs sessions."
|
|
|
36 (let ((frames (or frame-list (tapestry-frame-list)))
|
|
|
37 (frame-map (tapestry-frame-map))
|
|
|
38 (sf (tapestry-selected-frame))
|
|
|
39 (other-maps nil))
|
|
|
40 (unwind-protect
|
|
|
41 (while frames
|
|
|
42 (tapestry-select-frame (car frames))
|
|
|
43 (setq other-maps (cons (list (tapestry-window-map)
|
|
|
44 (tapestry-buffer-map)
|
|
|
45 (tapestry-position-map))
|
|
|
46 other-maps)
|
|
|
47 frames (cdr frames)))
|
|
|
48 (tapestry-select-frame sf))
|
|
|
49 (list frame-map other-maps)))
|
|
|
50
|
|
|
51 (defun set-tapestry (map &optional n root-window-edges)
|
|
|
52 "Restore the frame/window/buffer configuration described by MAP,
|
|
|
53 which should be a list previously returned by a call to
|
|
|
54 tapestry.
|
|
|
55
|
|
|
56 Optional second arg N causes frame reconfiguration to be skipped
|
|
|
57 and the windows of the current frame will configured according to
|
|
|
58 the window map of the Nth frame in MAP.
|
|
|
59
|
|
|
60 Optional third arg ROOT-WINDOW-EDGES non-nil should be a list
|
|
|
61 containing the edges of a window in the current frame. This list
|
|
|
62 should be in the same form as returned by the `window-edges'
|
|
|
63 function. The window configuration from MAP will be restored in
|
|
|
64 this window. If no window with these exact edges exists, a
|
|
|
65 window that lies entirely within the edge coordinates will be
|
|
|
66 expanded until the edge coordinates match or the window bounded by
|
|
|
67 ROOT-WINDOW-EDGES is entirely contained within the expanded
|
|
|
68 window. If no window entirely within the ROOT-WINDOW-EDGES edge
|
|
|
69 coordinates can be found, the window with the greatest overlap of
|
|
|
70 ROOT-WINDOW-EDGES will be used."
|
|
|
71 (let ((sf (tapestry-selected-frame))
|
|
|
72 frame-list frame-map other-maps other-map)
|
|
|
73 (setq frame-map (nth 0 map)
|
|
|
74 other-maps (nth 1 map))
|
|
|
75 (if (and root-window-edges (null n))
|
|
|
76 (setq n 1))
|
|
|
77 (if n
|
|
|
78 (let (first-window)
|
|
|
79 (setq other-map (nth (1- n) other-maps))
|
|
|
80 (if (null other-map)
|
|
|
81 (error "No such map, %d" n))
|
|
|
82 (setq first-window
|
|
|
83 (tapestry-set-window-map (nth 0 other-map) root-window-edges))
|
|
|
84 (tapestry-set-buffer-map (nth 1 other-map) first-window)
|
|
|
85 (tapestry-set-position-map (nth 2 other-map) first-window))
|
|
|
86 (tapestry-set-frame-map frame-map)
|
|
|
87 ;; frame list is reversed relative to the map order because
|
|
|
88 ;; created frames are added to the head of the list instead
|
|
|
89 ;; of the tail.
|
|
|
90 (setq frame-list (nreverse (tapestry-frame-list)))
|
|
|
91 (unwind-protect
|
|
|
92 (while other-maps
|
|
|
93 (tapestry-select-frame (car frame-list))
|
|
|
94 (tapestry-set-window-map (nth 0 (car other-maps)))
|
|
|
95 (tapestry-set-buffer-map (nth 1 (car other-maps)))
|
|
|
96 (tapestry-set-position-map (nth 2 (car other-maps)))
|
|
|
97 (setq other-maps (cdr other-maps)
|
|
|
98 frame-list (cdr frame-list)))
|
|
|
99 (and (tapestry-frame-live-p sf) (tapestry-select-frame sf))))))
|
|
|
100
|
|
|
101 (defun tapestry-frame-map ()
|
|
|
102 (let ((map (mapcar 'tapestry-frame-parameters (tapestry-frame-list)))
|
|
|
103 list cell frame-list)
|
|
|
104 (setq list map
|
|
|
105 frame-list (tapestry-frame-list))
|
|
|
106 (while list
|
|
|
107 (setq cell (assq 'minibuffer (car list)))
|
|
|
108 (if (and cell (windowp (cdr cell)))
|
|
|
109 (if (eq (tapestry-window-frame (cdr cell)) (car frame-list))
|
|
|
110 (setcdr cell t)
|
|
|
111 (setcdr cell 'none)))
|
|
|
112 (setq list (cdr list)
|
|
|
113 frame-list (cdr frame-list)))
|
|
|
114 map ))
|
|
|
115
|
|
|
116 (defun tapestry-set-frame-map (map)
|
|
|
117 ;; some parameters can only be set only at frame creation time.
|
|
|
118 ;; so all existing frames must die.
|
|
|
119 (let ((doomed-frames (tapestry-frame-list)))
|
|
|
120 (while map
|
|
|
121 (tapestry-make-frame (car map))
|
|
|
122 (setq map (cdr map)))
|
|
|
123 (while doomed-frames
|
|
|
124 (tapestry-delete-frame (car doomed-frames))
|
|
|
125 (setq doomed-frames (cdr doomed-frames)))))
|
|
|
126
|
|
|
127 (defun tapestry-window-map ()
|
|
|
128 (let (maps map0 map1 map0-edges map1-edges x-unchanged y-unchanged)
|
|
|
129 (setq maps (mapcar 'tapestry-window-edges (tapestry-window-list)))
|
|
|
130 (while (cdr maps)
|
|
|
131 (setq map0 maps)
|
|
|
132 (while (cdr map0)
|
|
|
133 (setq map1 (cdr map0)
|
|
|
134 map0-edges (tapestry-find-window-map-edges (car map0))
|
|
|
135 map1-edges (tapestry-find-window-map-edges (car map1))
|
|
|
136 x-unchanged (and (= (car map0-edges) (car map1-edges))
|
|
|
137 (= (nth 2 map0-edges) (nth 2 map1-edges)))
|
|
|
138 y-unchanged (and (= (nth 1 map0-edges) (nth 1 map1-edges))
|
|
|
139 (= (nth 3 map0-edges) (nth 3 map1-edges))))
|
|
|
140 (cond ((and (not x-unchanged) (not y-unchanged))
|
|
|
141 (setq map0 (cdr map0)))
|
|
|
142 ((or (and x-unchanged (eq (car (car map0)) '-))
|
|
|
143 (and y-unchanged (eq (car (car map0)) '|)))
|
|
|
144 (nconc (car map0) (list (car map1)))
|
|
|
145 (setcdr map0 (cdr map1)))
|
|
|
146 (t
|
|
|
147 (setcar map0 (list (if x-unchanged '- '|)
|
|
|
148 (car map0)
|
|
|
149 (car map1)))
|
|
|
150 (setcdr map0 (cdr map1))))))
|
|
|
151 (car maps)))
|
|
|
152
|
|
|
153 (defun tapestry-set-window-map (map &optional root-window-edges)
|
|
|
154 (let ((map-width (tapestry-compute-map-width map))
|
|
|
155 (map-height (tapestry-compute-map-height map))
|
|
|
156 (root-window nil))
|
|
|
157 (if root-window-edges
|
|
|
158 (let (w-list w-edges w-area
|
|
|
159 exact-w inside-w overlap-w max-overlap overlap)
|
|
|
160 (while (null root-window)
|
|
|
161 (setq exact-w nil
|
|
|
162 inside-w nil
|
|
|
163 overlap-w nil
|
|
|
164 max-overlap -1
|
|
|
165 w-list (tapestry-window-list))
|
|
|
166 (while w-list
|
|
|
167 (setq w-edges (tapestry-window-edges (car w-list))
|
|
|
168 w-area (tapestry-window-area w-edges))
|
|
|
169 (if (equal w-edges root-window-edges)
|
|
|
170 (setq exact-w (car w-list)
|
|
|
171 w-list nil)
|
|
|
172 (setq overlap (tapestry-window-overlap w-edges
|
|
|
173 root-window-edges)
|
|
|
174 overlap (if overlap (tapestry-window-area overlap) 0)
|
|
|
175 w-area (tapestry-window-area w-edges))
|
|
|
176 (if (< max-overlap overlap)
|
|
|
177 (setq max-overlap overlap
|
|
|
178 overlap-w (car w-list)))
|
|
|
179 ;; set inside-w each time we find a window inside
|
|
|
180 ;; the root window edges. FSF Emacs gives space
|
|
|
181 ;; to the window above or to the left if there is
|
|
|
182 ;; such a window. therefore we want to find the
|
|
|
183 ;; inside window that is bottom-most or right-most so that
|
|
|
184 ;; when we delete it, its space will be given to
|
|
|
185 ;; what will be the root window.
|
|
|
186 (if (= w-area overlap)
|
|
|
187 (setq inside-w (car w-list)))
|
|
|
188 (setq w-list (cdr w-list))))
|
|
|
189 (cond (exact-w (setq root-window exact-w))
|
|
|
190 (inside-w
|
|
|
191 ;; how could a window be inside the root window
|
|
|
192 ;; edges and there only be one window? a
|
|
|
193 ;; multi-line minibuffer, that's how!
|
|
|
194 (if (not (one-window-p t))
|
|
|
195 (delete-window inside-w)))
|
|
|
196 (t (setq root-window overlap-w))))
|
|
|
197 (tapestry-apply-window-map map map-width map-height root-window)
|
|
|
198 root-window )
|
|
|
199 (if (tapestry-windows-match-map map map-width map-height)
|
|
|
200 (tapestry-first-window)
|
|
|
201 (delete-other-windows)
|
|
|
202 (setq root-window (selected-window))
|
|
|
203 (tapestry-apply-window-map map map-width map-height root-window)
|
|
|
204 root-window ))))
|
|
|
205
|
|
|
206 (defun tapestry-buffer-map ()
|
|
|
207 (let ((w-list (tapestry-window-list))
|
|
|
208 b list)
|
|
|
209 (while w-list
|
|
|
210 (setq b (window-buffer (car w-list))
|
|
|
211 list (cons (list (buffer-file-name b)
|
|
|
212 (buffer-name b))
|
|
|
213 list)
|
|
|
214 w-list (cdr w-list)))
|
|
|
215 (nreverse list)))
|
|
|
216
|
|
|
217 (defun tapestry-set-buffer-map (buffer-map &optional first-window)
|
|
|
218 (let ((w-list (tapestry-window-list first-window)) wb)
|
|
|
219 (while (and w-list buffer-map)
|
|
|
220 (setq wb (car buffer-map))
|
|
|
221 (set-window-buffer
|
|
|
222 (car w-list)
|
|
|
223 (if (car wb)
|
|
|
224 (or (get-file-buffer (car wb))
|
|
|
225 (find-file-noselect (car wb)))
|
|
|
226 (get-buffer-create (nth 1 wb))))
|
|
|
227 (setq w-list (cdr w-list)
|
|
|
228 buffer-map (cdr buffer-map)))))
|
|
|
229
|
|
|
230 (defun tapestry-position-map ()
|
|
|
231 (let ((sw (selected-window))
|
|
|
232 (w-list (tapestry-window-list))
|
|
|
233 list)
|
|
|
234 (while w-list
|
|
|
235 (setq list (cons (list (window-start (car w-list))
|
|
|
236 (window-point (car w-list))
|
|
|
237 (window-hscroll (car w-list))
|
|
|
238 (eq (car w-list) sw))
|
|
|
239 list)
|
|
|
240 w-list (cdr w-list)))
|
|
|
241 (nreverse list)))
|
|
|
242
|
|
|
243 (defun tapestry-set-position-map (position-map &optional first-window)
|
|
|
244 (let ((w-list (tapestry-window-list first-window))
|
|
|
245 (osw (selected-window))
|
|
|
246 sw p)
|
|
|
247 (while (and w-list position-map)
|
|
|
248 (setq p (car position-map))
|
|
|
249 (and (car p) (set-window-start (car w-list) (car p)))
|
|
|
250 (and (nth 1 p) (set-window-point (car w-list) (nth 1 p)))
|
|
|
251 (and (nth 2 p) (set-window-hscroll (car w-list) (nth 2 p)))
|
|
|
252 (and (nth 3 p) (setq sw (car w-list)))
|
|
|
253 ;; move this buffer up in the buffer-list
|
|
|
254 (select-window (car w-list))
|
|
|
255 (setq w-list (cdr w-list)
|
|
|
256 position-map (cdr position-map)))
|
|
|
257 (select-window (or sw osw))))
|
|
|
258
|
|
|
259 (defun tapestry-apply-window-map (map map-width map-height current-window
|
|
|
260 &optional
|
|
|
261 root-window-width
|
|
|
262 root-window-height)
|
|
|
263 (let ((window-min-height 1)
|
|
|
264 (window-min-width 1)
|
|
|
265 horizontal)
|
|
|
266 (if (null root-window-width)
|
|
|
267 (setq root-window-height (window-height current-window)
|
|
|
268 root-window-width (window-width current-window)))
|
|
|
269 (while map
|
|
|
270 (cond
|
|
|
271 ((numberp (car map)) (setq map nil))
|
|
|
272 ((eq (car map) '-) (setq horizontal nil))
|
|
|
273 ((eq (car map) '|) (setq horizontal t))
|
|
|
274 (t
|
|
|
275 (if (cdr map)
|
|
|
276 (split-window
|
|
|
277 current-window
|
|
|
278 (if horizontal
|
|
|
279 (/ (* (tapestry-compute-map-width (car map))
|
|
|
280 root-window-width)
|
|
|
281 map-width)
|
|
|
282 (/ (* (tapestry-compute-map-height (car map))
|
|
|
283 root-window-height)
|
|
|
284 map-height))
|
|
|
285 horizontal))
|
|
|
286 (if (not (numberp (car (car map))))
|
|
|
287 (setq current-window
|
|
|
288 (tapestry-apply-window-map (car map)
|
|
|
289 map-width map-height
|
|
|
290 current-window
|
|
|
291 root-window-width
|
|
|
292 root-window-height)))
|
|
|
293 (and (cdr map) (setq current-window (next-window current-window 0)))))
|
|
|
294 (setq map (cdr map)))
|
|
|
295 current-window ))
|
|
|
296
|
|
|
297 (defun tapestry-windows-match-map (map
|
|
|
298 &optional
|
|
|
299 map-width map-height
|
|
|
300 window-map
|
|
|
301 window-map-width
|
|
|
302 window-map-height)
|
|
|
303 (or map-width
|
|
|
304 (setq map-width (tapestry-compute-map-width map)
|
|
|
305 map-height (tapestry-compute-map-height map)))
|
|
|
306 (or window-map
|
|
|
307 (setq window-map (tapestry-window-map)
|
|
|
308 window-map-height (tapestry-compute-map-height window-map)
|
|
|
309 window-map-width (tapestry-compute-map-width window-map)))
|
|
|
310 (let ((result t))
|
|
|
311 (cond ((numberp (car map))
|
|
|
312 (and (numberp (car window-map))
|
|
|
313 (= (/ (* (nth 0 map) window-map-width)
|
|
|
314 map-width)
|
|
|
315 (nth 0 window-map))
|
|
|
316 (= (/ (* (nth 1 map) window-map-height)
|
|
|
317 map-height)
|
|
|
318 (nth 1 window-map))
|
|
|
319 (= (/ (* (nth 2 map) window-map-width)
|
|
|
320 map-width)
|
|
|
321 (nth 2 window-map))
|
|
|
322 (= (/ (* (nth 3 map) window-map-height)
|
|
|
323 map-height)
|
|
|
324 (nth 3 window-map))))
|
|
|
325 ((eq (car map) '-)
|
|
|
326 (if (not (eq (car window-map) '-))
|
|
|
327 nil
|
|
|
328 (setq map (cdr map)
|
|
|
329 window-map (cdr window-map))
|
|
|
330 (while (and result map window-map)
|
|
|
331 (setq result (tapestry-windows-match-map (car map)
|
|
|
332 map-width
|
|
|
333 map-height
|
|
|
334 (car window-map)
|
|
|
335 window-map-width
|
|
|
336 window-map-height)
|
|
|
337 map (cdr map)
|
|
|
338 window-map (cdr window-map)))
|
|
|
339 (and result (null map) (null window-map))))
|
|
|
340 ((eq (car map) '|)
|
|
|
341 (if (not (eq (car window-map) '|))
|
|
|
342 nil
|
|
|
343 (setq map (cdr map)
|
|
|
344 window-map (cdr window-map))
|
|
|
345 (while (and result map window-map)
|
|
|
346 (setq result (tapestry-windows-match-map (car map)
|
|
|
347 map-width
|
|
|
348 map-height
|
|
|
349 (car window-map)
|
|
|
350 window-map-width
|
|
|
351 window-map-height)
|
|
|
352 map (cdr map)
|
|
|
353 window-map (cdr window-map)))
|
|
|
354 (and result (null map) (null window-map)))))))
|
|
|
355
|
|
|
356 (defun tapestry-find-window-map-edges (map)
|
|
|
357 (let (nw-edges se-edges)
|
|
|
358 (setq nw-edges map)
|
|
|
359 (while (and (consp nw-edges) (not (numberp (car nw-edges))))
|
|
|
360 (setq nw-edges (car (cdr nw-edges))))
|
|
|
361 (setq se-edges map)
|
|
|
362 (while (and (consp se-edges) (not (numberp (car se-edges))))
|
|
|
363 (while (cdr se-edges)
|
|
|
364 (setq se-edges (cdr se-edges)))
|
|
|
365 (setq se-edges (car se-edges)))
|
|
|
366 (if (eq nw-edges se-edges)
|
|
|
367 nw-edges
|
|
|
368 (setq nw-edges (copy-sequence nw-edges))
|
|
|
369 (setcdr (nthcdr 1 nw-edges) (nthcdr 2 se-edges))
|
|
|
370 nw-edges )))
|
|
|
371
|
|
|
372 (defun tapestry-compute-map-width (map)
|
|
|
373 (let ((edges (tapestry-find-window-map-edges map)))
|
|
|
374 (- (nth 2 edges) (car edges))))
|
|
|
375
|
|
|
376 (defun tapestry-compute-map-height (map)
|
|
|
377 (let ((edges (tapestry-find-window-map-edges map)))
|
|
|
378 (- (nth 3 edges) (nth 1 edges))))
|
|
|
379
|
|
|
380 ;; delq is to memq as delassq is to assq
|
|
|
381 (defun tapestry-delassq (elt list)
|
|
|
382 (let ((prev nil)
|
|
|
383 (curr list))
|
|
|
384 (while curr
|
|
|
385 (if (eq elt (car (car curr)))
|
|
|
386 (if (null prev)
|
|
|
387 (setq list (cdr list) curr list)
|
|
|
388 (setcdr prev (cdr curr))
|
|
|
389 (setq curr (cdr curr)))
|
|
|
390 (setq prev curr curr (cdr curr))))
|
|
|
391 list ))
|
|
|
392
|
|
|
393 (defun tapestry-remove-frame-parameters (map params)
|
|
|
394 (let (frame-map)
|
|
|
395 (while params
|
|
|
396 (setq frame-map (nth 0 map))
|
|
|
397 (while frame-map
|
|
|
398 (setcar frame-map (tapestry-delassq (car params) (car frame-map)))
|
|
|
399 (setq frame-map (cdr frame-map)))
|
|
|
400 (setq params (cdr params)))))
|
|
|
401
|
|
|
402 (defun tapestry-nullify-tapestry-elements (map &optional buf-file-name buf-name
|
|
|
403 window-start window-point
|
|
|
404 window-hscroll selected-window)
|
|
|
405 (let (p)
|
|
|
406 (setq map (nth 1 map))
|
|
|
407 (while map
|
|
|
408 (setq p (nth 1 (car map)))
|
|
|
409 (while p
|
|
|
410 (and buf-file-name (setcar (car p) nil))
|
|
|
411 (and buf-name (setcar (cdr (car p)) nil))
|
|
|
412 (setq p (cdr p)))
|
|
|
413 (setq p (nth 2 (car map)))
|
|
|
414 (while p
|
|
|
415 (and window-start (setcar (car p) nil))
|
|
|
416 (and window-point (setcar (cdr (car p)) nil))
|
|
|
417 (and window-hscroll (setcar (nthcdr 2 (car p)) nil))
|
|
|
418 (and selected-window (setcar (nthcdr 3 (car p)) nil))
|
|
|
419 (setq p (cdr p)))
|
|
|
420 (setq map (cdr map)))))
|
|
|
421
|
|
|
422 (defun tapestry-replace-tapestry-element (map what function)
|
|
|
423 (let (mapi mapj p old new)
|
|
|
424 (cond ((eq what 'buffer-file-name)
|
|
|
425 (setq mapi 1 mapj 0))
|
|
|
426 ((eq what 'buffer-name)
|
|
|
427 (setq mapi 1 mapj 1))
|
|
|
428 ((eq what 'window-start)
|
|
|
429 (setq mapi 2 mapj 0))
|
|
|
430 ((eq what 'window-point)
|
|
|
431 (setq mapi 2 mapj 1))
|
|
|
432 ((eq what 'window-hscroll)
|
|
|
433 (setq mapi 2 mapj 2))
|
|
|
434 ((eq what 'selected-window)
|
|
|
435 (setq mapi 2 mapj 3)))
|
|
|
436 (setq map (nth 1 map))
|
|
|
437 (while map
|
|
|
438 (setq p (nth mapi (car map)))
|
|
|
439 (while p
|
|
|
440 (setq old (nth mapj (car p))
|
|
|
441 new (funcall function old))
|
|
|
442 (if (not (equal old new))
|
|
|
443 (setcar (nthcdr mapj (car p)) new))
|
|
|
444 (setq p (cdr p)))
|
|
|
445 (setq map (cdr map)))))
|
|
|
446
|
|
|
447 (defun tapestry-window-list (&optional first-window)
|
|
|
448 (let* ((first-window (or first-window (tapestry-first-window)))
|
|
|
449 (windows (cons first-window nil))
|
|
|
450 (current-cons windows)
|
|
|
451 (w (next-window first-window 'nomini)))
|
|
|
452 (while (not (eq w first-window))
|
|
|
453 (setq current-cons (setcdr current-cons (cons w nil)))
|
|
|
454 (setq w (next-window w 'nomini)))
|
|
|
455 windows ))
|
|
|
456
|
|
|
457 (defun tapestry-first-window ()
|
|
|
458 (if (eq (tapestry-selected-frame)
|
|
|
459 (tapestry-window-frame (minibuffer-window)))
|
|
|
460 (next-window (minibuffer-window))
|
|
|
461 (let ((w (selected-window))
|
|
|
462 (top (or (cdr (assq 'menu-bar-lines (tapestry-frame-parameters))) 0))
|
|
|
463 edges)
|
|
|
464 (while (or (not (= 0 (car (setq edges (tapestry-window-edges w)))))
|
|
|
465 ;; >= instead of = because in FSF Emacs 19.2x
|
|
|
466 ;; (whenever the Lucid menubar code was added) the
|
|
|
467 ;; menu-bar-lines frame parameter == 1 when the
|
|
|
468 ;; Lucid menubar is enabled even though the
|
|
|
469 ;; menubar doesn't steal the first line from the
|
|
|
470 ;; window.
|
|
|
471 (not (>= top (nth 1 edges))))
|
|
|
472 (setq w (next-window w 'nomini)))
|
|
|
473 w )))
|
|
|
474
|
|
|
475 (defun tapestry-window-area (edges)
|
|
|
476 (* (- (nth 3 edges) (nth 1 edges))
|
|
|
477 (- (nth 2 edges) (nth 0 edges))))
|
|
|
478
|
|
|
479 (defun tapestry-window-overlap (e0 e1)
|
|
|
480 (let (top left bottom right)
|
|
|
481 (cond ((and (<= (nth 0 e0) (nth 0 e1)) (< (nth 0 e1) (nth 2 e0)))
|
|
|
482 (setq left (nth 0 e1)))
|
|
|
483 ((and (<= (nth 0 e1) (nth 0 e0)) (< (nth 0 e0) (nth 2 e1)))
|
|
|
484 (setq left (nth 0 e0))))
|
|
|
485 (cond ((and (< (nth 0 e0) (nth 2 e1)) (<= (nth 2 e1) (nth 2 e0)))
|
|
|
486 (setq right (nth 2 e1)))
|
|
|
487 ((and (< (nth 0 e1) (nth 2 e0)) (<= (nth 2 e0) (nth 2 e1)))
|
|
|
488 (setq right (nth 2 e0))))
|
|
|
489 (cond ((and (<= (nth 1 e0) (nth 1 e1)) (< (nth 1 e1) (nth 3 e0)))
|
|
|
490 (setq top (nth 1 e1)))
|
|
|
491 ((and (<= (nth 1 e1) (nth 1 e0)) (< (nth 1 e0) (nth 3 e1)))
|
|
|
492 (setq top (nth 1 e0))))
|
|
|
493 (cond ((and (< (nth 1 e0) (nth 3 e1)) (<= (nth 3 e1) (nth 3 e0)))
|
|
|
494 (setq bottom (nth 3 e1)))
|
|
|
495 ((and (< (nth 1 e1) (nth 3 e0)) (<= (nth 3 e0) (nth 3 e1)))
|
|
|
496 (setq bottom (nth 3 e0))))
|
|
|
497 (and left top right bottom (list left top right bottom))))
|
|
|
498
|
|
|
499 (defun tapestry-window-edges (&optional window)
|
|
|
500 (if (fboundp 'window-pixel-edges)
|
|
|
501 (let ((edges (window-pixel-edges window))
|
|
|
502 tmp)
|
|
|
503 (setq tmp edges)
|
|
|
504 (setcar tmp (/ (car tmp) (face-width 'default)))
|
|
|
505 (setq tmp (cdr tmp))
|
|
|
506 (setcar tmp (/ (car tmp) (face-height 'default)))
|
|
|
507 (setq tmp (cdr tmp))
|
|
|
508 (setcar tmp (/ (car tmp) (face-width 'default)))
|
|
|
509 (setq tmp (cdr tmp))
|
|
|
510 (setcar tmp (/ (car tmp) (face-height 'default)))
|
|
|
511 edges )
|
|
|
512 (window-edges window)))
|
|
|
513
|
|
|
514 ;; We call these functions instead of calling the Emacs 19 frame
|
|
|
515 ;; functions directly to let this package work with v18 Emacs.
|
|
|
516
|
|
|
517 (defun tapestry-frame-list ()
|
|
|
518 (if (fboundp 'frame-list)
|
|
|
519 (frame-list)
|
|
|
520 (list nil)))
|
|
|
521
|
|
|
522 (defun tapestry-frame-parameters (&optional f)
|
|
|
523 (if (fboundp 'frame-parameters)
|
|
|
524 (frame-parameters f)
|
|
|
525 nil ))
|
|
|
526
|
|
|
527 (defun tapestry-window-frame (w)
|
|
|
528 (if (fboundp 'window-frame)
|
|
|
529 (window-frame w)
|
|
|
530 nil ))
|
|
|
531
|
|
|
532 (defun tapestry-modify-frame-parameters (f alist)
|
|
|
533 (if (fboundp 'modify-frame-parameters)
|
|
|
534 (modify-frame-parameters f alist)
|
|
|
535 nil ))
|
|
|
536
|
|
|
537 (defun tapestry-select-frame (f)
|
|
|
538 (if (fboundp 'select-frame)
|
|
|
539 (select-frame f)
|
|
|
540 nil ))
|
|
|
541
|
|
|
542 (defun tapestry-selected-frame ()
|
|
|
543 (if (fboundp 'selected-frame)
|
|
|
544 (selected-frame)
|
|
|
545 nil ))
|
|
|
546
|
|
|
547 (defun tapestry-next-frame (&optional f all)
|
|
|
548 (if (fboundp 'next-frame)
|
|
|
549 (next-frame f all)
|
|
|
550 nil ))
|
|
|
551
|
|
|
552 (defun tapestry-make-frame (&optional alist)
|
|
|
553 (if (fboundp 'make-frame)
|
|
|
554 (make-frame alist)
|
|
|
555 nil ))
|
|
|
556
|
|
|
557 (defun tapestry-delete-frame (&optional f)
|
|
|
558 (if (fboundp 'delete-frame)
|
|
|
559 (delete-frame f)
|
|
|
560 nil ))
|
|
|
561
|
|
|
562 (defun tapestry-frame-live-p (f)
|
|
|
563 (if (fboundp 'frame-live-p)
|
|
|
564 (frame-live-p f)
|
|
|
565 t ))
|
