🚀 go-pugleaf

Changes:

* fixed vm-fsf-emacs-19-p to not confuse FSF Emacs with Lucid
* changed code to deal with screen.el's rename to tapestry.el
* set enable-local-variables to nil in vm-build-virtual-message-list
* began work on code in vm-virtual.el to get virtual folders to
  work right.  not finished yet.
* expanded and reorganized message structure for virtual folders
* added patch from jwz to use set-keymap parent in
  vm-edit-message under Lucid Emacs.

*** vm-edit.el.dist	Sun Aug 15 21:19:01 1993
--- vm-edit.el	Wed Aug 25 01:51:50 1993
***************
*** 72,77 ****
--- 72,81 ----
  	      (use-local-map (append vm-edit-message-mode-map
  				     (or (current-local-map)
  					 (make-sparse-keymap)))))
+ 	     ((vm-lucid-emacs-p)
+ 	      (let ((m (copy-keymap vm-edit-message-mode-map)))
+ 		(set-keymap-parent m (current-local-map))
+ 		(use-local-map m)))
  	     (t (use-local-map (copy-keymap (or (current-local-map)
  						(make-sparse-keymap))))
  		(vm-overlay-keymap vm-edit-message-mode-map
*** vm-folder.el.dist	Sun Aug 15 21:19:02 1993
--- vm-folder.el	Sat Aug 21 21:24:10 1993
***************
*** 1205,1213 ****
  	(random t)
  	(vm-load-rc)
  	(if vm-window-configuration-file
! 	    (if (condition-case () (progn (require 'screen) t))
  		(vm-load-window-configurations vm-window-configuration-file)
! 	      (message "can't support window configurations without the screen package... sorry.")
  	      (setq vm-window-configuration-file nil)
  	      (sleep-for 2)))
  	(setq vm-session-beginning nil))))
--- 1205,1213 ----
  	(random t)
  	(vm-load-rc)
  	(if vm-window-configuration-file
! 	    (if (condition-case () (progn (require 'tapestry) t))
  		(vm-load-window-configurations vm-window-configuration-file)
! 	      (message "can't support window configurations without the tapestry package... sorry.")
  	      (setq vm-window-configuration-file nil)
  	      (sleep-for 2)))
  	(setq vm-session-beginning nil))))
***************
*** 1236,1243 ****
    (interactive (list nil current-prefix-arg))
    (vm-session-initialization)
    ;; set inhibit-local-variables non-nil to protect
-   ;; set enable-local-variables to nil for newer Emacses
    ;; against letter bombs.
    (let ((inhibit-local-variables t)
  	(enable-local-variables nil)
  	(full-startup (not (bufferp folder)))
--- 1236,1243 ----
    (interactive (list nil current-prefix-arg))
    (vm-session-initialization)
    ;; set inhibit-local-variables non-nil to protect
    ;; against letter bombs.
+   ;; set enable-local-variables to nil for newer Emacses
    (let ((inhibit-local-variables t)
  	(enable-local-variables nil)
  	(full-startup (not (bufferp folder)))
*** vm-message.el.dist	Mon Mar  2 00:04:32 1992
--- vm-message.el	Wed Aug 25 00:57:30 1993
***************
*** 16,22 ****
  ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  
  ;; data that is always shared with virtual folders
! (defmacro vm-virtual-data-of (message) (list 'aref message 0))
  ;; where message begins (From_ line)
  (defmacro vm-start-of (message) (list 'aref (list 'aref message 0) 0))
  ;; where visible headers start
--- 16,22 ----
  ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  
  ;; data that is always shared with virtual folders
! (defmacro vm-location-data-of (message) (list 'aref message 0))
  ;; where message begins (From_ line)
  (defmacro vm-start-of (message) (list 'aref (list 'aref message 0) 0))
  ;; where visible headers start
***************
*** 30,45 ****
  				       (aref (aref message 0) 2))))
  ;; where message ends
  (defmacro vm-end-of (message) (list 'aref (list 'aref message 0) 3))
- ;; if message is being edited, this is the buffer being used.
- (defmacro vm-edit-buffer-of (message) (list 'aref (list 'aref message 0) 4))
- ;; message type; if nil, then default to folder type
- (defmacro vm-message-type-of (message) (list 'aref (list 'aref message 0) 5))
- ;; link to real message
- (defmacro vm-real-message-of (message) (list 'symbol-value (list 'aref (list 'aref message 0) 6)))
- ;; list of virtual messages referencing the above real message
- (defmacro vm-virtual-messages-of (message) (list 'aref (list 'aref message 0) 7))
- ;; list to previous message in the message list
- (defmacro vm-reverse-link-of (message) (list 'symbol-value (list 'aref (list 'aref message 0) 8)))
  ;; soft data vector
  (defmacro vm-softdata-of (message) (list 'aref message 1))
  (defmacro vm-number-of (message) (list 'aref (list 'aref message 1) 0))
--- 30,35 ----
***************
*** 94,113 ****
  (defmacro vm-to-names-of (message) (list 'aref (list 'aref message 3) 14))
  ;; numeric month sent
  (defmacro vm-month-number-of (message) (list 'aref (list 'aref message 3) 15))
  ;; modificaiton flag for this message
! (defmacro vm-modflag-of (message) (list 'aref message 4))
  
! (defmacro vm-set-virtual-data-of (message vdata) (list 'aset message 0 vdata))
  (defmacro vm-set-start-of (message start) (list 'aset (list 'aref message 0) 0 start))
  (defmacro vm-set-vheaders-of (message vh) (list 'aset (list 'aref message 0) 1 vh))
  (defmacro vm-set-text-of (message text) (list 'aset (list 'aref message 0) 2 text))
  (defmacro vm-set-end-of (message end) (list 'aset (list 'aref message 0) 3 end))
- (defmacro vm-set-edit-buffer-of (message buf) (list 'aset (list 'aref message 0) 4 buf))
- (defmacro vm-set-message-type-of (message type) (list 'aset (list 'aref message 0) 5 type))
- (defmacro vm-set-real-message-sym-of (message sym) (list 'aset (list 'aref message 0) 6 sym))
- (defmacro vm-set-virtual-messages-of (message list) (list 'aset (list 'aref message 0) 7 list))
- (defmacro vm-set-reverse-link-sym-of (message sym) (list 'aset (list 'aref message 0) 8 sym))
- (defmacro vm-set-reverse-link-of (message link) (list 'set (list 'aref (list 'aref message 0) 8) link))
  (defmacro vm-set-softdata-of (message data) (list 'aset message 1 data))
  (defmacro vm-set-number-of (message n) (list 'aset (list 'aref message 1) 0 n))
  (defmacro vm-set-mark-of (message val) (list 'aset (list 'aref message 1) 1 val))
--- 84,109 ----
  (defmacro vm-to-names-of (message) (list 'aref (list 'aref message 3) 14))
  ;; numeric month sent
  (defmacro vm-month-number-of (message) (list 'aref (list 'aref message 3) 15))
+ ;; extra data shared by virtual messages if vm-virtual-mirror is non-nil
+ (defmacro vm-mirror-data-of (message) (list 'aref message 4))
+ ;; if message is being edited, this is the buffer being used.
+ (defmacro vm-edit-buffer-of (message) (list 'aref (list 'aref message 4) 0))
+ ;; list of virtual messages referencing the above real message
+ (defmacro vm-virtual-messages-of (message) (list 'aref (list 'aref message 4) 1))
  ;; modificaiton flag for this message
! (defmacro vm-modflag-of (message) (list 'aref message 5))
! ;; link to real message
! (defmacro vm-real-message-of (message) (list 'symbol-value (list 'aref message 6)))
! ;; list to previous message in the message list
! (defmacro vm-reverse-link-of (message) (list 'symbol-value (list 'aref message 7)))
! ;; message type; if nil, then default to folder type
! (defmacro vm-message-type-of (message) (list 'aref message 8))
  
! (defmacro vm-set-location-data-of (message vdata) (list 'aset message 0 vdata))
  (defmacro vm-set-start-of (message start) (list 'aset (list 'aref message 0) 0 start))
  (defmacro vm-set-vheaders-of (message vh) (list 'aset (list 'aref message 0) 1 vh))
  (defmacro vm-set-text-of (message text) (list 'aset (list 'aref message 0) 2 text))
  (defmacro vm-set-end-of (message end) (list 'aset (list 'aref message 0) 3 end))
  (defmacro vm-set-softdata-of (message data) (list 'aset message 1 data))
  (defmacro vm-set-number-of (message n) (list 'aset (list 'aref message 1) 0 n))
  (defmacro vm-set-mark-of (message val) (list 'aset (list 'aref message 1) 1 val))
***************
*** 150,156 ****
    (list 'aset (list 'aref message 3) 14 recips))
  (defmacro vm-set-month-number-of (message val)
    (list 'aset (list 'aref message 3) 15 val))
! (defmacro vm-set-modflag-of (message val) (list 'aset message 4 val))
  
  (defun vm-text-end-of (message)
    (- (vm-end-of message)
--- 146,162 ----
    (list 'aset (list 'aref message 3) 14 recips))
  (defmacro vm-set-month-number-of (message val)
    (list 'aset (list 'aref message 3) 15 val))
! (defmacro vm-set-mirror-data-of (message data)
!   (list 'aset message 4 data))
! (defmacro vm-set-edit-buffer-of (message buf)
!   (list 'aset (list 'aref message 4) 0 buf))
! (defmacro vm-set-virtual-messages-of (message list)
!   (list 'aset (list 'aref message 4) 1 list))
! (defmacro vm-set-modflag-of (message val) (list 'aset message 5 val))
! (defmacro vm-set-real-message-sym-of (message sym) (list 'aset message 6 sym))
! (defmacro vm-set-reverse-link-of (message link) (list 'set (list 'aref message 7) link))
! (defmacro vm-set-reverse-link-sym-of (message sym) (list 'aset message 7 sym))
! (defmacro vm-set-message-type-of (message type) (list 'aset message 8 type))
  
  (defun vm-text-end-of (message)
    (- (vm-end-of message)
***************
*** 158,166 ****
  	   (t 1))))
  
  (defun vm-make-message ()
!   (let ((v (make-vector 5 nil)) sym)
      (vm-set-softdata-of v (make-vector vm-softdata-vector-length nil))
!     (vm-set-virtual-data-of v (make-vector vm-virtual-data-vector-length nil))
      ;; We use an uninterned symbol here as a level of indirection
      ;; from a purely self-referential structure.  This is
      ;; necessary so that Emacs debugger can be used on this
--- 164,174 ----
  	   (t 1))))
  
  (defun vm-make-message ()
!   (let ((v (make-vector 9 nil)) sym)
      (vm-set-softdata-of v (make-vector vm-softdata-vector-length nil))
!     (vm-set-location-data-of
!      v (make-vector vm-location-data-vector-length nil))
!     (vm-set-mirror-data-of v (make-vector vm-mirror-data-vector-length nil))
      ;; We use an uninterned symbol here as a level of indirection
      ;; from a purely self-referential structure.  This is
      ;; necessary so that Emacs debugger can be used on this
*** vm-misc.el.dist	Sun Aug 15 21:19:03 1993
--- vm-misc.el	Sat Aug 21 21:24:02 1993
***************
*** 277,280 ****
    (string-match "Lucid" emacs-version))
  
  (defun vm-fsf-emacs-19-p ()
!   (string-match "^19" emacs-version))
--- 277,280 ----
    (string-match "Lucid" emacs-version))
  
  (defun vm-fsf-emacs-19-p ()
!   (and (string-match "^19" emacs-version) (not (vm-lucid-emacs-p))))
*** vm-vars.el.dist	Sun Aug 15 21:19:05 1993
--- vm-vars.el	Wed Aug 25 00:31:34 1993
***************
*** 253,259 ****
  underlying real message.
  
  The value of vm-virtual-mirror is considered only at the time a
! virtaul folder is visited.  Changing the value of vm-virtual-mirror
  does not affect the behavior of existing virtual folders.")
  
  (defvar vm-folder-read-only nil
--- 253,259 ----
  underlying real message.
  
  The value of vm-virtual-mirror is considered only at the time a
! virtual folder is visited.  Changing the value of vm-virtual-mirror
  does not affect the behavior of existing virtual folders.")
  
  (defvar vm-folder-read-only nil
***************
*** 761,767 ****
  (defconst vm-attributes-vector-length 9)
  (defconst vm-cache-vector-length 16)
  (defconst vm-softdata-vector-length 4)
! (defconst vm-virtual-data-vector-length 9)
  (defconst vm-startup-message-lines
        '("Mail bug reports to bug-vm@uunet.uu.net or post them to gnu.emacs.vm.bug"
  	"This is prerelease software.  Giving out copies of it means DEATH!"
--- 761,768 ----
  (defconst vm-attributes-vector-length 9)
  (defconst vm-cache-vector-length 16)
  (defconst vm-softdata-vector-length 4)
! (defconst vm-location-data-vector-length 4)
! (defconst vm-mirror-data-vector-length 2)
  (defconst vm-startup-message-lines
        '("Mail bug reports to bug-vm@uunet.uu.net or post them to gnu.emacs.vm.bug"
  	"This is prerelease software.  Giving out copies of it means DEATH!"
*** vm-version.el.dist	Sun Aug 15 21:19:05 1993
--- vm-version.el	Sat Aug 21 21:24:23 1993
***************
*** 1,6 ****
  (provide 'vm)
  
! (defconst vm-version "5.34 (beta)"
    "Version number of VM.")
  
  (defun vm-version ()
--- 1,6 ----
  (provide 'vm)
  
! (defconst vm-version "5.35 (beta)"
    "Version number of VM.")
  
  (defun vm-version ()
*** vm-virtual.el.dist	Sun Aug 15 21:19:05 1993
--- vm-virtual.el	Sun Aug 22 12:00:54 1993
***************
*** 31,69 ****
      (setq first-time (not (eq major-mode 'vm-virtual-mode)))
      (if first-time
  	(progn
! 	  (setq major-mode 'vm-virtual-mode
! 		mode-name "VM Virtual"
  		mode-line-format vm-mode-line-format
  		buffer-read-only t
  		vm-folder-read-only read-only
  		truncate-lines t
  		vm-current-grouping vm-group-by
- 		vm-mail-buffer (current-buffer)
- 		vm-summary-buffer vm-mail-buffer
  		vm-numbering-redo-start-point t
  		vm-summary-redo-start-point t)
- 	  (buffer-disable-undo (current-buffer))
- 	  (abbrev-mode 0)
- 	  (auto-fill-mode 0)
  	  (vm-build-virtual-message-list
! 	   (assoc folder-name vm-virtual-folder-alist)
! 	   read-only)
! 	  (vm-thoughtfully-select-message)
  	  (use-local-map vm-mode-map)
  	  (vm-emit-totals-blurb)))
      (switch-to-buffer (current-buffer))
      (and (not vm-inhibit-startup-message) (not vm-startup-message-displayed)
  	 (vm-display-startup-message))))
  
! (defun vm-build-virtual-message-list (def read-only)
    (let ((clauses (cdr def))
  	;; letter bomb protection
  	;; set enable-local-variables to nil for newer Emacses
  	(inhibit-local-variables t)
  	(vbuffer (current-buffer))
! 	(inhibit-quit t)
! 	message-list folders folder selector-list selector arg
! 	buffers-used)
      (save-excursion
        (while clauses
  	(setq folders (car (car clauses))
--- 31,69 ----
      (setq first-time (not (eq major-mode 'vm-virtual-mode)))
      (if first-time
  	(progn
! 	  (buffer-disable-undo (current-buffer))
! 	  (abbrev-mode 0)
! 	  (auto-fill-mode 0)
! 	  (setq mode-name "VM Virtual"
  		mode-line-format vm-mode-line-format
  		buffer-read-only t
  		vm-folder-read-only read-only
  		truncate-lines t
  		vm-current-grouping vm-group-by
  		vm-numbering-redo-start-point t
  		vm-summary-redo-start-point t)
  	  (vm-build-virtual-message-list
! 	   (assoc folder-name vm-virtual-folder-alist))
  	  (use-local-map vm-mode-map)
+ 	  ;; save this for last in case the user interrupts.
+ 	  ;; an interrupt anywhere before this point will cause
+ 	  ;; everything to be redone next revisit.
+ 	  (setq major-mode 'vm-virtual-mode)
+ 	  (vm-thoughtfully-select-message)
  	  (vm-emit-totals-blurb)))
      (switch-to-buffer (current-buffer))
      (and (not vm-inhibit-startup-message) (not vm-startup-message-displayed)
  	 (vm-display-startup-message))))
  
! (defun vm-build-virtual-message-list (def)
    (let ((clauses (cdr def))
  	;; letter bomb protection
  	;; set enable-local-variables to nil for newer Emacses
  	(inhibit-local-variables t)
+ 	(enable-local-variables nil)
  	(vbuffer (current-buffer))
! 	message-list mp folders folder selector-list selector arg
! 	real-buffers-used)
      (save-excursion
        (while clauses
  	(setq folders (car (car clauses))
***************
*** 90,96 ****
  			      (find-file-noselect folder)))
  	      (if (not (memq vbuffer vm-virtual-buffers))
  		  (setq vm-virtual-buffers (cons vbuffer vm-virtual-buffers)
! 			buffers-used (cons (current-buffer) buffers-used)))
  	      (if (not (eq major-mode 'vm-mode))
  		  (vm-mode))
  	      (setq mp vm-message-list)
--- 90,96 ----
  			      (find-file-noselect folder)))
  	      (if (not (memq vbuffer vm-virtual-buffers))
  		  (setq vm-virtual-buffers (cons vbuffer vm-virtual-buffers)
! 			real-buffers-used (cons (current-buffer) real-buffers-used)))
  	      (if (not (eq major-mode 'vm-mode))
  		  (vm-mode))
  	      (setq mp vm-message-list)
***************
*** 102,111 ****
  		      (setq message-list (cons (copy-sequence (car mp))
  					       message-list))
  		      (if vm-virtual-mirror
! 			  (vm-set-virtual-messages-of
! 			   (car mp)
! 			   (cons (car message-list)
! 				 (vm-virtual-messages-of (car mp))))
  			(vm-set-attributes-of
  			 (car message-list)
  			 (make-vector vm-attributes-vector-length nil)))
--- 102,111 ----
  		      (setq message-list (cons (copy-sequence (car mp))
  					       message-list))
  		      (if vm-virtual-mirror
! 			  ()
! 			(vm-set-mirror-data-of
! 			 (car message-list)
! 			 (make-vector nil vm-mirror-data-vector-length))
  			(vm-set-attributes-of
  			 (car message-list)
  			 (make-vector vm-attributes-vector-length nil)))
***************
*** 113,125 ****
  		       (car message-list)
  		       (copy-sequence (vm-softdata-of
  				       (car message-list))))
! 		      (vm-set-mark-of (car message-list) nil)))
  		(setq mp (cdr mp)))
  	      (setq folders (cdr folders))))
  	  (setq selector-list (cdr selector-list)))
  	(setq clauses (cdr clauses))))
!     (setq vm-message-list (nreverse message-list)
! 	  vm-real-buffers buffers-used)))
  
  (defun vm-delete-directories (list)
    (vm-delete 'file-directory-p list))
--- 113,148 ----
  		       (car message-list)
  		       (copy-sequence (vm-softdata-of
  				       (car message-list))))
! 		      (vm-set-mark-of (car message-list) nil)
! 		      (vm-set-modflag-of (car message-list) nil)
! 		      (vm-set-reverse-link-of (car message-list) nil)))
  		(setq mp (cdr mp)))
  	      (setq folders (cdr folders))))
  	  (setq selector-list (cdr selector-list)))
  	(setq clauses (cdr clauses))))
!     ;; Until this point the user doesn't really have a virtual
!     ;; folder, as the virtual message haven't been linked to the
!     ;; real messages, virtual buffers to the real buffers, and no
!     ;; message list has been installed.
!     ;;
!     ;; Now we tie it all together, with this section of code being
!     ;; uninterruptible.
!     (let ((inhibit-quit))
!       (setq vm-real-buffers real-buffers-used)
!       (while real-buffers-used
! 	(set-buffer (car real-buffers-used))
! 	(if (not (memq vbuffer vm-virtual-buffers))
! 	    (setq vm-virtual-buffers (cons vbuffer vm-virtual-buffers)))
! 	(setq real-buffers-used (cdr real-buffers-used)))
!       (if vm-virtual-mirror
! 	  (progn
! 	    (setq mp message-list)
! 	    (while mp
! 	      (vm-set-virtual-messages-of
! 	       (vm-real-message-of (car mp))
! 	       (cons (car map) (vm-virtual-messages-of (car mp))))
! 	      (setq mp (cdr mp)))))
!       (setq vm-message-list (nreverse message-list)))))
  
  (defun vm-delete-directories (list)
    (vm-delete 'file-directory-p list))
***************
*** 168,175 ****
  	      bp (cdr bp))))
      (while mp
        (vm-set-virtual-messages-of
!        (car mp)
!        (delq (car mp) (vm-virtual-messages-of (car mp))))
        (setq mp (cdr mp)))
      (set-buffer-modified-p nil)
      (kill-buffer (current-buffer))))
--- 191,198 ----
  	      bp (cdr bp))))
      (while mp
        (vm-set-virtual-messages-of
!        (vm-real-message-of (car mp))
!        (delq (car mp) (vm-virtual-messages-of (vm-real-message-of (car mp)))))
        (setq mp (cdr mp)))
      (set-buffer-modified-p nil)
      (kill-buffer (current-buffer))))
*** vm-window.el.dist	Mon Mar  2 00:04:34 1992
--- vm-window.el	Sat Aug 21 21:29:56 1993
***************
*** 125,132 ****
        (or message (setq message (current-buffer)))
        (or summary (setq summary (or vm-summary-buffer scratch)))
        (or composition (setq composition scratch))	
!       (screen-replace-map-element (nth 1 config) 'buffer-name 'symbol-value)
!       (set-screen-map (nth 1 config))
        (save-excursion
  	(set-buffer message)
  	(setq vm-window-configuration (car tags)))
--- 125,132 ----
        (or message (setq message (current-buffer)))
        (or summary (setq summary (or vm-summary-buffer scratch)))
        (or composition (setq composition scratch))	
!       (tapestry-replace-map-element (nth 1 config) 'buffer-name 'symbol-value)
!       (set-tapestry-map (nth 1 config))
        (save-excursion
  	(set-buffer message)
  	(setq vm-window-configuration (car tags)))
***************
*** 145,153 ****
    (if (null vm-window-configuration-file)
        (error "Configurable windows not enabled."))
    (let (map p)
!     (setq map (screen-map))
!     (screen-replace-map-element map 'buffer-name 'vm-screen-buffer-to-label)
!     (screen-nullify-map-elements map t nil t t t nil)
      (setq p (assq tag vm-window-configurations))
      (if p
  	(setcar (cdr p) map)
--- 145,153 ----
    (if (null vm-window-configuration-file)
        (error "Configurable windows not enabled."))
    (let (map p)
!     (setq map (tapestry-map))
!     (tapestry-replace-map-element map 'buffer-name 'vm-screen-buffer-to-label)
!     (tapestry-nullify-map-elements map t nil t t t nil)
      (setq p (assq tag vm-window-configurations))
      (if p
  	(setcar (cdr p) map)
*** tapestry.el.dist	Wed Aug 25 01:28:19 1993
--- tapestry.el	Wed Aug 25 01:37:24 1993
***************
*** 0 ****
--- 1,234 ----
+ ;;; Tools to configure your GNU Emacs windows
+ ;;; Copyright (C) 1991 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
+ ;;; the Free Software Foundation; either version 1, or (at your option)
+ ;;; any later version.
+ ;;;
+ ;;; This program is distributed in the hope that it will be useful,
+ ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;;; GNU General Public License for more details.
+ ;;;
+ ;;; A copy of the GNU General Public License can be obtained from this
+ ;;; program's author (send electronic mail to kyle@uunet.uu.net) or from
+ ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
+ ;;; 02139, USA.
+ ;;;
+ ;;; Send bug reports to kyle@uunet.uu.net.
+ 
+ (provide 'tapestry)
+ 
+ (defvar tapestry-version "1.00")
+ 
+ (defun tapestry-map ()
+   "Returns a list containing complete information about the current
+ configuration of windows and buffers.  Call the function
+ set-tapestry-map with this list to restore the current
+ window/buffer configuration.
+ 
+ This is much like the function window-configuration except that
+ the information is returned in a form that can be saved and
+ restored across multiple Emacs sessions."
+   (list (window-map) (buffer-map) (position-map)))
+ 
+ (defun set-tapestry-map (map)
+   "Restore the window/buffer configuration described by MAP,
+ which should be a list previously returned by a call to
+ tapestry-map."
+   (set-window-map (nth 0 map))
+   (set-buffer-map (nth 1 map))
+   (set-position-map (nth 2 map)))
+ 
+ (defun window-map ()
+   (let (w maps map0 map1 map0-edges map1-edges x-unchanged y-unchanged)
+     (setq maps (mapcar 'window-edges (tapestry-window-list)))
+     (while (cdr maps)
+       (setq map0 maps)
+       (while (cdr map0)
+ 	(setq map1 (cdr map0)
+ 	      map0-edges (tapestry-find-window-map-edges (car map0))
+ 	      map1-edges (tapestry-find-window-map-edges (car map1))
+ 	      x-unchanged (and (= (car map0-edges) (car map1-edges))
+ 			       (= (nth 2 map0-edges) (nth 2 map1-edges)))
+ 	      y-unchanged (and (= (nth 1 map0-edges) (nth 1 map1-edges))
+ 			       (= (nth 3 map0-edges) (nth 3 map1-edges))))
+ 	(cond ((and (not x-unchanged) (not y-unchanged))
+ 	       (setq map0 (cdr map0)))
+ 	      ((or (and x-unchanged (eq (car (car map0)) '-))
+ 		   (and y-unchanged (eq (car (car map0)) '|)))
+ 	       (nconc (car map0) (list (car map1)))
+ 	       (setcdr map0 (cdr map1)))
+ 	      (t
+ 	       (setcar map0 (list (if x-unchanged '- '|)
+ 				  (car map0)
+ 				  (car map1)))
+ 	       (setcdr map0 (cdr map1))))))
+     (car maps)))
+ 
+ (defun set-window-map (map)
+   (if (eq (selected-window) (minibuffer-window))
+       (delete-other-windows (next-window (minibuffer-window)))
+     (delete-other-windows))
+   (let (map-width map-height)
+     (setq map-width (tapestry-compute-map-width map)
+ 	  map-height (tapestry-compute-map-height map))
+     (tapestry-apply-window-map map (next-window (minibuffer-window)))))
+ 
+ (defun buffer-map ()
+   (let ((w-list (tapestry-window-list))
+ 	b list)
+     (while w-list
+       (setq b (window-buffer (car w-list))
+ 	    list (cons (list (buffer-file-name b)
+ 			     (buffer-name b))
+ 		       list)
+ 	    w-list (cdr w-list)))
+     (nreverse list)))
+ 
+ (defun set-buffer-map (buffer-map)
+   (let ((w-list (tapestry-window-list)) 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 position-map ()
+   (let ((sw (selected-window))
+ 	(w-list (tapestry-window-list))
+ 	list)
+     (while w-list
+       (setq list (cons (list (window-start (car w-list))
+ 			     (window-point (car w-list))
+ 			     (window-hscroll (car w-list))
+ 			     (eq (car w-list) sw))
+ 		       list)
+ 	    w-list (cdr w-list)))
+     (nreverse list)))
+ 
+ (defun set-position-map (position-map)
+   (let ((w-list (tapestry-window-list)) (osw (selected-window)) sw p)
+     ;; select a window we don't care about so that when we select
+     ;; another window its buffer will be moved up in the buffer
+     ;; list.
+     (select-window (minibuffer-window))
+     (while (and w-list position-map)
+       (setq p (car position-map))
+       (and (car p) (set-window-start (car w-list) (car p)))
+       (and (nth 1 p) (set-window-point (car w-list) (nth 1 p)))
+       (and (nth 2 p) (set-window-hscroll (car w-list) (nth 2 p)))
+       (and (nth 3 p) (setq sw (car w-list)))
+       ;; move this buffer up in the buffer-list
+       (select-window (car w-list))
+       (setq w-list (cdr w-list)
+ 	    position-map (cdr position-map)))
+     (select-window (or sw osw))))
+ 
+ (defun tapestry-window-list (&optional mini)
+   "Returns a list of Lisp window objects for all Emacs windows.
+ Optional first arg MINIBUF t means include the minibuffer window
+ in the list, even if it is not active.  If MINIBUF is neither t
+ nor nil it means to not count the minibuffer window even if it is active."
+   (let* ((first-window (next-window (minibuffer-window)))
+ 	 (windows (cons first-window nil))
+ 	 (current-cons windows)
+ 	 (w (next-window first-window mini)))
+     (while (not (eq w first-window))
+       (setq current-cons (setcdr current-cons (cons w nil)))
+       (setq w (next-window w mini)))
+     windows))
+ 
+ (defun tapestry-apply-window-map (map current-window)
+   (let (horizontal)
+     (while map
+       (cond
+        ((numberp (car map)) (setq map nil))
+        ((eq (car map) '-))
+        ((eq (car map) '|) (setq horizontal t))
+        (t
+ 	(if (cdr map)
+ 	    (split-window
+ 	     current-window
+ 	     (if horizontal
+ 		 (1- (/ (* (tapestry-compute-map-width (car map)) (screen-width))
+ 		       map-width))
+ 	       (/ (* (tapestry-compute-map-height (car map))
+ 		     (- (screen-height) (window-height (minibuffer-window))))
+ 		  map-height))
+ 	     horizontal))
+ 	(if (not (numberp (car (car map))))
+ 	    (setq current-window
+ 		  (tapestry-apply-window-map (car map) current-window)))
+ 	(and (cdr map) (setq current-window (next-window current-window)))))
+       (setq map (cdr map)))
+     current-window ))
+ 
+ (defun tapestry-find-window-map-edges (map)
+   (let (nw-edges se-edges)
+     (setq nw-edges map)
+     (while (and (consp nw-edges) (not (numberp (car nw-edges))))
+       (setq nw-edges (car (cdr nw-edges))))
+     (setq se-edges map)
+     (while (and (consp se-edges) (not (numberp (car se-edges))))
+       (while (cdr se-edges)
+ 	(setq se-edges (cdr se-edges)))
+       (setq se-edges (car se-edges)))
+     (if (eq nw-edges se-edges)
+ 	nw-edges
+       (setq nw-edges (copy-sequence nw-edges))
+       (setcdr (nthcdr 1 nw-edges) (nthcdr 2 se-edges))
+       nw-edges )))
+ 
+ (defun tapestry-compute-map-width (map)
+   (let ((edges (tapestry-find-window-map-edges map)))
+     (- (nth 2 edges) (car edges))))
+ 
+ (defun tapestry-compute-map-height (map)
+   (let ((edges (tapestry-find-window-map-edges map)))
+     (- (nth 3 edges) (nth 1 edges))))
+ 
+ (defun tapestry-nullify-map-elements (map &optional buffer-file-name buffer-name
+ 					window-start window-point
+ 					window-hscroll selected-window)
+   (let (p)
+     (setq p (nth 1 map))
+     (while p
+       (and buffer-file-name (setcar (car p) nil))
+       (and buffer-name (setcar (cdr (car p)) nil))
+       (setq p (cdr p)))
+     (setq p (nth 2 map))
+     (while p
+       (and window-start (setcar (car p) nil))
+       (and window-point (setcar (cdr (car p)) nil))
+       (and window-hscroll (setcar (nthcdr 2 (car p)) nil))
+       (and selected-window (setcar (nthcdr 3 (car p)) nil))
+       (setq p (cdr p)))))
+ 
+ (defun tapestry-replace-map-element (map what function)
+   (let (mapi mapj p old new)
+     (cond ((eq what 'buffer-file-name)
+ 	   (setq mapi 1 mapj 0))
+ 	   ((eq what 'buffer-name)
+ 	    (setq mapi 1 mapj 1))
+ 	   ((eq what 'window-start)
+ 	    (setq mapi 2 mapj 0))
+ 	   ((eq what 'window-point)
+ 	    (setq mapi 2 mapj 1))
+ 	   ((eq what 'window-hscroll)
+ 	    (setq mapi 2 mapj 2))
+ 	   ((eq what 'selected-window)
+ 	    (setq mapi 2 mapj 3)))
+     (setq p (nth mapi map))
+     (while p
+       (setq old (nth mapj (car p))
+ 	    new (funcall function old))
+       (if (not (equal old new))
+ 	  (setcar (nthcdr mapj (car p)) new))
+       (setq p (cdr p)))))
*** README.dist	Mon Mar  2 00:04:34 1992
--- README	Wed Aug 25 01:18:32 1993
***************
*** 2,13 ****
  
  1) `make'.  `make all' if you want the Info document built as well.
  
! 2) Put the vm.elc files in a Lisp directory that Emacs knows
     about.  (see load-path).  You don't need to install the other
!    .elc files, only vm.elc.
  
! 3) Copy the file vm file into the Emacs' info directory under the
!    name "vm".  Edit the "dir" file in that directory and add a menu
!    entry for VM.
  
  Mail bug reports to bug-vm@uunet.uu.net or post them to gnu.emacs.vm.bug.
--- 2,13 ----
  
  1) `make'.  `make all' if you want the Info document built as well.
  
! 2) Put the vm.elc and tapestry.elc file in a Lisp directory that Emacs knows
     about.  (see load-path).  You don't need to install the other
!    .elc files, only vm.elc and tapestry.elc.
  
! 3) If you built the Info document, copy the file vm file into
!    the Emacs' info directory under the name "vm".  Edit the "dir"
!    file in that directory and add a menu entry for VM.
  
  Mail bug reports to bug-vm@uunet.uu.net or post them to gnu.emacs.vm.bug.