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