diff lisp/vm/tapestry.el @ 20:859a2309aef8 r19-15b93

Import from CVS: tag r19-15b93
author cvs
date Mon, 13 Aug 2007 08:50:05 +0200
parents 376386a54a3c
children 131b0175ea99
line wrap: on
line diff
--- a/lisp/vm/tapestry.el	Mon Aug 13 08:49:44 2007 +0200
+++ b/lisp/vm/tapestry.el	Mon Aug 13 08:50:05 2007 +0200
@@ -1,5 +1,5 @@
 ;;; Tools to configure your GNU Emacs windows
-;;; Copyright (C) 1991, 1993, 1994, 1995 Kyle E. Jones 
+;;; Copyright (C) 1991, 1993, 1994, 1995, 1997 Kyle E. Jones 
 ;;;
 ;;; This program is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
@@ -20,7 +20,12 @@
 
 (provide 'tapestry)
 
-(defvar tapestry-version "1.07")
+(defvar tapestry-version "1.08")
+
+;; Pass state information between the tapestry-set-window-map
+;; and tapestry-set-buffer-map stages.  UGH.  The reason for this
+;; is explained in tapestry-set-buffer-map.
+(defvar tapestry-windows-changed nil)
 
 (defun tapestry (&optional frame-list)
   "Returns a list containing complete information about the current
@@ -69,6 +74,7 @@
 coordinates can be found, the window with the greatest overlap of
 ROOT-WINDOW-EDGES will be used."
   (let ((sf (tapestry-selected-frame))
+	(tapestry-windows-changed nil)
 	frame-list frame-map other-maps other-map)
     (setq frame-map (nth 0 map)
 	  other-maps (nth 1 map))
@@ -195,12 +201,14 @@
 		       (delete-window inside-w)))
 		  (t (setq root-window overlap-w))))
 	  (tapestry-apply-window-map map map-width map-height root-window)
+	  (setq tapestry-windows-changed t)
 	  root-window )
       (if (tapestry-windows-match-map map map-width map-height)
 	  (tapestry-first-window)
 	(delete-other-windows)
 	(setq root-window (selected-window))
 	(tapestry-apply-window-map map map-width map-height root-window)
+	(setq tapestry-windows-changed t)
 	root-window ))))
 
 (defun tapestry-buffer-map ()
@@ -214,16 +222,50 @@
 	    w-list (cdr w-list)))
     (nreverse list)))
 
+;; This version of tapestry-set-buffer-map unconditionally set
+;; the window buffer.  This confused XEmacs 19.14's scroll-up
+;; function when scrolling VM presentation buffers.
+;; end-of-buffer was never signaled after a scroll.  You can
+;; duplicate this by creating a buffer that can be displayed
+;; fully in the current window and then run
+;;
+;;    (progn
+;;      (set-window-buffer (selected-window) (current-buffer))
+;;      (scroll-up nil))
+;;;;;;;;;;;
+;;(defun tapestry-set-buffer-map (buffer-map &optional first-window)
+;;  (let ((w-list (tapestry-window-list first-window)) wb)
+;;    (while (and w-list buffer-map)
+;;      (setq wb (car buffer-map))
+;;      (set-window-buffer
+;;       (car w-list)
+;;       (if (car wb)
+;;	   (or (get-file-buffer (car wb))
+;;	       (find-file-noselect (car wb)))
+;;	 (get-buffer-create (nth 1 wb))))
+;;      (setq w-list (cdr w-list)
+;;	    buffer-map (cdr buffer-map)))))
+
 (defun tapestry-set-buffer-map (buffer-map &optional first-window)
-  (let ((w-list (tapestry-window-list first-window)) wb)
+  (let ((w-list (tapestry-window-list first-window))
+	current-wb proposed-wb cell)
     (while (and w-list buffer-map)
-      (setq wb (car buffer-map))
-      (set-window-buffer
-       (car w-list)
-       (if (car wb)
-	   (or (get-file-buffer (car wb))
-	       (find-file-noselect (car wb)))
-	 (get-buffer-create (nth 1 wb))))
+      (setq cell (car buffer-map)
+	    proposed-wb (if (car cell)
+			    (or (get-file-buffer (car cell))
+				(find-file-noselect (car cell)))
+			  (get-buffer-create (nth 1 cell)))
+	    current-wb (window-buffer (car w-list)))
+      ;; Setting the window buffer to the same value it already
+      ;; has seems to confuse XEmacs' scroll-up function.  But
+      ;; _not_ setting after windows torn down seem to cause
+      ;; window point to sometimes drift away from point at
+      ;; redisplay time.  The solution (hopefully!) is to track
+      ;; when windows have been rearranged and unconditionally do
+      ;; the set-window-buffer, otherwise do it only if the
+      ;; window buffer and the prosed window buffer differ.
+      (if (or tapestry-windows-changed (not (eq proposed-wb current-wb)))
+	  (set-window-buffer (car w-list) proposed-wb))
       (setq w-list (cdr w-list)
 	    buffer-map (cdr buffer-map)))))