Commits

Anonymous committed 7bb3eea

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

* Sync with VM-6.94.

And increment the version of a couple of Makefiles.

  • Participants
  • Parent commits dbee24b

Comments (0)

Files changed (19)

+2001-07-21  Steve Youngs  <youngs@xemacs.org>
+
+	* Sync with VM-6.94.
+
 2001-05-11  Ben Wing  <ben@xemacs.org>
 
 	* Makefile (binkit):
 # the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 # Boston, MA 02111-1307, USA.
 
-VERSION = 6.92
-AUTHOR_VERSION = 6.92
+VERSION = 6.94
+AUTHOR_VERSION = 6.94
 MAINTAINER = XEmacs Development Team <xemacs-beta@xemacs.org>
 PACKAGE = vm
 PKG_TYPE = regular
 	       (if (not
 		    (save-excursion
 		      (save-match-data
-			(skip-chars-forward "\n")
+			;; People who roll digests often think
+			;; any old format will do.  Adding blank
+			;; lines after teh message separator is
+			;; common.  Spaces on such lines are an
+			;; added delight.
+			(skip-chars-forward " \n")
 			(or (and (vm-match-header)
 				 (vm-digest-get-header-contents "From"))
 			    (not (re-search-forward separator-regexp
 	     ;; enable-local-variables == nil disables them for newer Emacses
 	     (let ((inhibit-local-variables t)
 		   (enable-local-variables nil)
+		   (enable-local-eval nil)
 		   (coding-system-for-read (vm-line-ending-coding-system)))
 	       (find-file-noselect crash-box)))
        (if (eq (current-buffer) crash-buf)
   (setq use-dialog-box nil)
   ;; mail folders are precious.  protect them by default.
   (make-local-variable 'file-precious-flag)
-  (setq file-precious-flag t)
+  (setq file-precious-flag vm-folder-file-precious-flag)
   ;; scroll in place messes with scroll-up and this loses
   (make-local-variable 'scroll-in-place)
   (setq scroll-in-place nil)
 			  (message "IMAP password for %s incorrect" imapdrop)
 			  (sleep-for 2)
 			  (throw 'end-of-session nil))))
+		  ((equal auth "cram-md5")
+		   (let ((ipad (make-string 64 54))
+			 (opad (make-string 64 92))
+			 (command "AUTHENTICATE CRAM-MD5")
+			 (secret (concat
+				  pass (make-string (- 64 (length pass)) 0)))
+			 response p challenge answer)
+		     (vm-imap-send-command process command)
+		     (setq response (vm-imap-read-response process))
+		     (if (vm-imap-response-matches response 'VM 'NO)
+			 (error "server said NO to %s" command))
+		     (if (vm-imap-response-matches response 'VM 'BAD)
+			 (vm-imap-protocol-error "server said BAD to %s"
+						 command))
+		     (cond ((vm-imap-response-matches response '+ 'atom)
+			    (setq p (cdr (nth 1 response))
+				  challenge (buffer-substring
+					     (nth 0 p)
+					     (nth 1 p))
+				  challenge (vm-mime-base64-decode-string
+					     challenge)))
+			   (t
+			    (error "Don't understand AUTHENTICATE response")))
+		     (setq answer
+			   (concat
+			    user " "
+			    (vm-md5-string
+			     (concat
+			      (vm-xor-string secret opad)
+			      (vm-md5-raw-string 
+			       (concat
+				(vm-xor-string secret ipad) challenge)))))
+			   answer (vm-mime-base64-encode-string answer))
+		     (vm-imap-send-command process answer)
+		     (and (null (vm-imap-read-ok-response process))
+			  (progn
+			    (setq vm-imap-passwords
+				  (delete (list source-nopwd-nombox pass)
+					  vm-imap-passwords))
+			    (message "IMAP password for %s incorrect" imapdrop)
+			    (sleep-for 2)
+			    (throw 'end-of-session nil)))))
 		  ((equal auth "preauth")
 		   (if (not (eq greeting 'preauth))
 		       (progn
 	     'vm-mime-display-body-as-text) t]
 	   ["Display using External Viewer"
 	    (vm-mime-run-display-function-at-point
-	     'vm-mime-display-body-using-external-viewer) t]
-	   "---"
+	     'vm-mime-display-body-using-external-viewer) t])
+     ;; FSF Emacs does not allow a non-string menu element name.
+     (if (vm-menu-can-eval-item-name)
+	 (list [(format "Convert to %s and Display"
+			(or (nth 1 (vm-mime-can-convert
+				(car
+				 (vm-mm-layout-type
+				  (vm-mime-get-button-layout e)))))
+			    "different type"))
+		(vm-mime-run-display-function-at-point
+		 'vm-mime-convert-body-then-display)
+		(vm-mime-can-convert (car (vm-mm-layout-type
+					   (vm-mime-get-button-layout e))))]))
+     (list "---"
 	   ["Save to File" vm-mime-reader-map-save-file t]
 	   ["Save to Folder" vm-mime-reader-map-save-message
 	    (let ((layout (vm-mime-run-display-function-at-point
 (defun vm-mime-B-encode-region (start end)
   (vm-mime-base64-encode-region start end nil t))
 
+(defun vm-mime-base64-decode-string (string)
+  (vm-with-string-as-temp-buffer
+   string
+   (function
+    (lambda () (vm-mime-base64-decode-region (point-min) (point-max))))))
+
+(defun vm-mime-base64-encode-string (string)
+  (vm-with-string-as-temp-buffer
+   string
+   (function
+    (lambda () (vm-mime-base64-encode-region (point-min) (point-max)
+					     nil t)))))
+
 (defun vm-mime-crlf-to-lf-region (start end)
   (let ((buffer-read-only nil))
     (save-excursion
 	  (insert "\r\n"))))))
       
 (defun vm-encode-coding-region (b-start b-end coding-system &rest foo)
-  (let ((work-buffer (vm-make-work-buffer))
+  (let ((work-buffer nil)
 	start end
 	oldsize
 	retval
 	(b (current-buffer)))
-    (save-excursion
-      (set-buffer work-buffer)
-      (insert-buffer-substring b b-start b-end)
-      (setq oldsize (buffer-size))
-      (setq retval (apply 'encode-coding-region (point-min) (point-max)
-			  coding-system foo))
-      (setq start (point-min) end (point-max))
-      (setq retval (buffer-size))
-      (save-excursion
-	(set-buffer b)
-	(goto-char b-start)
-	(insert-buffer-substring work-buffer start end)
-	(delete-region (point) (+ (point) oldsize))
-	;; Fixup the end point.  I have found no other way to
-	;; let the calling function know where the region ends
-	;; after encode-coding-region has scrambled the markers.
-	(and (markerp b-end)
-	     (set-marker b-end (point)))
-	(kill-buffer work-buffer)
-	retval ))))
+    (unwind-protect
+	(save-excursion
+	  (setq work-buffer (vm-make-work-buffer))
+	  (set-buffer work-buffer)
+	  (insert-buffer-substring b b-start b-end)
+	  (setq oldsize (buffer-size))
+	  (setq retval (apply 'encode-coding-region (point-min) (point-max)
+			      coding-system foo))
+	  (setq start (point-min) end (point-max))
+	  (setq retval (buffer-size))
+	  (save-excursion
+	    (set-buffer b)
+	    (goto-char b-start)
+	    (insert-buffer-substring work-buffer start end)
+	    (delete-region (point) (+ (point) oldsize))
+	    ;; Fixup the end point.  I have found no other way to
+	    ;; let the calling function know where the region ends
+	    ;; after encode-coding-region has scrambled the markers.
+	    (and (markerp b-end)
+		 (set-marker b-end (point)))
+	    retval ))
+      (and work-buffer (kill-buffer work-buffer)))))
 
 (defun vm-decode-coding-region (b-start b-end coding-system &rest foo)
-  (let ((work-buffer (vm-make-work-buffer))
+  (let ((work-buffer nil)
 	start end
 	oldsize
 	retval
 	(b (current-buffer)))
-    (save-excursion
-      (setq oldsize (- b-end b-start))
-      (set-buffer work-buffer)
-      (insert-buffer-substring b b-start b-end)
-      (setq retval (apply 'decode-coding-region (point-min) (point-max)
-			  coding-system foo))
-      (and vm-fsfemacs-p (set-buffer-multibyte t))
-      (setq start (point-min) end (point-max))
-      (save-excursion
-	(set-buffer b)
-	(goto-char b-start)
-	(delete-region (point) (+ (point) oldsize))
-	(insert-buffer-substring work-buffer start end)
-	;; Fixup the end point.  I have found no other way to
-	;; let the calling function know where the region ends
-	;; after decode-coding-region has scrambled the markers.
-	(and (markerp b-end)
-	     (set-marker b-end (point)))
-	(kill-buffer work-buffer)
-	retval ))))
+    (unwind-protect
+	(save-excursion
+	  (setq work-buffer (vm-make-work-buffer))
+	  (setq oldsize (- b-end b-start))
+	  (set-buffer work-buffer)
+	  (insert-buffer-substring b b-start b-end)
+	  (setq retval (apply 'decode-coding-region (point-min) (point-max)
+			      coding-system foo))
+	  (and vm-fsfemacs-p (set-buffer-multibyte t))
+	  (setq start (point-min) end (point-max))
+	  (save-excursion
+	    (set-buffer b)
+	    (goto-char b-start)
+	    (delete-region (point) (+ (point) oldsize))
+	    (insert-buffer-substring work-buffer start end)
+	    ;; Fixup the end point.  I have found no other way to
+	    ;; let the calling function know where the region ends
+	    ;; after decode-coding-region has scrambled the markers.
+	    (and (markerp b-end)
+		 (set-marker b-end (point)))
+	    retval ))
+      (and work-buffer (kill-buffer work-buffer)))))
 
 (defun vm-mime-charset-decode-region (charset start end)
   (or (markerp end) (setq end (vm-marker end)))
 	     (nth 1 ooo))
     (save-excursion
       (set-buffer (vm-make-work-buffer " *mime object*"))
+      (setq vm-message-garbage-alist
+	    (cons (cons (current-buffer) 'kill-buffer)
+		  vm-message-garbage-alist))
       ;; call-process-region calls write-region.
       ;; don't let it do CR -> LF translation.
       (setq selective-display nil)
-      (setq vm-message-garbage-alist
-	    (cons (cons (current-buffer) 'kill-buffer)
-		  vm-message-garbage-alist))
       (vm-mime-insert-mime-body layout)
       (vm-mime-transfer-decode-region layout (point-min) (point-max))
       (call-process-region (point-min) (point-max) shell-file-name
 	       nil ))
     (vm-set-mm-layout-display-error layout "Need W3 to inline HTML")
     (message "%s" (vm-mm-layout-display-error layout))
-    (sleep-for 2)
     nil ))
 
 (defun vm-mime-display-internal-text/plain (layout &optional no-highlighting)
 	       (car (vm-mm-layout-type layout)))
       (vm-mime-display-external-generic layout))))
 
+(defun vm-mime-convert-body-then-display (button)
+  (let ((layout (vm-mime-convert-undisplayable-layout
+		 (vm-extent-property button 'vm-mime-layout))))
+    (vm-set-extent-property button 'vm-mime-disposable t)
+    (vm-set-extent-property button 'vm-mime-layout layout)
+    (goto-char (vm-extent-start-position button))
+    (vm-decode-mime-layout button t)))
+
+(defun vm-mime-get-button-layout (e)
+  (vm-mime-run-display-function-at-point
+   (function
+    (lambda (e)
+      (vm-extent-property e 'vm-mime-layout)))))
+
 (defun vm-mime-scrub-description (string)
   (let ((work-buffer nil))
       (save-excursion
   "Like get-file-buffer, but also checks buffers against FILE's truename"
   (or (get-file-buffer file)
       (and (fboundp 'file-truename)
-	   (get-file-buffer (file-truename file)))))
+	   (get-file-buffer (file-truename file)))
+      (and (fboundp 'find-buffer-visiting)
+	   (find-buffer-visiting file))))
 
 (defun vm-set-region-face (start end face)
   (let ((e (vm-make-extent start end)))
   (if (fboundp 'md5)
       (md5 (current-buffer) start end)
     (let ((buffer nil)
+	  (retval nil)
 	  (curbuf (current-buffer)))
       (unwind-protect
 	  (save-excursion
 	    ;; call-process-region calls write-region.
 	    ;; don't let it do CR -> LF translation.
 	    (setq selective-display nil)
-	    (call-process-region (point-min) (point-max)
-				 (or shell-file-name "/bin/sh") t buffer nil
-				 shell-command-switch vm-pop-md5-program)
+	    (setq retval
+		  (call-process-region (point-min) (point-max)
+				       (or shell-file-name "/bin/sh")
+				       t buffer nil
+				       shell-command-switch
+				       vm-pop-md5-program))
+	    (if (not (equal retval 0))
+		(progn
+		  (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]")
+		    (< (point-max) 32))
+		(error "%s produced bogus MD5 digest '%s'"
+		       vm-pop-md5-program 
+		       (vm-buffer-substring-no-properties (point-min) 
+							  (point-max))))
 	    ;; MD5 digest is 32 chars long
 	    ;; mddriver adds a newline to make neaten output for tty
 	    ;; viewing, make sure we leave it behind.
 	    (vm-buffer-substring-no-properties (point-min) (+ (point-min) 32)))
 	(and buffer (kill-buffer buffer))))))
+
+;; output is in hex
+(defun vm-md5-string (string)
+  (if (fboundp 'md5)
+      (md5 string)
+    (vm-with-string-as-temp-buffer
+     string (function
+	     (lambda ()
+	       (goto-char (point-min))
+	       (insert (vm-md5-region (point-min) (point-max)))
+	       (delete-region (point) (point-max)))))))
+
+;; output is the raw digest bits, not hex
+(defun vm-md5-raw-string (s)
+  (setq s (vm-md5-string s))
+  (let ((raw (make-string 16 0))
+	(i 0) n
+	(hex-digit-alist '((?0 .  0)  (?1 .  1)  (?2 .  2)  (?3 .  3)
+			   (?4 .  4)  (?5 .  5)  (?6 .  6)  (?7 .  7)
+			   (?8 .  8)  (?9 .  9)  (?A . 10)  (?B . 11)
+			   (?C . 12)  (?D . 13)  (?E . 14)  (?F . 15)
+			   ;; some mailer uses lower-case hex
+			   ;; digits despite this being forbidden
+			   ;; by the MIME spec.
+			   (?a . 10)  (?b . 11)  (?c . 12)  (?d . 13)
+			   (?e . 14)  (?f . 15))))
+    (while (< i 32)
+      (setq n (+ (* (cdr (assoc (aref s i) hex-digit-alist)) 16)
+		 (cdr (assoc (aref s (1+ i)) hex-digit-alist))))
+      (aset raw (/ i 2) n)
+      (setq i (+ i 2)))
+    raw ))
+
+(defun vm-xor-string (s1 s2)
+  (let ((len (length s1))
+	result (i 0))
+    (if (/= len (length s2))
+	(error "strings not of equal length"))
+    (setq result (make-string len 0))
+    (while (< i len)
+      (aset result i (logxor (aref s1 i) (aref s2 i)))
+      (setq i (1+ i)))
+    result ))
 (defun vm-move-to-next-button (count)
   "Moves to the next button in the current message.
 Prefix argument N means move to the Nth next button.
-Negavite N means move to the Nth previous button.
+Negative N means move to the Nth previous button.
 If there is no next button, an error is signaled and point is not moved.
 
 A button is a highlighted region of text where pressing RETURN
 (defun vm-move-to-previous-button (count)
   "Moves to the previous button in the current message.
 Prefix argument N means move to the Nth previous button.
-Negavite N means move to the Nth next button.
+Negative N means move to the Nth next button.
 If there is no previous button, an error is signaled and point is not moved.
 
 A button is a highlighted region of text where pressing RETURN
 (defun vm-pop-read-stat-response (process)
   (let ((response (vm-pop-read-response process t))
 	list)
-    (setq list (vm-parse response "\\([^ ]+\\) *"))
-    (list (string-to-int (nth 1 list)) (string-to-int (nth 2 list)))))
+    (if (null response)
+	nil
+      (setq list (vm-parse response "\\([^ ]+\\) *"))
+      (list (string-to-int (nth 1 list)) (string-to-int (nth 2 list))))))
 
 (defun vm-pop-read-list-response (process)
   (let ((response (vm-pop-read-response process t)))
-    (string-to-int (nth 2 (vm-parse response "\\([^ ]+\\) *")))))
+    (and response
+	 (string-to-int (nth 2 (vm-parse response "\\([^ ]+\\) *"))))))
 
 (defun vm-pop-read-uidl-long-response (process)
   (let ((start vm-pop-read-point)
 	      (vm-insert-region-from-buffer (vm-buffer-of message)
 					    (vm-headers-of message)
 					    (vm-text-of message))
+	      ;; decode MIME encoded words so supercite and other
+	      ;; mail-citation-hook denizens won't have to eat 'em.
+	      (if vm-display-using-mime
+		  (save-restriction
+		    (narrow-to-region start (point))
+		    (vm-decode-mime-encoded-words)))
 	      (cond ((vm-mime-types-match "multipart" type)
 		     (setq parts (copy-sequence (vm-mm-layout-parts o))))
 		    (t (setq parts (list o))))
 	  (set-buffer (vm-buffer-of message))
 	  (save-restriction
 	    (widen)
+	    ;; decode MIME encoded words so supercite and other
+	    ;; mail-citation-hook denizens won't have to eat 'em.
 	    (append-to-buffer b (vm-headers-of message)
 			      (vm-text-end-of message))
 	    (set-buffer b)
 	     (setq folder-buffer (or (vm-get-file-buffer folder)
 				     ;; avoid letter bombs
 				     (let ((inhibit-local-variables t)
+					   (enable-local-eval nil)
 					   (enable-local-variables nil))
 				       (find-file-noselect folder)))))
 	    ((and mlist vm-visit-when-saving)
 				  default-directory))
 			    (inhibit-local-variables t)
 			    (enable-local-variables nil)
+			    (enable-local-eval nil)
 			    ;; for Emacs/MULE
 			    (default-enable-multibyte-characters nil)
 			    ;; for XEmacs/Mule
 	  ;; don't decode MIME if recover-file is
 	  ;; likely to happen, since recover-file does
 	  ;; not work in a presentation buffer.
-	  (let ((vm-auto-decode-mime-messages (not preserve-auto-save-file)))
+	  (let ((vm-auto-decode-mime-messages
+		 (and vm-auto-decode-mime-messages
+		      (not preserve-auto-save-file))))
 	    (vm-preview-current-message)))
 
       (run-hooks 'vm-visit-folder-hook)
 (defun vm-mode (&optional read-only)
   "Major mode for reading mail.
 
-This is VM 6.92.
+This is VM 6.94.
 
 Commands:
    h - summarize folder contents
       (vm-su-do-month m (substring date (match-beginning 4) (match-end 4)))
       (vm-set-year-of m (substring date (match-beginning 5) (match-end 5)))
       (if (= 2 (length (vm-year-of m)))
-	  (vm-set-year-of m (concat "19" (vm-year-of m))))
+	  (save-match-data
+	    (cond ((string-match "^[0-6]" (vm-year-of m))
+		   (vm-set-year-of m (concat "20" (vm-year-of m))))
+		  (t
+		   (vm-set-year-of m (concat "19" (vm-year-of m)))))))
       (vm-set-hour-of m (substring date (match-beginning 6) (match-end 6)))
       (vm-set-zone-of m (substring date (match-beginning 7) (match-end 7))))
      ((string-match
 			(let ((kids (get old-parent-sym 'children))
 			      (msgs (get id-sym 'messages)))
 			  (while msgs
-			    (setq kids (delq m kids)
+			    (setq kids (delq (car msgs) kids)
 				  msgs (cdr msgs)))
 			  kids ))
 		   (set id-sym parent-sym)
 		    (vm-thread-mark-for-summary-update msgs)))
 	      (setq parent-sym id-sym
 		    refs (cdr refs)))))
-      (if vm-thread-using-subject
-	  ;; inhibit-quit because we need to make sure the asets
-	  ;; below are an atomic group.
-	  (let* ((inhibit-quit t)
-		 (subject (vm-so-sortable-subject m))
-		 (subject-sym (intern subject vm-thread-subject-obarray)))
-	    ;; if this subject never seen before create the
-	    ;; information vector.
-	    (if (not (boundp subject-sym))
-		(set subject-sym
-		     (vector id-sym (vm-so-sortable-datestring m)
-			     nil (list m)))
-	      ;; this subject seen before 
-	      (aset (symbol-value subject-sym) 3
-		    (cons m (aref (symbol-value subject-sym) 3)))
-	      (if (string< date (aref (symbol-value subject-sym) 1))
-		  (let* ((vect (symbol-value subject-sym))
-			 (i-sym (aref vect 0)))
-		    ;; optimization: if we know that this message
-		    ;; already has a parent, then don't bother
-		    ;; adding it to the list of child messages
-		    ;; since we know that it will be threaded and
-		    ;; unthreaded using the parent information.
-		    (if (or (not (boundp i-sym))
-			    (null (symbol-value i-sym)))
-			(aset vect 2 (append (get i-sym 'messages)
-					     (aref vect 2))))
-		    (aset vect 0 id-sym)
-		    (aset vect 1 date)
-		    ;; this loops _and_ recurses and I'm worried
-		    ;; about it going into a spin someday.  So I
-		    ;; unblock interrupts here.  It's not critical
-		    ;; that it finish... the summary will just be out
-		    ;; of sync.
-		    (if schedule-reindents
-			(let ((inhibit-quit nil))
-			  (vm-thread-mark-for-summary-update (aref vect 2)))))
-		;; optimization: if we know that this message
-		;; already has a parent, then don't bother adding
-		;; it to the list of child messages, since we
-		;; know that it will be threaded and unthreaded
-		;; using the parent information.
-		(if (null parent)
-		    (aset (symbol-value subject-sym) 2
-			  (cons m (aref (symbol-value subject-sym) 2))))))))
       (setq mp (cdr mp) n (1+ n))
       (if (zerop (% n modulus))
-	  (message "Building threads... %d" n)))
+	  (message "Building threads (by reference)... %d" n)))
+    (if vm-thread-using-subject
+	(progn
+	  (setq n 0 mp (or message-list vm-message-list))
+	  (while mp
+	    (setq m (car mp)
+		  parent (vm-th-parent m)
+		  id (vm-su-message-id m)
+		  id-sym (intern id vm-thread-obarray)
+		  date (vm-so-sortable-datestring m))
+	    ;; inhibit-quit because we need to make sure the asets
+	    ;; below are an atomic group.
+	    (let* ((inhibit-quit t)
+		   (subject (vm-so-sortable-subject m))
+		   (subject-sym (intern subject vm-thread-subject-obarray)))
+	      ;; if this subject was never seen before create the
+	      ;; information vector.
+	      (if (not (boundp subject-sym))
+		  (set subject-sym
+		       (vector id-sym (vm-so-sortable-datestring m)
+			       nil (list m)))
+		;; this subject seen before 
+		(aset (symbol-value subject-sym) 3
+		      (cons m (aref (symbol-value subject-sym) 3)))
+		(if (string< date (aref (symbol-value subject-sym) 1))
+		    (let* ((vect (symbol-value subject-sym))
+			   (i-sym (aref vect 0)))
+		      ;; optimization: if we know that this message
+		      ;; already has a parent, then don't bother
+		      ;; adding it to the list of child messages
+		      ;; since we know that it will be threaded and
+		      ;; unthreaded using the parent information.
+		      (if (or (not (boundp i-sym))
+			      (null (symbol-value i-sym)))
+			  (aset vect 2 (append (get i-sym 'messages)
+					       (aref vect 2))))
+		      (aset vect 0 id-sym)
+		      (aset vect 1 date)
+		      ;; this loops _and_ recurses and I'm worried
+		      ;; about it going into a spin someday.  So I
+		      ;; unblock interrupts here.  It's not critical
+		      ;; that it finish... the summary will just be out
+		      ;; of sync.
+		      (if schedule-reindents
+			  (let ((inhibit-quit nil))
+			    (vm-thread-mark-for-summary-update (aref vect 2)))))
+		  ;; optimization: if we know that this message
+		  ;; already has a parent, then don't bother adding
+		  ;; it to the list of child messages, since we
+		  ;; know that it will be threaded and unthreaded
+		  ;; using the parent information.
+		  (if (null parent)
+		      (aset (symbol-value subject-sym) 2
+			    (cons m (aref (symbol-value subject-sym) 2)))))))
+	    (setq mp (cdr mp) n (1+ n))
+	    (if (zerop (% n modulus))
+		(message "Building threads (by subject)... %d" n)))))
     (if (> n modulus)
 	(message "Building threads... done"))))
 
     server.
 
     AUTH is the authentication method used to convince the server
-    you should have access to the maildrop.  Acceptable values are
-    \"preauth\" and \"login\".  \"preauth\" causes VM to skip the
-    authentication stage of the protocol with the assumption that
-    the session was authenticated some externally way.  The other
-    value, \"login\", tells VM to use the IMAP LOGIN command for
-    authentication.
-
-    USER is the user name sent to the server for \"login\" style
-    authentication.
+    you should have access to the maildrop.  Acceptable values
+    are \"preauth\", \"login\" and \"cram-md5\".  \"preauth\"
+    causes VM to skip the authentication stage of the protocol
+    with the assumption that the session was authenticated some
+    externally way.  \"login\", tells VM to use the IMAP LOGIN
+    command for authentication, which sends your username and
+    password in cleartext to the server.  \"cram-md5\" is a
+    challenge response system that convinces the server of your
+    identity without transmitting your password in the clear.
+    Not all servers support \"cram-md5\"; if you're not sure, ask
+    your mail administrator or just try it.
+
+    USER is the user name used with authentication methods that
+    require such an identifier.  \"login\" and \"cram-md5\"
+    use it currently.
 
     PASSWORD is the secret shared by you and the server for
     authentication purposes.  If the PASSWORD is \"*\", VM
 A value of nil means never remove empty folders.
 A value that's not t or nil means ask before removing empty folders.")
 
+(defvar vm-folder-file-precious-flag t
+  "*Value that `file-precious-flag' should have in visited folders.
+A non-nil value causes folders to be saved by writing to a
+temporary file and then replacing the folder with that file.  A
+nil value causes folders to be saved by writing directly to the
+folder without the use of a temporary file.")
+
 (defvar vm-flush-interval 90
   "*Non-nil value specifies how often VM flushes its cached internal
 data.  A numeric value gives the number of seconds between
 	   ("iso-8859-9"	iso-8859-9)
 	   ("iso-2022-jp"	iso-2022-jp)
 	   ("big5"		big5)
+	   ("koi8-r"		koi8-r)
 	   ;; probably not correct, but probably better than nothing.
 	   ("iso-2022-jp-2"	iso-2022-jp)
 	   ("iso-2022-int-1"	iso-2022-int-1)
 
 (provide 'vm-version)
 
-(defconst vm-version "6.92"
+(defconst vm-version "6.94"
   "Version number of VM.")
 
 (defun vm-version ()
   (and vm-xemacs-p
        (fboundp 'set-buffer-menubar)))
 
+(defun vm-menu-can-eval-item-name ()
+  (and vm-xemacs-p
+       (fboundp 'check-menu-syntax)
+       (condition-case nil
+	   (check-menu-syntax '("bar" ((identity "foo") 'ding t)))
+	 (error nil))))
+
 (defun vm-multiple-frames-possible-p () 
   (cond (vm-xemacs-p 
 	 (or (memq 'win (device-matching-specifier-tag-list))
 			 ;; set enable-local-variables to nil
 			 ;; for newer Emacses
 			 (let ((inhibit-local-variables t)
+			       (enable-local-eval nil)
 			       (enable-local-variables nil))
 			   (find-file-noselect folder)))))
 	    (set-buffer (or (and (bufferp folder) folder)
 			    (vm-get-file-buffer folder)
 			    (let ((inhibit-local-variables t)
+				  (enable-local-eval nil)
 				  (enable-local-variables nil))
 			      (find-file-noselect folder))))
 	    (if (eq major-mode 'vm-virtual-mode)
 that the next time the folder is visited VM will know which messages
 have been already read, replied to and so on.  Typing @kbd{S}
 (@code{vm-save-folder}) saves the folder.  Note that deleted messages are
-not expunged automatically when you save a folder; this is a change from
+@emph{not} expunged automatically when you save a folder; this is a change from
 version 4 of VM.  The next time you visit the folder any deleted
-messages will still be flagged for deleted.
+messages will still be flagged for deletion.
+
+@vindex vm-folder-file-precious-flag
+When a folder is first visited, the value of the variable
+@code{vm-folder-file-precious-flag} is used to initialize a
+buffer-local instance of #code{file-precious-flag}, which
+determines how folders are saved.  A non-nil value causes
+folders to be saved by writing to a temporary file and then
+replacing the folder with that file.  A nil value causes
+folders to be saved by writing directly to the folder without
+the use of a temporary file.
 
 @vindex vm-delete-empty-folders
-If the folder is empty and the variable @code{vm-delete-empty-folders}
-is non-@code{nil}, VM will remove the zero length folder after saving it.
+If the folder is empty at the time you save it and the variable
+@code{vm-delete-empty-folders} is non-@code{nil}, VM will remove
+the zero length folder after saving it.
 
 @findex vm-quit
 @findex vm-quit-no-change
 be @samp{"inbox"}, to access your default IMAP maildrop on the
 server.
 
-@var{AUTH} is the authentication method used to convince the server
-you should have access to the maildrop.  Acceptable values are
-@samp{"preauth"} and @samp{"login"}.  @samp{"preauth"} causes VM to skip the
-authentication stage of the protocol with the assumption that
-the session was authenticated in some way external to VM.  The
-hook @code{vm-imap-session-preauth-hook} is run, and it is
-expected to return a process connected to an authenticated
-session. The other value, @samp{"login"}, tells VM to use the IMAP LOGIN
-command for authentication.
-
-@var{USER} is the user name sent to the server for @samp{"login"} style
-authentication.
+@var{AUTH} is the authentication method used to convince the
+server you should have access to the maildrop.  Acceptable values
+are @samp{"preauth"}, @samp{"cram-md5"}, and @samp{"login"}.
+@samp{"preauth"} causes VM to skip the authentication stage of
+the protocol with the assumption that the session was
+authenticated in some way external to VM.  The hook
+@code{vm-imap-session-preauth-hook} is run, and it is expected to
+return a process connected to an authenticated IMAP session.
+@samp{"cram-md5} tells VM to use the CRAM-MD5 authentication
+method as specificed in RFC 2195.  The advantage of this method
+over the @samp{"login"} method is that it avoids sending your
+password over the net unencrypted.  Not all IMAP servers support
+@samp{"cram-md5"}; if you're not sure, ask your mail
+administrator or just try it.  The other value, @samp{"login"},
+tells VM to use the IMAP LOGIN command for authentication, which
+sends your username and password in cleartext to the server.
+
+@var{USER} is the user name used in authentication methods that
+require such an identifier.  @samp{"login"} and @samp{"cram-md5"}
+use it currently.
 
 @var{PASSWORD} is the secret shared by you and the server for
 authentication purposes.  If the @var{PASSWORD} is @samp{*}, VM