--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/vm/vm-virtual.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,642 @@
+;;; Virtual folders for VM
+;;; Copyright (C) 1990, 1993, 1994, 1995 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.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(provide 'vm-virtual)
+
+;; This function builds the virtual message list.
+;;
+;; If the new-messages argument is nil, the message list is
+;; derived from the folders listed in the virtual folder
+;; definition and selected by the various selectors.  The
+;; resulting message list is assigned to vm-message-list.
+;;
+;; If new-messages is non-nil then it is a list of messages to be
+;; tried against the selector parts of the virtual folder
+;; definition.  Matching messages are added to
+;; vm-message-list, instead of replacing it.
+;;
+;; The messages in new-messages must all be in the same real folder.
+(defun vm-build-virtual-message-list (new-messages)
+  (let ((clauses (cdr vm-virtual-folder-definition))
+
+	(message-set (make-vector 311 0))
+	(vbuffer (current-buffer))
+	(mirrored vm-virtual-mirror)
+	(case-fold-search t)
+	(tail-cons (vm-last vm-message-list))
+	(new-message-list nil)
+
+	;; selectors
+	(any 'vm-vs-any)
+	(and 'vm-vs-and)
+	(or 'vm-vs-or)
+	(not 'vm-vs-not)
+	(header 'vm-vs-header)
+	(label 'vm-vs-label)
+	(text 'vm-vs-text)
+	(recipient 'vm-vs-recipient)
+	(author 'vm-vs-author)
+	(subject 'vm-vs-subject)
+	(sent-before 'vm-vs-sent-before)
+	(sent-after 'vm-vs-sent-after)
+	(more-chars-than 'vm-vs-more-chars-than)
+	(less-chars-than 'vm-vs-less-chars-than)
+	(more-lines-than 'vm-vs-more-lines-than)
+	(less-lines-than 'vm-vs-less-lines-than)
+	(new 'vm-vs-new)
+	(unread 'vm-vs-unread)
+	(read 'vm-vs-read)
+	(deleted 'vm-vs-deleted)
+	(replied 'vm-vs-replied)
+	(forwarded 'vm-vs-forwarded)
+	(filed 'vm-vs-filed)
+	(written 'vm-vs-written)
+	(edited 'vm-vs-edited)
+	(marked 'vm-vs-marked)
+
+	virtual location-vector
+	message mp folders folder
+	selectors sel-list selector arglist i
+	real-buffers-used)
+    ;; Since there is at most one virtual message in the folder
+    ;; buffer of a virtual folder, the location data vector (and
+    ;; the markers in it) of all virtual messages in a virtual
+    ;; folder is shared.  We initialize the vector here if it
+    ;; hasn't been created already.
+    (if vm-message-list
+	(setq location-vector (vm-location-data-of (car vm-message-pointer)))
+      (setq i 0
+	    location-vector (make-vector vm-location-data-vector-length nil))
+      (while (< i vm-location-data-vector-length)
+	(aset location-vector i (vm-marker nil))
+	(vm-increment i)))
+    ;; To keep track of the messages in a virtual folder to
+    ;; prevent duplicates we create and maintain a set that
+    ;; contain all the real messages.
+    (setq mp vm-message-list)
+    (while mp
+      (intern (vm-message-id-number-of (vm-real-message-of (car mp)))
+	      message-set)
+      (setq mp (cdr mp)))
+    ;; now select the messages
+    (save-excursion
+      (while clauses
+	(setq folders (car (car clauses))
+	      selectors (cdr (car clauses)))
+	(while folders
+	  (setq folder (car folders))
+	  (and (stringp folder)
+	       (setq folder (expand-file-name folder vm-folder-directory)))
+	  (and (listp folder)
+	       (setq folder (eval folder)))
+	  (cond
+	   ((null folder)
+	    ;; folder was a s-expr which returned nil
+	    ;; skip it
+	    nil )
+	   ((and (stringp folder) (file-directory-p folder))
+	    (setq folders (nconc folders
+				 (vm-delete-backup-file-names
+				  (vm-delete-auto-save-file-names
+				   (vm-delete-directory-file-names
+				    (directory-files folder t nil)))))))
+	   ((or (null new-messages)
+		;; If we're assimilating messages into an
+		;; existing virtual folder, only allow selectors
+		;; that would be normally applied to this folder.
+		(and (bufferp folder)
+		     (eq (vm-buffer-of (car new-messages)) folder))
+		(and (stringp folder)
+		     (eq (vm-buffer-of (car new-messages))
+			 ;; letter bomb protection
+			 ;; set inhibit-local-variables to t for v18 Emacses
+			 ;; set enable-local-variables to nil for newer Emacses
+			 (let ((inhibit-local-variables t)
+			       (enable-local-variables nil))
+			   (find-file-noselect folder)))))
+	    (set-buffer (or (and (bufferp folder) folder)
+			    (vm-get-file-buffer folder)
+			    (find-file-noselect folder)))
+	    (if (eq major-mode 'vm-virtual-mode)
+		(setq virtual t
+		      real-buffers-used
+		      (append vm-real-buffers real-buffers-used))
+	      (setq virtual nil)
+	      (if (not (memq (current-buffer) real-buffers-used))
+		  (setq real-buffers-used (cons (current-buffer)
+						real-buffers-used)))
+	      (if (not (eq major-mode 'vm-mode))
+		  (vm-mode)))
+	    ;; change (sexpr) into ("/file" "/file2" ...)
+	    ;; this assumes that there will never be (sexpr sexpr2)
+	    ;; in a virtual folder spec.
+	    (if (bufferp folder)
+		(if virtual
+		    (setcar (car clauses)
+			    (delq nil
+				  (mapcar 'buffer-file-name vm-real-buffers)))
+		  (if buffer-file-name
+		      (setcar (car clauses) (list buffer-file-name)))))
+	    ;; if new-messages non-nil use it instead of the
+	    ;; whole message list
+	    (setq mp (or new-messages vm-message-list))
+	    (while mp
+	      (if (and (not (intern-soft
+			     (vm-message-id-number-of
+			      (vm-real-message-of (car mp)))
+			     message-set))
+		       (if virtual
+			   (save-excursion
+			     (set-buffer
+			      (vm-buffer-of
+			       (vm-real-message-of
+				(car mp))))
+			     (apply 'vm-vs-or (vm-real-message-of (car mp))
+				    selectors))
+			 (apply 'vm-vs-or (car mp) selectors)))
+		  (progn
+		    (intern
+		     (vm-message-id-number-of
+		      (vm-real-message-of (car mp)))
+		      message-set)
+		    (setq message (copy-sequence
+				   (vm-real-message-of (car mp))))
+		    (if mirrored
+			()
+		      (vm-set-mirror-data-of
+		       message
+		       (make-vector vm-mirror-data-vector-length nil))
+		      (vm-set-virtual-messages-sym-of
+		       message (make-symbol "<v>"))
+		      (vm-set-virtual-messages-of message nil)
+		      (vm-set-attributes-of
+		       message
+		       (make-vector vm-attributes-vector-length nil)))
+		    (vm-set-location-data-of message location-vector)
+		    (vm-set-softdata-of
+		     message
+		     (make-vector vm-softdata-vector-length nil))
+		    (vm-set-real-message-sym-of
+		     message
+		     (vm-real-message-sym-of (car mp)))
+		    (vm-set-message-type-of message vm-folder-type)
+		    (vm-set-message-id-number-of message
+						 vm-message-id-number)
+		    (vm-increment vm-message-id-number)
+		    (vm-set-buffer-of message vbuffer)
+		    (vm-set-reverse-link-sym-of message (make-symbol "<--"))
+		    (vm-set-reverse-link-of message tail-cons)
+		    (if (null tail-cons)
+			(setq new-message-list (list message)
+			      tail-cons new-message-list)
+		      (setcdr tail-cons (list message))
+		      (if (null new-message-list)
+			  (setq new-message-list (cdr tail-cons)))
+		      (setq tail-cons (cdr tail-cons)))))
+	      (setq mp (cdr mp)))))
+	  (setq folders (cdr folders)))
+	(setq clauses (cdr clauses))))
+; this doesn't need to work currently, but it might someday
+;    (if virtual
+;	(setq real-buffers-used (vm-delete-duplicates real-buffers-used)))
+    (vm-increment vm-modification-counter)
+    ;; Until this point the user doesn't really have a virtual
+    ;; folder, as the virtual messages 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 t))
+      (if (null vm-real-buffers)
+	  (setq vm-real-buffers real-buffers-used))
+      (save-excursion
+	(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))))
+      (setq mp new-message-list)
+      (while mp
+	(vm-set-virtual-messages-of
+	 (vm-real-message-of (car mp))
+	 (cons (car mp) (vm-virtual-messages-of (car mp))))
+	(setq mp (cdr mp)))
+      (if vm-message-list
+	  (progn
+	    (vm-set-summary-redo-start-point new-message-list)
+	    (vm-set-numbering-redo-start-point new-message-list))
+	(vm-set-summary-redo-start-point t)
+	(vm-set-numbering-redo-start-point t)
+	(setq vm-message-list new-message-list)))))
+
+(defun vm-create-virtual-folder (selector &optional arg read-only)
+  "Create a new virtual folder from messages in the current folder.
+The messages will be chosen by applying the selector you specify,
+which is normally read from the minibuffer.
+
+Prefix arg means the new virtual folder should be visited read only."
+  (interactive
+   (let ((last-command last-command)
+	 (this-command this-command)
+	 (prefix current-prefix-arg))
+     (vm-select-folder-buffer)
+     (nconc (vm-read-virtual-selector "Create virtual folder of messages: ")
+	    (list prefix))))
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-empty)
+  (let (vm-virtual-folder-alist name)
+    (if arg
+	(setq name (format "%s %s %s" (buffer-name) selector arg))
+      (setq name (format "%s %s" (buffer-name) selector)))
+    (setq vm-virtual-folder-alist
+	  (list
+	   (list name
+		 (list (list (list 'get-buffer (buffer-name)))
+		       (if arg (list selector arg) (list selector))))))
+    (vm-visit-virtual-folder name read-only)))
+
+(defun vm-apply-virtual-folder (name &optional read-only)
+  "Apply the selectors of a named virtual folder to the current folder
+and create a virtual folder containing the selected messages.
+
+Prefix arg means the new virtual folder should be visited read only."
+  (interactive
+   (let ((last-command last-command)
+	 (this-command this-command))
+     (list
+      (completing-read "Apply this virtual folder's selectors: "
+		       vm-virtual-folder-alist nil t)
+      current-prefix-arg)))
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-empty)
+  (let ((vfolder (assoc name vm-virtual-folder-alist))
+	clauses vm-virtual-folder-alist)
+    (or vfolder (error "No such virtual folder, %s" name))
+    (setq vfolder (vm-copy vfolder))
+    (setq clauses (cdr vfolder))
+    (while clauses
+      (setcar (car clauses) (list (list 'get-buffer (buffer-name))))
+      (setq clauses (cdr clauses)))
+    (setcar vfolder (format "%s/%s" (buffer-name) (car vfolder)))
+    (setq vm-virtual-folder-alist (list vfolder))
+    (vm-visit-virtual-folder (car vfolder) read-only)))
+
+(defun vm-toggle-virtual-mirror ()
+  (interactive)
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (if (not (eq major-mode 'vm-virtual-mode))
+      (error "This is not a virtual folder."))
+  (let ((mp vm-message-list)
+	(inhibit-quit t)
+	modified undo-list)
+    (setq undo-list vm-saved-undo-record-list
+	  vm-saved-undo-record-list vm-undo-record-list
+	  vm-undo-record-list undo-list
+	  vm-undo-record-pointer undo-list)
+    (setq modified vm-saved-buffer-modified-p
+	  vm-saved-buffer-modified-p (buffer-modified-p))
+    (set-buffer-modified-p modified)
+    (if vm-virtual-mirror
+	(while mp
+	  (vm-set-attributes-of
+	   (car mp) (or (vm-saved-virtual-attributes-of (car mp))
+			(make-vector vm-attributes-vector-length nil)))
+	  (vm-set-mirror-data-of
+	   (car mp) (or (vm-saved-virtual-mirror-data-of (car mp))
+			(make-vector vm-mirror-data-vector-length nil)))
+	  (vm-mark-for-summary-update (car mp) t)
+	  (setq mp (cdr mp)))
+      (while mp
+	;; mark for summary update _before_ we set this message to
+	;; be mirrored.  this will prevent the real message and
+	;; the other messages that will share attributes with
+	;; this message from having their summaries
+	;; updated... they don't need it.
+	(vm-mark-for-summary-update (car mp) t)
+	(vm-set-saved-virtual-attributes-of
+	 (car mp) (vm-attributes-of (car mp)))
+	(vm-set-saved-virtual-mirror-data-of
+	 (car mp) (vm-mirror-data-of (car mp)))
+	(vm-set-attributes-of
+	 (car mp) (vm-attributes-of (vm-real-message-of (car mp))))
+	(vm-set-mirror-data-of
+	 (car mp) (vm-mirror-data-of (vm-real-message-of (car mp))))
+	(setq mp (cdr mp))))
+    (setq vm-virtual-mirror (not vm-virtual-mirror))
+    (vm-increment vm-modification-counter))
+  (vm-update-summary-and-mode-line)
+  (message "Virtual folder now %s the underlying real folder%s."
+	   (if vm-virtual-mirror "mirrors" "does not mirror")
+	   (if (cdr vm-real-buffers) "s" "")))
+
+(defun vm-virtual-help ()
+  (interactive)
+  (vm-display nil nil '(vm-virtual-help) '(vm-virtual-help))
+  (message "VV = visit, VA = apply selectors, VC = create, VM = toggle virtual mirror"))
+
+(defun vm-delete-directory-file-names (list)
+  (vm-delete 'file-directory-p list))
+
+(defun vm-delete-backup-file-names (list)
+  (vm-delete 'backup-file-name-p list))
+
+(defun vm-delete-auto-save-file-names (list)
+  (vm-delete 'auto-save-file-name-p list))
+
+(defun vm-vs-or (m &rest selectors)
+  (let ((result nil) selector arglist)
+    (while selectors
+      (setq selector (car (car selectors))
+	    arglist (cdr (car selectors))
+	    result (apply (symbol-value selector) m arglist)
+	    selectors (if result nil (cdr selectors))))
+    result ))
+
+(defun vm-vs-and (m &rest selectors)
+  (let ((result t) selector arglist)
+    (while selectors
+      (setq selector (car (car selectors))
+	    arglist (cdr (car selectors))
+	    result (apply (symbol-value selector) m arglist)
+	    selectors (if (null result) nil (cdr selectors))))
+    result ))
+
+(defun vm-vs-not (m arg)
+  (let ((selector (car arg))
+	(arglist (cdr arg)))
+    (not (apply (symbol-value selector) m arglist))))
+
+(defun vm-vs-any (m) t)
+
+(defun vm-vs-author (m arg)
+  (or (string-match arg (vm-su-full-name m))
+      (string-match arg (vm-su-from m))))
+
+(defun vm-vs-recipient (m arg)
+  (or (string-match arg (vm-su-to m))
+      (string-match arg (vm-su-to-names m))))
+
+(defun vm-vs-subject (m arg)
+  (string-match arg (vm-su-subject m)))
+
+(defun vm-vs-sent-before (m arg)
+  (string< (vm-so-sortable-datestring m) (vm-timezone-make-date-sortable arg)))
+
+(defun vm-vs-sent-after (m arg)
+  (string< (vm-timezone-make-date-sortable arg) (vm-so-sortable-datestring m)))
+
+(defun vm-vs-header (m arg)
+  (save-excursion
+    (save-restriction
+      (widen)
+      (goto-char (vm-headers-of m))
+      (re-search-forward arg (vm-text-of m) t))))
+
+(defun vm-vs-label (m arg)
+  (vm-member arg (vm-labels-of m)))
+
+(defun vm-vs-text (m arg)
+  (save-excursion
+    (save-restriction
+      (widen)
+      (goto-char (vm-text-of m))
+      (re-search-forward arg (vm-text-end-of m) t))))
+
+(defun vm-vs-more-chars-than (m arg)
+  (> (string-to-int (vm-su-byte-count m)) arg))
+
+(defun vm-vs-less-chars-than (m arg)
+  (< (string-to-int (vm-su-byte-count m)) arg))
+
+(defun vm-vs-more-lines-than (m arg)
+  (> (string-to-int (vm-su-line-count m)) arg))
+
+(defun vm-vs-less-lines-than (m arg)
+  (< (string-to-int (vm-su-line-count m)) arg))
+
+(defun vm-vs-new (m) (vm-new-flag m))
+(defun vm-vs-unread (m) (vm-unread-flag m))
+(defun vm-vs-read (m) (not (or (vm-new-flag m) (vm-unread-flag m))))
+(defun vm-vs-deleted (m) (vm-deleted-flag m))
+(defun vm-vs-replied (m) (vm-replied-flag m))
+(defun vm-vs-forwarded (m) (vm-forwarded-flag m))
+(defun vm-vs-filed (m) (vm-filed-flag m))
+(defun vm-vs-written (m) (vm-written-flag m))
+(defun vm-vs-marked (m) (vm-mark-of m))
+(defun vm-vs-edited (m) (vm-edited-flag m))
+
+(put 'header 'vm-virtual-selector-clause "with header matching")
+(put 'label 'vm-virtual-selector-clause "with label of")
+(put 'text 'vm-virtual-selector-clause "with text matching")
+(put 'recipient 'vm-virtual-selector-clause "with recipient matching")
+(put 'author 'vm-virtual-selector-clause "with author matching")
+(put 'subject 'vm-virtual-selector-clause "with subject matching")
+(put 'sent-before 'vm-virtual-selector-clause "sent before")
+(put 'sent-after 'vm-virtual-selector-clause "sent after")
+(put 'more-chars-than 'vm-virtual-selector-clause
+     "with more characters than")
+(put 'less-chars-than 'vm-virtual-selector-clause
+     "with less characters than")
+(put 'more-lines-than 'vm-virtual-selector-clause "with more lines than")
+(put 'less-lines-than 'vm-virtual-selector-clause "with less lines than")
+
+(defun vm-read-virtual-selector (prompt)
+  (let (selector (arg nil))
+    (setq selector
+	  (vm-read-string prompt vm-supported-interactive-virtual-selectors)
+	  selector (intern selector))
+    (if (memq selector '(header label text recipient
+			 author subject
+			 sent-before sent-after
+			 more-chars-than more-lines-than
+			 less-chars-than less-lines-than))
+	(progn
+	  (setq prompt (concat (substring prompt 0 -2) " "
+			       (get selector 'vm-virtual-selector-clause)
+			       ": "))
+	  (cond ((memq selector '(more-chars-than more-lines-than
+			          less-chars-than less-lines-than))
+		 (setq arg (vm-read-number prompt)))
+		((eq selector 'label)
+		 (let ((vm-completion-auto-correct nil)
+		       (completion-ignore-case t))
+		   (setq arg (downcase
+			      (vm-read-string
+			       prompt
+			       (vm-obarray-to-string-list
+				vm-label-obarray)
+			       nil)))))
+		(t (setq arg (read-string prompt))))))
+    (list selector arg)))
+
+;; clear away links between real and virtual folders when
+;; a vm-quit is performed in either type folder.
+(defun vm-virtual-quit ()
+  (save-excursion
+    (cond ((eq major-mode 'vm-virtual-mode)
+	   ;; don't trust blindly, user might have killed some of
+	   ;; these buffers.
+	   (setq vm-real-buffers (vm-delete 'buffer-name vm-real-buffers t))
+	   (let ((bp vm-real-buffers)
+		 (mp vm-message-list)
+		 (b (current-buffer))
+		 ;; lock out interrupts here
+		 (inhibit-quit t))
+	     (while bp
+	       (set-buffer (car bp))
+	       (setq vm-virtual-buffers (delq b vm-virtual-buffers)
+		     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)))))
+	  ((eq major-mode 'vm-mode)
+	   ;; don't trust blindly, user might have killed some of
+	   ;; these buffers.
+	   (setq vm-virtual-buffers
+		 (vm-delete 'buffer-name vm-virtual-buffers t))
+	   (let ((bp vm-virtual-buffers)
+		 (mp vm-message-list)
+		 vmp
+		 (b (current-buffer))
+		 ;; lock out interrupts here
+		 (inhibit-quit t))
+	     (while mp
+	       (setq vmp (vm-virtual-messages-of (car mp)))
+	       (while vmp
+		 ;; we'll clear these messages from the virtual
+		 ;; folder by looking for messages that have a "Q"
+		 ;; id number associated with them.
+		 (vm-set-message-id-number-of (car vmp) "Q")
+		 (setq vmp (cdr vmp)))
+	       (vm-set-virtual-messages-of (car mp) nil)
+	       (setq mp (cdr mp)))
+	     (while bp
+	       (set-buffer (car bp))
+	       (setq vm-real-buffers (delq b vm-real-buffers))
+	       ;; set the message pointer to a new value if it is
+	       ;; now invalid.
+	       (setq vmp vm-message-pointer)
+	       (while (and vm-message-pointer
+			   (equal "Q" (vm-message-id-number-of
+				       (car vm-message-pointer))))
+		 (setq vm-message-pointer
+		       (cdr vm-message-pointer)))
+	       ;; if there were no good messages ahead, try going
+	       ;; backward.
+	       (if (null vm-message-pointer)
+		   (progn
+		     (setq vm-message-pointer vmp)
+		     (while (and vm-message-pointer
+				 (equal "Q" (vm-message-id-number-of
+					     (car vm-message-pointer))))
+		       (setq vm-message-pointer
+			     (vm-reverse-link-of (car vm-message-pointer))))))
+	       ;; expunge the virtual messages associated with
+	       ;; real messages that are going away.
+	       (setq vm-message-list
+		     (vm-delete (function
+				 (lambda (m)
+				   (equal "Q" (vm-message-id-number-of m))))
+				vm-message-list nil))
+	       (if (null vm-message-pointer)
+		   (setq vm-message-pointer vm-message-list))
+	       ;; same for vm-last-message-pointer
+	       (if (null vm-last-message-pointer)
+		   (setq vm-last-message-pointer nil))
+	       (vm-clear-virtual-quit-invalidated-undos)
+	       (vm-reverse-link-messages)
+	       (vm-set-numbering-redo-start-point t)
+	       (vm-set-summary-redo-start-point t)
+	       (if vm-message-pointer
+		   (vm-preview-current-message)
+		 (vm-update-summary-and-mode-line))
+	       (setq bp (cdr bp))))))))
+
+(defun vm-virtual-save-folder (prefix)
+  (save-excursion
+    ;; don't trust blindly, user might have killed some of
+    ;; these buffers.
+    (setq vm-real-buffers (vm-delete 'buffer-name vm-real-buffers t))
+    (let ((bp vm-real-buffers))
+      (while bp
+	(set-buffer (car bp))
+	(vm-save-folder prefix)
+	(setq bp (cdr bp)))))
+  (vm-set-buffer-modified-p nil)
+  (vm-clear-modification-flag-undos)
+  (vm-update-summary-and-mode-line))
+
+(defun vm-virtual-get-new-mail ()
+  (save-excursion
+    ;; don't trust blindly, user might have killed some of
+    ;; these buffers.
+    (setq vm-real-buffers (vm-delete 'buffer-name vm-real-buffers t))
+    (let ((bp vm-real-buffers))
+      (while bp
+	(set-buffer (car bp))
+	(condition-case error-data
+	    (vm-get-new-mail)
+	  (folder-read-only
+	   (message "Folder is read only: %s"
+		    (or buffer-file-name (buffer-name)))
+	   (sit-for 1))
+	  (unrecognized-folder-type
+	   (message "Folder type is unrecognized: %s"
+		    (or buffer-file-name (buffer-name)))
+	   (sit-for 1)))
+	(setq bp (cdr bp)))))
+  (vm-emit-totals-blurb))
+
+(defun vm-make-virtual-copy (m)
+  (widen)
+  (let ((virtual-buffer (current-buffer))
+	(real-m (vm-real-message-of m))
+	(buffer-read-only nil)
+	(modified (buffer-modified-p)))
+    (unwind-protect
+	(save-excursion
+	  (set-buffer (vm-buffer-of real-m))
+	  (save-restriction
+	    (widen)
+	    ;; must reference this now so that headers will be in
+	    ;; their final position before the message is copied.
+	    ;; otherwise the vheader offset computed below will be wrong.
+	    (vm-vheaders-of real-m)
+	    (copy-to-buffer virtual-buffer (vm-start-of real-m)
+			    (vm-end-of real-m))))
+      (set-buffer-modified-p modified))
+    (set-marker (vm-start-of m) (point-min))
+    (set-marker (vm-headers-of m) (+ (vm-start-of m)
+				     (- (vm-headers-of real-m)
+					(vm-start-of real-m))))
+    (set-marker (vm-vheaders-of m) (+ (vm-start-of m)
+				      (- (vm-vheaders-of real-m)
+					 (vm-start-of real-m))))
+    (set-marker (vm-text-of m) (+ (vm-start-of m) (- (vm-text-of real-m)
+						     (vm-start-of real-m))))
+    (set-marker (vm-text-end-of m) (+ (vm-start-of m)
+				      (- (vm-text-end-of real-m)
+					 (vm-start-of real-m))))
+    (set-marker (vm-end-of m) (+ (vm-start-of m) (- (vm-end-of real-m)
+						    (vm-start-of real-m))))))