Commits

youngs  committed cc66d49

2001-07-26 Steve Youngs <youngs@xemacs.org>

* Sync with VM-6.95.

  • Participants
  • Parent commits 7bb3eea

Comments (0)

Files changed (13)

+2001-07-26  Steve Youngs  <youngs@xemacs.org>
+
+	* Sync with VM-6.95.
+
 2001-07-21  Steve Youngs  <youngs@xemacs.org>
 
 	* Sync with VM-6.94.

File vm-digest.el

 to find out how KEEP-LIST and DISCARD-REGEXP are used.
 
 If ALWAYS-USE-DIGEST is non-nil, always encapsulate for a multipart/digest.
-Otherwise if there are fewer than two messages to be encapsulated
+Otherwise if there is only one message to be encapsulated
 leave off the multipart boundary strings.  The caller is assumed to
 be using message/rfc822 or message/news encoding instead.
 
       (let ((target-buffer (current-buffer))
 	    (boundary-positions nil)
 	    (mlist message-list)
-	    (mime-keep-list (append keep-list vm-mime-header-list))
 	    (boundary nil)
 	    source-buffer m start n beg)
 	(save-restriction
 	    (vm-insert-region-from-buffer source-buffer (vm-headers-of m)
 					  (vm-text-end-of m))
 	    (goto-char beg)
-	    (vm-reorder-message-headers nil nil "\\(X-VM-\\|Status:\\)")
-	    (vm-reorder-message-headers
-	     nil (if (vm-mime-plain-message-p m)
-		     keep-list
-		   mime-keep-list)
-	     discard-regexp)
+	    ;; remove the Berkeley and VM status headers and sort
+	    ;; the MIME headers to the top of the message.
+	    (vm-reorder-message-headers nil vm-mime-header-list
+					"\\(X-VM-\\|Status:\\)")
+	    ;; skip past the MIME headers so that when the
+	    ;; user's header filters are applied they won't
+	    ;; remove the MIME headers.
+	    (while (and (vm-match-header) (looking-at vm-mime-header-regexp))
+	      (goto-char (vm-matched-header-end)))
+	    ;; apply the user's header filters.
+	    (vm-reorder-message-headers nil keep-list discard-regexp)
 	    (goto-char (point-max))
 	    (setq mlist (cdr mlist)))
 	  (if (and (< (length message-list) 2) (not always-use-digest))
 to find out how KEEP-LIST and DISCARD-REGEXP are used."
   (if message-list
       (let ((target-buffer (current-buffer))
-	    (mime-keep-list (append keep-list vm-mime-header-list))
 	    (mlist message-list)
 	    source-buffer m start n)
 	(save-restriction
 		    (insert-buffer-substring source-buffer (vm-headers-of m)
 					     (vm-text-end-of m))
 		    (goto-char beg)
-		    (vm-reorder-message-headers nil nil
+		    ;; remove the Berkeley and VM status headers and sort
+		    ;; the MIME headers to the top of the message.
+		    (vm-reorder-message-headers nil vm-mime-header-list
 						"\\(X-VM-\\|Status:\\)")
-		    (vm-reorder-message-headers
-		     nil (if (vm-mime-plain-message-p m)
-			     keep-list
-			   mime-keep-list)
-		     discard-regexp)
+		    ;; skip past the MIME headers so that when the
+		    ;; user's header filters are applied they won't
+		    ;; remove the MIME headers.
+		    (while (and (vm-match-header)
+				(looking-at vm-mime-header-regexp))
+		      (goto-char (vm-matched-header-end)))
+		    ;; apply the user's header filters.
+		    (vm-reorder-message-headers nil keep-list discard-regexp)
 		    (vm-rfc934-char-stuff-region beg (point-max))))))
 	    (goto-char (point-max))
 	    (insert "---------------")
 to find out how KEEP-LIST and DISCARD-REGEXP are used."
   (if message-list
       (let ((target-buffer (current-buffer))
-	    (mime-keep-list (append keep-list vm-mime-header-list))
 	    (mlist message-list)
 	    source-buffer m start)
 	(save-restriction
 		    (insert-buffer-substring source-buffer (vm-headers-of m)
 					     (vm-text-end-of m))
 		    (goto-char beg)
-		    (vm-reorder-message-headers nil nil
+		    ;; remove the Berkeley and VM status headers and sort
+		    ;; the MIME headers to the top of the message.
+		    (vm-reorder-message-headers nil vm-mime-header-list
 						"\\(X-VM-\\|Status:\\)")
-		    (vm-reorder-message-headers
-		     nil (if (vm-mime-plain-message-p m)
-			     keep-list
-			   mime-keep-list)
-		     discard-regexp)
+		    ;; skip past the MIME headers so that when the
+		    ;; user's header filters are applied they won't
+		    ;; remove the MIME headers.
+		    (while (and (vm-match-header)
+				(looking-at vm-mime-header-regexp))
+		      (goto-char (vm-matched-header-end)))
+		    ;; apply the user's header filters.
+		    (vm-reorder-message-headers nil keep-list discard-regexp)
 		    (vm-rfc1153-char-stuff-region beg (point-max))))))
 	    (goto-char (point-max))
 	    (insert "\n---------------")
       (save-restriction
 	(widen)
 	(goto-char (vm-text-of m))
-	(cond ((search-forward "\n----------------------------------------------------------------------\n" (vm-text-end-of m) t)
+	(cond ((and (search-forward "\n----------------------------------------------------------------------\n" (vm-text-end-of m) t)
+		    (search-forward "\n------------------------------\n" (vm-text-end-of m) t))
 	       "rfc1153")
 	      (t "rfc934"))))))
 

File vm-folder.el

 	    (goto-char (match-beginning 0))
 	    t )
 	nil )))
+   ((eq vm-folder-type 'baremessage)
+    (goto-char (point-max)))
    ((eq vm-folder-type 'babyl)
     (let ((reg1 "\014\n[01],")
 	  (case-fold-search nil))
 	    (forward-char -5)))))
    ((eq vm-folder-type 'mmdf)
     (vm-find-leading-message-separator))
+   ((eq vm-folder-type 'baremessage)
+    (goto-char (point-max)))
    ((eq vm-folder-type 'babyl)
     (vm-find-leading-message-separator)
     (forward-char -1))))
 	oldval)
     (while (and (not (input-pending-p)) b-list)
       (save-excursion
-	(set-buffer (car b-list))
-	(if (and (eq major-mode 'vm-mode)
-		 (setq found-one t)
-		 ;; to avoid reentrance into the pop and imap code
-		 (not vm-global-block-new-mail))
-	    (progn
-	      (setq oldval vm-spooled-mail-waiting)
-	      (setq vm-spooled-mail-waiting (vm-check-for-spooled-mail nil t))
-	      (if (not (eq oldval vm-spooled-mail-waiting))
-		  (progn
-		    (intern (buffer-name) vm-buffers-needing-display-update)
-		    (run-hooks 'vm-spooled-mail-waiting-hook))))))
+	(if (not (buffer-live-p (car b-list)))
+	    nil
+	  (set-buffer (car b-list))
+	  (if (and (eq major-mode 'vm-mode)
+		   (setq found-one t)
+		   ;; to avoid reentrance into the pop and imap code
+		   (not vm-global-block-new-mail))
+	      (progn
+		(setq oldval vm-spooled-mail-waiting)
+		(setq vm-spooled-mail-waiting (vm-check-for-spooled-mail nil t))
+		(if (not (eq oldval vm-spooled-mail-waiting))
+		    (progn
+		      (intern (buffer-name) vm-buffers-needing-display-update)
+		      (run-hooks 'vm-spooled-mail-waiting-hook)))))))
       (setq b-list (cdr b-list)))
     (vm-update-summary-and-mode-line)
     ;; make the timer go away if we didn't encounter a vm-mode buffer.
 	(found-one nil))
     (while (and (not (input-pending-p)) b-list)
       (save-excursion
-	(set-buffer (car b-list))
-	(if (and (eq major-mode 'vm-mode)
-		 (setq found-one t)
-		 (not (and (not (buffer-modified-p))
-			   buffer-file-name
-			   (file-newer-than-file-p
-			    (make-auto-save-file-name)
-			    buffer-file-name)))
-		 (not vm-global-block-new-mail)
-		 (not vm-folder-read-only)
-		 (vm-get-spooled-mail nil)
-		 (vm-assimilate-new-messages t))
-	    (progn
-	      ;; don't move the message pointer unless the folder
-	      ;; was empty.
-	      (if (and (null vm-message-pointer)
-		       (vm-thoughtfully-select-message))
-		  (vm-preview-current-message)
-		(vm-update-summary-and-mode-line)))))
+	(if (not (buffer-live-p (car b-list)))
+	    nil
+	  (set-buffer (car b-list))
+	  (if (and (eq major-mode 'vm-mode)
+		   (setq found-one t)
+		   (not (and (not (buffer-modified-p))
+			     buffer-file-name
+			     (file-newer-than-file-p
+			      (make-auto-save-file-name)
+			      buffer-file-name)))
+		   (not vm-global-block-new-mail)
+		   (not vm-folder-read-only)
+		   (vm-get-spooled-mail nil)
+		   (vm-assimilate-new-messages t))
+	      (progn
+		;; don't move the message pointer unless the folder
+		;; was empty.
+		(if (and (null vm-message-pointer)
+			 (vm-thoughtfully-select-message))
+		    (vm-preview-current-message)
+		  (vm-update-summary-and-mode-line))))))
       (setq b-list (cdr b-list)))
     ;; make the timer go away if we didn't encounter a vm-mode buffer.
     (if (and (not found-one) (null b-list))
     (let ((buf-list (buffer-list))
 	  (found-one nil))
       (while (and buf-list (not (input-pending-p)))
-	(set-buffer (car buf-list))
-	(cond ((and (eq major-mode 'vm-mode) vm-message-list)
-	       (setq found-one t)
-	       (if (not (eq vm-modification-counter
-			    vm-flushed-modification-counter))
-		   (progn
-		     (vm-stuff-last-modified)
-		     (vm-stuff-pop-retrieved)
-		     (vm-stuff-imap-retrieved)
-		     (vm-stuff-summary)
-		     (vm-stuff-labels)
-		     (and vm-message-order-changed
-			  (vm-stuff-message-order))
-		     (and (vm-stuff-folder-attributes t)
-			  (setq vm-flushed-modification-counter
-				vm-modification-counter))))))
+	(if (not (buffer-live-p (car buf-list)))
+	    nil
+	  (set-buffer (car buf-list))
+	  (cond ((and (eq major-mode 'vm-mode) vm-message-list)
+		 (setq found-one t)
+		 (if (not (eq vm-modification-counter
+			      vm-flushed-modification-counter))
+		     (progn
+		       (vm-stuff-last-modified)
+		       (vm-stuff-pop-retrieved)
+		       (vm-stuff-imap-retrieved)
+		       (vm-stuff-summary)
+		       (vm-stuff-labels)
+		       (and vm-message-order-changed
+			    (vm-stuff-message-order))
+		       (and (vm-stuff-folder-attributes t)
+			    (setq vm-flushed-modification-counter
+				  vm-modification-counter)))))))
 	(setq buf-list (cdr buf-list)))
       ;; if we haven't checked them all return non-nil so
       ;; the flusher won't give up trying.
 				(delete (list source-nopwd-nombox pass)
 					vm-imap-passwords))
 			  (message "IMAP password for %s incorrect" imapdrop)
-			  (sleep-for 2)
+			  ;; don't sleep unless we're running synchronously.
+			  (if vm-imap-ok-to-ask
+			      (sleep-for 2))
 			  (throw 'end-of-session nil))))
 		  ((equal auth "cram-md5")
 		   (let ((ipad (make-string 64 54))
 				  (delete (list source-nopwd-nombox pass)
 					  vm-imap-passwords))
 			    (message "IMAP password for %s incorrect" imapdrop)
-			    (sleep-for 2)
+			    ;; don't sleep unless we're running synchronously.
+			    (if vm-imap-ok-to-ask
+				(sleep-for 2))
 			    (throw 'end-of-session nil)))))
 		  ((equal auth "preauth")
 		   (if (not (eq greeting 'preauth))
 		       (progn
 			 (message "IMAP session was not pre-authenticated")
-			 (sleep-for 2)
+			 ;; don't sleep unless we're running synchronously.
+			 (if vm-imap-ok-to-ask
+			     (sleep-for 2))
 			 (throw 'end-of-session nil))))
 		  (t (error "Don't know how to authenticate using %s" auth)))
 	    (setq process-to-shutdown nil)
     (if need-msg
 	(vm-imap-protocol-error "FETCH OK sent before FETCH response"))
     ;; must make the read point a marker so that it stays fixed
-    ;; relative to the text and we modify things below.
+    ;; relative to the text when we modify things below.
     (setq vm-imap-read-point (point-marker))
     (vm-set-imap-stat-x-got statblob nil)
     (setq list (cdr (nth 3 fetch-response)))
 	  (goto-char start)
 	  (vm-skip-past-folder-header)))
     (insert (vm-leading-message-separator))
-    ;; this will not find the trailing message separator but
-    ;; for the Content-Length stuff counting from eob is
-    ;; the same thing in this case.
-    (vm-convert-folder-type-headers nil vm-folder-type)
+    (save-restriction
+      (narrow-to-region (point) end)
+      (vm-convert-folder-type-headers 'baremessage vm-folder-type))
     (goto-char end)
     (insert-before-markers (vm-trailing-message-separator))
     ;; Some IMAP servers don't understand Sun's stupid
 		    (vm-mime-insert-mime-body layout)
 		    (setq end (point-marker))
 		    (vm-mime-transfer-decode-region layout start end)))
-	     (setq suffix (vm-mime-extract-filename-suffix layout))
+	     (setq suffix (vm-mime-extract-filename-suffix layout)
+		   suffix (or suffix
+			      (vm-mime-find-filename-suffix-for-type layout)))
 	     (setq tempfile (vm-make-tempfile-name suffix))
 	     (let ((buffer-file-type buffer-file-type)
 		   (selective-display nil)
 	  (insert-char ?\n 1))
 	(setq e (vm-make-extent (1- (point)) (point)))
 	(vm-set-extent-property e 'begin-glyph g)
+	(vm-set-extent-property e 'start-open t)
 	t )))
 
 (defun vm-mime-display-internal-image-fsfemacs-xxxx (layout image-type name)
 	(setq suffix (substring filename (match-beginning 0) (match-end 0))))
     suffix ))
 
+(defun vm-mime-find-filename-suffix-for-type (layout)
+  (let ((type (car (vm-mm-layout-type layout)))
+	suffix
+	(alist vm-mime-attachment-auto-suffix-alist))
+    (while alist
+      (if (vm-mime-types-match (car (car alist)) type)
+	  (setq suffix (cdr (car alist))
+		alist nil)
+	(setq alist (cdr alist))))
+    suffix ))
+
 (defun vm-mime-attach-file (file type &optional charset description
 			    no-suggested-filename)
   "Attach a file to a VM composition buffer to be sent along with the message.
 it entirely with normal text editing commands.  If you remove the
 attachment tag, the attachment will not be sent.
 
-First argument, MESSAGE, is a VM message struct.  When called
-interactively a message number read.  The message will come from
-the parent folder of this composition.  If the composition has no
-parent, the name of a folder will be read from the minibuffer
-before the message number is read.
+First argument, MESSAGE, is either a VM message struct or a list
+of message structs.  When called interactively a message number is read
+from the minibuffer.  The message will come from the parent
+folder of this composition.  If the composition has no parent,
+the name of a folder will be read from the minibuffer before the
+message number is read.
 
 If this command is invoked with a prefix argument, the name of a
 folder is read and that folder is used instead of the parent
 folder of the composition.
 
+If this command is invoked on marked message (via
+`vm-next-command-uses-marks') the marked messages in the selected
+folder will be attached as a MIME message digest.
+
 Optional second argument DESCRIPTION is a one-line description of
 the message being attached.  This is also read from the
 minibuffer if the command is run interactively."
    (let ((last-command last-command)
 	 (this-command this-command)
 	 (result 0)
-	 mp default prompt description folder)
+	 mlist mp default prompt description folder)
      (if (null vm-send-using-mime)
 	 (error "MIME attachments disabled, set vm-send-using-mime non-nil to enable."))
      (cond ((or current-prefix-arg (null vm-mail-buffer)
 	    (let ((dir (if vm-folder-directory
 			   (expand-file-name vm-folder-directory)
 			 default-directory))
-		  file
-		  (last-command last-command)
-		  (this-command this-command))
-	      (setq file (read-file-name "Yank from folder: " dir nil t))
+		  file)
+	      (let ((last-command last-command)
+		    (this-command this-command))
+		(setq file (read-file-name "Yank from folder: " dir nil t)))
 	      (save-excursion
 		(set-buffer
 		 (let ((coding-system-for-read (vm-binary-coding-system)))
 		   (find-file-noselect file)))
 		(setq folder (current-buffer))
-		(vm-mode))))
+		(vm-mode)
+		(setq mlist (vm-select-marked-or-prefixed-messages 0)))))
 	   (t
-	    (setq folder vm-mail-buffer)))
-     (save-excursion
-       (set-buffer folder)
-       (setq default (and vm-message-pointer
-			  (vm-number-of (car vm-message-pointer)))
-	     prompt (if default
-			(format "Yank message number: (default %s) "
-				default)
-		      "Yank message number: "))
-       (while (zerop result)
-	 (setq result (read-string prompt))
-	 (and (string= result "") default (setq result default))
-	 (setq result (string-to-int result)))
-       (if (null (setq mp (nthcdr (1- result) vm-message-list)))
-	   (error "No such message.")))
+	    (setq folder vm-mail-buffer)
+	    (save-excursion
+	      (set-buffer folder)
+	      (setq mlist (vm-select-marked-or-prefixed-messages 0)))))
+     (if (null mlist)
+	 (save-excursion
+	   (set-buffer folder)
+	   (setq default (and vm-message-pointer
+			      (vm-number-of (car vm-message-pointer)))
+		 prompt (if default
+			    (format "Yank message number: (default %s) "
+				    default)
+			  "Yank message number: "))
+	   (while (zerop result)
+	     (setq result (read-string prompt))
+	     (and (string= result "") default (setq result default))
+	     (setq result (string-to-int result)))
+	   (if (null (setq mp (nthcdr (1- result) vm-message-list)))
+	       (error "No such message."))))
      (setq description (read-string "Description: "))
      (if (string-match "^[ \t]*$" description)
 	 (setq description nil))
-     (list (car mp) description)))
+     (list (or mlist (car mp)) description)))
   (if (null vm-send-using-mime)
       (error "MIME attachments disabled, set vm-send-using-mime non-nil to enable."))
-  (let* ((buf (generate-new-buffer "*attached message*"))
-	 (m (vm-real-message-of message))
-	 (folder (vm-buffer-of m)))
-    (save-excursion
-      (set-buffer buf)
-      (if vm-fsfemacs-mule-p
-	  (set-buffer-multibyte nil))
-      (vm-insert-region-from-buffer folder (vm-headers-of m)
-				    (vm-text-end-of m))
-      (goto-char (point-min))
-      (vm-reorder-message-headers nil nil "\\(X-VM-\\|Status:\\)"))
-    (and description (setq description
-			   (vm-mime-scrub-description description)))
-    (vm-mime-attach-object buf "message/rfc822" nil description nil)
-    (add-hook 'kill-buffer-hook
-	      (list 'lambda ()
-		    (list 'if (list 'eq (current-buffer) '(current-buffer))
-			  (list 'kill-buffer buf))))))
+  (if (not (consp message))
+      (let* ((buf (generate-new-buffer "*attached message*"))
+	     (m (vm-real-message-of message))
+	     (folder (vm-buffer-of m)))
+	(save-excursion
+	  (set-buffer buf)
+	  (if vm-fsfemacs-mule-p
+	      (set-buffer-multibyte nil))
+	  (vm-insert-region-from-buffer folder (vm-headers-of m)
+					(vm-text-end-of m))
+	  (goto-char (point-min))
+	  (vm-reorder-message-headers nil nil "\\(X-VM-\\|Status:\\)"))
+	(and description (setq description
+			       (vm-mime-scrub-description description)))
+	(vm-mime-attach-object buf "message/rfc822" nil description nil)
+	(add-hook 'kill-buffer-hook
+		  (list 'lambda ()
+			(list 'if (list 'eq (current-buffer) '(current-buffer))
+			      (list 'kill-buffer buf)))))
+    (let ((buf (generate-new-buffer "*attached messages*"))
+	  boundary)
+      (save-excursion
+	(set-buffer buf)
+	(setq boundary (vm-mime-encapsulate-messages
+			message vm-mime-digest-headers
+			vm-mime-digest-discard-header-regexp
+			t))
+	(goto-char (point-min))
+	(insert "MIME-Version: 1.0\n")
+	(insert (if vm-mime-avoid-folding-content-type
+		    "Content-Type: multipart/digest; boundary=\""
+		  "Content-Type: multipart/digest;\n\tboundary=\"")
+		boundary "\"\n")
+	(insert "Content-Transfer-Encoding: "
+		(vm-determine-proper-content-transfer-encoding
+		 (point)
+		 (point-max))
+		"\n\n"))
+      (and description (setq description
+			     (vm-mime-scrub-description description)))
+      (vm-mime-attach-object buf "multipart/digest"
+			     (list (concat "boundary=\""
+					   boundary "\"")) nil t)
+      (add-hook 'kill-buffer-hook
+		(list 'lambda ()
+		      (list 'if (list 'eq (current-buffer) '(current-buffer))
+			    (list 'kill-buffer buf)))))))
 
 (defun vm-mime-attach-object (object type params description mimed
 			      &optional no-suggested-filename)
 		(nth 1 (funcall vm-chop-full-name-function (car list)))
 	      (car list))
 	    sym-string (or sym-string "-unparseable-garbage-")
-	    sym (intern sym-string hashtable))
+	    sym (intern (if hack-addresses (downcase sym-string) sym-string)
+			hashtable))
       (if (boundp sym)
 	  (and all (setcar (symbol-value sym) nil))
 	(setq new-list (cons (car list) new-list))
 		  (error "%s failed: exited with code %s"
 			 vm-pop-md5-program retval)))
 	    (goto-char (point-min))
-	    (if (or (re-search-forward "[^0-9a-f\n]")
+	    (if (or (re-search-forward "[^0-9a-f\n]" nil t)
 		    (< (point-max) 32))
 		(error "%s produced bogus MD5 digest '%s'"
 		       vm-pop-md5-program 
 	   (save-excursion
 	     (goto-char (vm-text-of (car vm-message-pointer)))
 	     (forward-line (if (natnump vm-preview-lines) vm-preview-lines 0))
+	     ;; KLUDGE CITY: Under XEmacs, an extent's begin-glyph
+	     ;; will be displayed even if the extent is at the end
+	     ;; of a narrowed region.  Thus a message continaing
+	     ;; only an image will have the image displayed at
+	     ;; preview time even if vm-preview-lines is 0 provided
+	     ;; vm-mime-decode-for-preview is non-nil.  We kludge
+	     ;; a fix for this by moving everything on the preview
+	     ;; cutoff line one character forward, but only if
+	     ;; we're doing MIME decode for preview.
+	     (if (and vm-xemacs-p
+		      vm-mail-buffer ; in presentation buffer
+		      vm-auto-decode-mime-messages
+		      vm-mime-decode-for-preview
+		      ;; can't do the kludge unless we know that
+		      ;; when the message is exposed it will be
+		      ;; decoded and thereby remove the kludge.
+		      (not (vm-mime-plain-message-p (car vm-message-pointer))))
+		 (let ((buffer-read-only nil))
+		   (insert " ")
+		   (forward-char -1)))
 	     (point))))
 	 (t (vm-text-end-of (car vm-message-pointer))))))
 
 			       (delete (list source-nopwd pass)
 				       vm-pop-passwords))
 			 (message "POP password for %s incorrect" popdrop)
-			 (sleep-for 2)
+			 ;; don't sleep unless we're running synchronously.
+			 (if vm-pop-ok-to-ask
+			     (sleep-for 2))
 			 (throw 'done nil))))
 		  ((equal auth "rpop")
 		   (vm-pop-send-command process (format "USER %s" user))
 			 (goto-char (point-max))
    (insert-before-markers "<<< ooops, no timestamp found in greeting! >>>\n")
 			 (message "Server of %s does not support APOP" popdrop)
-			 (sleep-for 2)
+			 ;; don't sleep unless we're running synchronously
+			 (if vm-pop-ok-to-ask
+			     (sleep-for 2))
 			 (throw 'done nil)))
 		   (vm-pop-send-command
 		    process
 			       (delete (list source-nopwd pass)
 				       vm-pop-passwords))
 			 (message "POP password for %s incorrect" popdrop)
-			 (sleep-for 2)
+			 (if vm-pop-ok-to-ask
+			     (sleep-for 2))
 			 (throw 'done nil))))
 		  (t (error "Don't know how to authenticate using %s" auth)))
 	    (setq process-to-shutdown nil)
 		(goto-char start)
 		(vm-skip-past-folder-header)))
 	  (insert (vm-leading-message-separator))
-	  ;; this will not find the trailing message separator but
-	  ;; for the Content-Length stuff counting from eob is
-	  ;; the same thing in this case.
-	  (vm-convert-folder-type-headers nil vm-folder-type)
+	  (save-restriction
+	    (narrow-to-region (point) end)
+	    (vm-convert-folder-type-headers 'baremessage vm-folder-type))
 	  (goto-char end)
 	  (insert-before-markers (vm-trailing-message-separator))))
     ;; Set file type to binary for DOS/Windows.  I don't know if
       (and temp-buffer (kill-buffer temp-buffer)))))
 
 (defun vm-mail-mode-remove-tm-hooks ()
-  (make-local-hook 'mail-setup-hook)
-  (remove-hook 'mail-setup-hook 'mime/decode-message-header t)
-  (remove-hook 'mail-setup-hook 'mime/editor-mode t)
-  (make-local-hook 'mail-send-hook)
+  (remove-hook 'mail-setup-hook 'turn-on-mime-edit)
+  (remove-hook 'mail-setup-hook 'mime/decode-message-header)
+  (remove-hook 'mail-setup-hook 'mime/editor-mode)
+  (remove-hook 'mail-send-hook  'mime-edit-maybe-translate)
   (remove-hook 'mail-send-hook 'mime-editor/maybe-translate))
-
-(defvar mail-send-actions)
-
-(defun vm-compose-mail (&optional to subject other-headers continue
-		        switch-function yank-action
-			send-actions)
-  (interactive)
-  (vm-session-initialization)
-  (if continue
-      (vm-continue-composing-message)
-    (let ((buffer (vm-mail-internal
-		   (if to
-		       (format "message to %s"
-			       (vm-truncate-roman-string to 20))
-		     nil)
-		   to subject)))
-      (goto-char (point-min))
-      (re-search-forward (concat "^" mail-header-separator "$"))
-      (beginning-of-line)
-      (while other-headers
-	(insert (car (car other-headers)))
-	(while (eq (char-syntax (char-before (point))) ?\ )
-	  (delete-char -1))
-	(while (eq (char-before (point)) ?:)
-	  (delete-char -1))
-	(insert ": " (cdr (car other-headers)))
-	(if (not (eq (char-before (point)) ?\n))
-	    (insert "\n"))
-	(setq other-headers (cdr other-headers)))
-      (cond ((null to)
-	     (mail-position-on-field "To"))
-	    ((null subject)
-	     (mail-position-on-field "Subject"))
-	    (t
-	     (mail-text)))
-      (funcall (or switch-function (function switch-to-buffer))
-	       (current-buffer))
-      (if yank-action
-	  (apply (car yank-action) (cdr yank-action)))
-      (make-local-variable 'mail-send-actions)
-      (setq mail-send-actions send-actions))))

File vm-startup.el

 (defun vm-mode (&optional read-only)
   "Major mode for reading mail.
 
-This is VM 6.94.
+This is VM 6.95.
 
 Commands:
    h - summarize folder contents
 		(list this-command)))
   (vm-update-summary-and-mode-line))
 
+(defvar mail-send-actions)
+
+;;;###autoload
+(defun vm-compose-mail (&optional to subject other-headers continue
+		        switch-function yank-action
+			send-actions)
+  (interactive)
+  (vm-session-initialization)
+  (if continue
+      (vm-continue-composing-message)
+    (let ((buffer (vm-mail-internal
+		   (if to
+		       (format "message to %s"
+			       (vm-truncate-roman-string to 20))
+		     nil)
+		   to subject)))
+      (goto-char (point-min))
+      (re-search-forward (concat "^" mail-header-separator "$"))
+      (beginning-of-line)
+      (while other-headers
+	(insert (car (car other-headers)))
+	(while (eq (char-syntax (char-before (point))) ?\ )
+	  (delete-char -1))
+	(while (eq (char-before (point)) ?:)
+	  (delete-char -1))
+	(insert ": " (cdr (car other-headers)))
+	(if (not (eq (char-before (point)) ?\n))
+	    (insert "\n"))
+	(setq other-headers (cdr other-headers)))
+      (cond ((null to)
+	     (mail-position-on-field "To"))
+	    ((null subject)
+	     (mail-position-on-field "Subject"))
+	    (t
+	     (mail-text)))
+      (funcall (or switch-function (function switch-to-buffer))
+	       (current-buffer))
+      (if yank-action
+	  (apply (car yank-action) (cdr yank-action)))
+      (make-local-variable 'mail-send-actions)
+      (setq mail-send-actions send-actions))))
+
 ;;;###autoload
 (defun vm-submit-bug-report ()
   "Submit a bug report, with pertinent information to the VM bug list."

File vm-toolbar.el

 If the current folder looks out-of-date relative to its auto-save
 file then this button will run `recover-file'
 If there is mail waiting in one of the spool files associated
-with the current folder, this button will run `vm-get-new-mail'.
+with the current folder, and the `getmail' button is not on the
+toolbar, this button will run `vm-get-new-mail'.
 If the current message needs to be MIME decoded then this button
 will run 'vm-decode-mime-message'."])
 
   (cond ((vm-toolbar-can-recover-p)
 	 (setq vm-toolbar-helper-command 'recover-file
 	       vm-toolbar-helper-icon vm-toolbar-recover-icon))
-	((vm-toolbar-mail-waiting-p)
+	((and (vm-toolbar-mail-waiting-p)
+	      (not (memq 'getmail vm-use-toolbar)))
 	 (setq vm-toolbar-helper-command 'vm-get-new-mail
 	       vm-toolbar-helper-icon vm-toolbar-getmail-icon))
-	((and (vm-toolbar-can-decode-mime-p) (not vm-mime-decoded))
+	((and (vm-toolbar-can-decode-mime-p) (not vm-mime-decoded)
+	      (not (memq 'mime vm-use-toolbar)))
 	 (setq vm-toolbar-helper-command 'vm-decode-mime-message
 	       vm-toolbar-helper-icon vm-toolbar-decode-mime-icon))
 	(t
 Otherwise all headers are displayed except those matched by
 `vm-invisible-header-regexp'.  In this case `vm-visible-headers'
 specifies the order in which headers are displayed.  Headers not
-matching `vm-visible-headers' are display last.")
+matching `vm-visible-headers' are displayed last.")
 
 (defvar vm-invisible-header-regexp nil
   "*Non-nil value should be a regular expression that tells what headers
 application/octet-stream objects for display purposes if the
 value of `vm-infer-mime-types' is non-nil.")
 
+(defvar vm-mime-attachment-auto-suffix-alist
+  '(
+    ("image/jpeg"		.	".jpg")
+    ("image/gif"		.	".gif")
+    ("image/png"		.	".png")
+    ("text/html"		.	".html")
+    ("audio/basic"		.	".au")
+    ("video/mpeg"		.	".mpg")
+    ("video/quicktime"		.	".mov")
+    ("application/postscript"	.	".ps")
+    ("application/pdf"		.	".pdf")
+    ("application/vnd.ms.excel"	.	".xls")
+    ("application/mac-binhex40"	.	".hqx")
+    ("application/pdf"		.	".pdf")
+    ("application/zip"		.	".zip")
+)
+  "*Alist used to select a filename suffix for MIME object temporary files.
+The list format is 
+
+  ((TYPE . SUFFIX) ...)
+
+TYPE is a string specifying a MIME top-level type or a type/subtype pair.
+If a top-level type is listed without a subtype, all subtypes of
+that type are matched.
+
+SUFFIX is a string specifying the suffix that shoul be used for
+the accompanying type.
+
+When a MIME object is displayed using an external viewer VM must
+first write the object to a temporary file.  The external viewer
+opens and displays that file.  Some viewers will not open a file
+unless the filename ends with some extention that it recognizes
+such as '.html' or '.jpg'.  You can use this variable to map MIME
+types to extensions that your external viewers will recognize.  VM
+will search the list for a matching type.  The suffix assocaited
+with the first type that matches will be used.")
+
 (defvar vm-mime-max-message-size nil
   "*Largest MIME message that VM should send without fragmentation.
 The value should be an integer which specifies the size in bytes.
 Nil means don't move the mouse cursor.")
 
 (defvar vm-url-retrieval-methods '(lynx wget url-w3)
-  "*Non-mil value specifies how VM is permitted to retrieve URLs.
+  "*Non-nil value specifies how VM is permitted to retrieve URLs.
 VM needs to do this when supporting the message/external-body
 MIME type, which provides a reference to an object instead of the
 object itself.  The specification should be a list of symbols
 (defvar vm-folder-garbage-alist nil)
 (make-variable-buffer-local 'vm-folder-garbage-alist)
 (defconst vm-mime-header-list '("MIME-Version:" "Content-"))
-
+(defconst vm-mime-header-regexp "\\(MIME-Version:\\|Content-\\)")
 (defconst vm-mime-mule-charset-to-coding-alist
   (cond (vm-fsfemacs-mule-p
 	 (let ((coding-systems (coding-system-list))

File vm-version.el

 
 (provide 'vm-version)
 
-(defconst vm-version "6.94"
+(defconst vm-version "6.95"
   "Version number of VM.")
 
 (defun vm-version ()