changeset 88273:d30c56339f08

(rmail): Go back to using find-file for reading in the mail file. This avoids gratuitous modification of the file. (rmail-decode-region): Doc string, cleanup. (rmail-decode-by-content-type): New function. (rmail-decode-messages): Use it. Add FROM and TO args and only process messages in that region. (rmail-get-new-mail): Call `rmail-decode-region' before `rmail-process-new-messages'.
author Henrik Enberg <henrik.enberg@telia.com>
date Sun, 22 Jan 2006 05:45:47 +0000
parents 6cc100458664
children 8a210508c1d6
files lisp/mail/rmail.el
diffstat 1 files changed, 138 insertions(+), 95 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/mail/rmail.el	Sat Jan 21 21:58:52 2006 +0000
+++ b/lisp/mail/rmail.el	Sun Jan 22 05:45:47 2006 +0000
@@ -788,39 +788,64 @@
 	 ;; code conversion, then decode the messages one by one.
 	 (coding-system-for-read (and rmail-enable-multibyte 'raw-text))
 	 run-mail-hook msg-shown new-mail)
-    (when existed
-      (switch-to-buffer existed)
-      (when (eq major-mode 'rmail-edit-mode)
-	(error "Exit Rmail Edit mode before getting new mail")))
-    ;; If no buffer existed, or the file was changed behind our back,
-    ;; get the raw data again.  If we just read in a BABYL file, the
-    ;; conversion will have changed the buffer, thus a user issuing
-    ;; another M-x rmail will reconvert the BABYL file since we're not
-    ;; saving after a conversion.
-    (unless (and existed (verify-visited-file-modtime existed))
-      ;; There used to be mucking with enable-local-variables here,
-      ;; and that was tricky because it was made buffer-local, and
-      ;; binding a variable locally with let is not safe if it has
-      ;; buffer-local bindings.  We also don't want to run any
-      ;; find-file-hooks, as these might tamper with the restrictions,
-      ;; eg. session management.
-      (if existed
-	  ;; quietly revert file if it changed under us
-	  (let ((inhibit-read-only t))
-	    (erase-buffer)
-	    (insert-file-contents-literally file-name)
-	    ;; We need to re-initialize rmail-mode later.
-	    (setq major-mode 'fundamental-mode))
+    ;; This is how we used to do it.  I reverted to the original Rmail
+    ;; way of reading in the mail file, as it's the only way I can think
+    ;; of to avoid needless modification of the mail file.  However, the
+    ;; comments below (some of which appear in the original `rmail' too)
+    ;; indicate that there was problems with that approach, so I'm not
+    ;; sure on what to do.  --enberg
+
+    ;; (when existed
+    ;;   (switch-to-buffer existed)
+    ;;   (when (eq major-mode 'rmail-edit-mode)
+    ;; 	(error "Exit Rmail Edit mode before getting new mail")))
+    ;; ;; If no buffer existed, or the file was changed behind our back,
+    ;; ;; get the raw data again.  If we just read in a BABYL file, the
+    ;; ;; conversion will have changed the buffer, thus a user issuing
+    ;; ;; another M-x rmail will reconvert the BABYL file since we're not
+    ;; ;; saving after a conversion.
+    ;; (unless (and existed (verify-visited-file-modtime existed))
+    ;;   ;; There used to be mucking with enable-local-variables here,
+    ;;   ;; and that was tricky because it was made buffer-local, and
+    ;;   ;; binding a variable locally with let is not safe if it has
+    ;;   ;; buffer-local bindings.  We also don't want to run any
+    ;;   ;; find-file-hooks, as these might tamper with the restrictions,
+    ;;   ;; eg. session management.
+    ;;   (if existed
+    ;; 	  ;; quietly revert file if it changed under us
+    ;; 	  (let ((inhibit-read-only t))
+    ;; 	    (erase-buffer)
+    ;; 	    (insert-file-contents-literally file-name)
+    ;; 	    ;; We need to re-initialize rmail-mode later.
+    ;; 	    (setq major-mode 'fundamental-mode))
+    ;; 	(switch-to-buffer
+    ;; 	 (get-buffer-create (file-name-nondirectory file-name)))
+    ;; 	(when (file-exists-p file-name)
+    ;; 	  (insert-file-contents-literally file-name))
+    ;; 	(setq buffer-file-name file-name)
+    ;; 	;; As we have read a file as raw-text, the buffer is set to
+    ;; 	;; unibyte.  We must make it multibyte if necessary.
+    ;; 	(if (and rmail-enable-multibyte
+    ;; 		 (not enable-multibyte-characters))
+    ;; 	    (set-buffer-multibyte t))))
+
+    (when (and existed (eq major-mode 'rmail-edit-mode))
+      (error "Exit Rmail Edit mode before getting new mail"))
+    (if (and existed (not (verify-visited-file-modtime existed)))
+	(progn
+	  (find-file file-name)
+	  (when (and (verify-visited-file-modtime existed)
+		     (eq major-mode 'rmail-mode))
+	    (setq major-mode 'fundamental-mode)))
 	(switch-to-buffer
-	 (get-buffer-create (file-name-nondirectory file-name)))
-	(when (file-exists-p file-name)
-	  (insert-file-contents-literally file-name))
-	(setq buffer-file-name file-name)
+	 (let ((enable-local-variables nil))
+	   (find-file-noselect file-name)))
 	;; As we have read a file as raw-text, the buffer is set to
 	;; unibyte.  We must make it multibyte if necessary.
-	(if (and rmail-enable-multibyte
-		 (not enable-multibyte-characters))
-	    (set-buffer-multibyte t))))
+	(when (and rmail-enable-multibyte
+		   (not enable-multibyte-characters))
+	  (set-buffer-multibyte t)))
+
     ;; Make sure we're in rmail-mode, even if the buffer did exist and
     ;; the file was not changed.
     (unless (eq major-mode 'rmail-mode)
@@ -844,7 +869,7 @@
 	    (delete-file new-file)))
 	;; Go through the converted file and decode each message
 	;; according to its mime charset.
-	(rmail-decode-messages))
+	(rmail-decode-messages (point-min) (point-max)))
       (goto-char (point-max))
       (rmail-mode-2)
       ;; setup files coding system
@@ -1454,13 +1479,13 @@
 		;; Process newly found messages and save them into the
 		;; RMAIL file.
 		(unless (equal (point-min) (point-max))
+		  ;; Go through the region and decode each message.
+		  (rmail-decode-messages (point-min) (point-max))
+		  ;; Update state and save buffer
 		  (setq new-messages (rmail-process-new-messages)
 			rmail-current-message (1+ rmail-total-messages)
 			rmail-total-messages (rmail-desc-get-count))
 		  (run-hooks 'rmail-get-new-mail-hook)
-		  ;; Go through the RMAIL file and decode each message
-		  ;; according to its mime charset.
-		  (rmail-decode-messages)
 		  (save-buffer))
 		;; Delete the old files, now that the RMAIL file is
 		;; saved.
@@ -1683,21 +1708,25 @@
       (message "")
       (setq files (cdr files)))
     delete-files))
+
+;;;; *** Rmail message decoding ***
 
-;; Decode the region specified by FROM and TO by CODING.
-;; If CODING is nil or an invalid coding system, decode by `undecided'.
 (defun rmail-decode-region (from to coding)
-  (if (or (not coding) (not (coding-system-p coding)))
-      (setq coding 'undecided))
+  "Decode the region specified by FROM and TO by CODING.
+If CODING is nil or an invalid coding system, decode by `undecided'."
+  (unless (and coding (coding-system-p coding))
+    (setq coding 'undecided))
   ;; Use -dos decoding, to remove ^M characters left from base64 or
   ;; rogue qp-encoded text.
   (decode-coding-region from to
-			(coding-system-change-eol-conversion coding 1))
+			(coding-system-change-eol-conversion
+			 coding 'dos))
   ;; Don't reveal the fact we used -dos decoding, as users generally
   ;; will not expect the RMAIL buffer to use DOS EOL format.
   (setq buffer-file-coding-system
 	(setq last-coding-system-used
-	      (coding-system-change-eol-conversion coding 0))))
+	      (coding-system-change-eol-conversion
+	       coding 'unix))))
 
 (defun rmail-decode-mail-file ()
   "Decode mail file to a suitable conding system."
@@ -1719,62 +1748,76 @@
       (setq buffer-file-coding-system nil)
       (setq save-buffer-coding-system (or coding-system 'undecided)))))
 
-(defun rmail-decode-messages ()
-  (let ((inhibit-read-only t)
-        (case-fold-search nil)
-	(start (point-max))
-	end)
-    ;; Process each message in turn starting from the back and
-    ;; proceeding to the front of the region.  This is especially a good
-    ;; approach since the buffer will likely have new headers added.
-    (widen)
-    (goto-char start)
-    (while (re-search-backward rmail-unix-mail-delimiter nil t)
-      (setq end start)
-      (setq start (point))
-      (save-excursion
-	(save-restriction
-	  (narrow-to-region start end)
-	  (goto-char (point-min))
-	  ;; Detect messages that have been added with DOS line endings
-	  ;; and convert the line endings for such messages.
-	  (when (save-excursion (end-of-line) (= (preceding-char) ?\r))
-	    (let ((buffer-read-only nil)
-		  (buffer-undo t)
-		  (end-marker (copy-marker end)))
-	      (message
-	       "Processing new messages...(converting line endings)")
-	      (save-excursion
-		(goto-char (point-max))
-		(while (search-backward "\r\n" (point-min) t)
-		  (delete-char 1)))
-	      (setq end (marker-position end-marker))
-	      (set-marker end-marker nil)))
-	  ;; Figure out the encoding by looking at the MIME header and
-	  ;; decode the message.
-	  (setq last-coding-system-used nil)
-	  (when (and (not rmail-enable-mime) rmail-enable-multibyte)
-	    (let ((mime-charset
-		   (when (and rmail-decode-mime-charset
-			      (save-excursion
-				(goto-char (rmail-header-get-limit))
-				(let ((case-fold-search t))
-				  (re-search-backward
-				   rmail-mime-charset-pattern
-				   (point-min) t))))
-		     (intern (downcase (match-string 1))))))
-	      (rmail-decode-region start (point) mime-charset)))
-	  ;; encoded-words in from and subject
-	  (dolist (header '("Subject" "From"))
-	    (let ((value (rmail-header-get-header header)))
-	      (rmail-header-add-header
-	       header (mail-decode-encoded-word-string value))))
-	  ;; Add an the X-Coding-System header.
-	  (unless (rmail-header-get-header "X-Coding-System")
-	    (let ((val (symbol-name last-coding-system-used)))
-	      (rmail-header-add-header "X-Coding-System" val))))))))
+(defun rmail-decode-by-content-type (from to)
+  "Decode message between FROM and TO according to Content-Type."
+  (when (and (not rmail-enable-mime) rmail-enable-multibyte)
+    (let ((coding-system-used nil)
+	  (case-fold-search t))
+      (save-restriction
+	(narrow-to-region from to)
+	(when (and (not rmail-enable-mime) rmail-enable-multibyte)
+	  (let ((coding
+		 (when (save-excursion
+			 (goto-char (rmail-header-get-limit))
+			 (re-search-backward
+			  rmail-mime-charset-pattern
+			  (point-min) t))
+		   (intern (downcase (match-string 1))))))
+	    (setq coding-system-used (rmail-decode-region
+				      (point-min) (point-max)
+				      coding)))))
+      (setq last-coding-system-used coding-system-used))))
 
-
+;; NB: this function may only be called on a region containing fresh,
+;; never before seen messages.  Using it on old messages will mess up
+;; encoding.
+(defun rmail-decode-messages (from to)
+  ;; Process each message in turn starting from the back and
+  ;; proceeding to the front of the region.  This is especially a good
+  ;; approach since the buffer will likely have new headers added.
+  (save-excursion
+    (narrow-to-region from to)
+    (let ((inhibit-read-only t)
+	  (case-fold-search nil)
+	  (start (point-max))
+	  end)
+      (goto-char start)
+      (while (re-search-backward rmail-unix-mail-delimiter nil t)
+	(setq end start)
+	(setq start (point))
+	(save-excursion
+	  (save-restriction
+	    (narrow-to-region start end)
+	    (goto-char (point-min))
+	    ;; Detect messages that have been added with DOS line endings
+	    ;; and convert the line endings for such messages.
+	    (when (save-excursion (end-of-line) (= (preceding-char) ?\r))
+	      (let ((buffer-read-only nil)
+		    (buffer-undo t)
+		    (end-marker (copy-marker end)))
+		(message
+		 "Processing new messages...(converting line endings)")
+		(save-excursion
+		  (goto-char (point-max))
+		  (while (search-backward "\r\n" (point-min) t)
+		    (delete-char 1)))
+		(setq end (marker-position end-marker))
+		(set-marker end-marker nil)))
+
+	    ;; Decode message according to content type, and make sure we
+	    ;; have a coding-system header.
+	    (let ((coding (rmail-decode-by-content-type
+			   (point-min) (point-max))))
+	      (unless (rmail-header-get-header "X-Coding-System")
+		(rmail-header-add-header "X-Coding-System"
+					 (symbol-name coding))))
+
+	    ;; encoded-words in from and subject
+	    (dolist (header '("Subject" "From"))
+	      (let ((value (rmail-header-get-header header)))
+		(rmail-header-add-header
+		 header (mail-decode-encoded-word-string value))))))))))
+  
 ;;;; *** Rmail Message Formatting and Header Manipulation ***
 
 (defun rmail-clear-headers (&optional ignored-headers)