comparison lisp/vm/tapestry.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 859a2309aef8
children 0d2f883870bc
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; Tools to configure your GNU Emacs windows 1 ;;; Tools to configure your GNU Emacs windows
2 ;;; Copyright (C) 1991, 1993, 1994, 1995, 1997 Kyle E. Jones 2 ;;; Copyright (C) 1991, 1993, 1994, 1995 Kyle E. Jones
3 ;;; 3 ;;;
4 ;;; This program is free software; you can redistribute it and/or modify 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 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) 6 ;;; the Free Software Foundation; either version 1, or (at your option)
7 ;;; any later version. 7 ;;; any later version.
18 ;;; 18 ;;;
19 ;;; Send bug reports to kyle@uunet.uu.net. 19 ;;; Send bug reports to kyle@uunet.uu.net.
20 20
21 (provide 'tapestry) 21 (provide 'tapestry)
22 22
23 (defvar tapestry-version "1.08") 23 (defvar tapestry-version "1.07")
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)
29 24
30 (defun tapestry (&optional frame-list) 25 (defun tapestry (&optional frame-list)
31 "Returns a list containing complete information about the current 26 "Returns a list containing complete information about the current
32 configuration of Emacs frames, windows, buffers and cursor 27 configuration of Emacs frames, windows, buffers and cursor
33 positions. Call the function set-tapestry with the list that this function 28 positions. Call the function set-tapestry with the list that this function
72 ROOT-WINDOW-EDGES is entirely contained within the expanded 67 ROOT-WINDOW-EDGES is entirely contained within the expanded
73 window. If no window entirely within the ROOT-WINDOW-EDGES edge 68 window. If no window entirely within the ROOT-WINDOW-EDGES edge
74 coordinates can be found, the window with the greatest overlap of 69 coordinates can be found, the window with the greatest overlap of
75 ROOT-WINDOW-EDGES will be used." 70 ROOT-WINDOW-EDGES will be used."
76 (let ((sf (tapestry-selected-frame)) 71 (let ((sf (tapestry-selected-frame))
77 (tapestry-windows-changed nil)
78 frame-list frame-map other-maps other-map) 72 frame-list frame-map other-maps other-map)
79 (setq frame-map (nth 0 map) 73 (setq frame-map (nth 0 map)
80 other-maps (nth 1 map)) 74 other-maps (nth 1 map))
81 (if (and root-window-edges (null n)) 75 (if (and root-window-edges (null n))
82 (setq n 1)) 76 (setq n 1))
199 ;; multi-line minibuffer, that's how! 193 ;; multi-line minibuffer, that's how!
200 (if (not (one-window-p t)) 194 (if (not (one-window-p t))
201 (delete-window inside-w))) 195 (delete-window inside-w)))
202 (t (setq root-window overlap-w)))) 196 (t (setq root-window overlap-w))))
203 (tapestry-apply-window-map map map-width map-height root-window) 197 (tapestry-apply-window-map map map-width map-height root-window)
204 (setq tapestry-windows-changed t)
205 root-window ) 198 root-window )
206 (if (tapestry-windows-match-map map map-width map-height) 199 (if (tapestry-windows-match-map map map-width map-height)
207 (tapestry-first-window) 200 (tapestry-first-window)
208 (delete-other-windows) 201 (delete-other-windows)
209 (setq root-window (selected-window)) 202 (setq root-window (selected-window))
210 (tapestry-apply-window-map map map-width map-height root-window) 203 (tapestry-apply-window-map map map-width map-height root-window)
211 (setq tapestry-windows-changed t)
212 root-window )))) 204 root-window ))))
213 205
214 (defun tapestry-buffer-map () 206 (defun tapestry-buffer-map ()
215 (let ((w-list (tapestry-window-list)) 207 (let ((w-list (tapestry-window-list))
216 b list) 208 b list)
220 (buffer-name b)) 212 (buffer-name b))
221 list) 213 list)
222 w-list (cdr w-list))) 214 w-list (cdr w-list)))
223 (nreverse list))) 215 (nreverse list)))
224 216
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
249 (defun tapestry-set-buffer-map (buffer-map &optional first-window) 217 (defun tapestry-set-buffer-map (buffer-map &optional first-window)
250 (let ((w-list (tapestry-window-list first-window)) 218 (let ((w-list (tapestry-window-list first-window)) wb)
251 current-wb proposed-wb cell)
252 (while (and w-list buffer-map) 219 (while (and w-list buffer-map)
253 (setq cell (car buffer-map) 220 (setq wb (car buffer-map))
254 proposed-wb (if (car cell) 221 (set-window-buffer
255 (or (get-file-buffer (car cell)) 222 (car w-list)
256 (find-file-noselect (car cell))) 223 (if (car wb)
257 (get-buffer-create (nth 1 cell))) 224 (or (get-file-buffer (car wb))
258 current-wb (window-buffer (car w-list))) 225 (find-file-noselect (car wb)))
259 ;; Setting the window buffer to the same value it already 226 (get-buffer-create (nth 1 wb))))
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))
269 (setq w-list (cdr w-list) 227 (setq w-list (cdr w-list)
270 buffer-map (cdr buffer-map))))) 228 buffer-map (cdr buffer-map)))))
271 229
272 (defun tapestry-position-map () 230 (defun tapestry-position-map ()
273 (let ((sw (selected-window)) 231 (let ((sw (selected-window))