emacs: lisp/mail/rmail.el comparison

comparison lisp/mail/rmail.el @ 22045:2c21cfc02a7f

(rmail-decode-babyl-format): Set save-buffer-coding-system instead of buffer-file-coding-system. Decode the whole Babyl text at once, not message by message. Don't alter global value of rmail-file-coding-system. (rmail-show-message): Set buffer-file-coding-system from X-Coding-System header field. (rmail-convert-to-babyl-format): Record X-Coding-System header for each message that was converted. (rmail-variables): Make local binding for save-buffer-coding-system, and set it from buffer-file-coding-system if not already non-nil. (rmail-ignored-headers): Ignore X-Coding-System header. Ignore Return-Path, Errors-To, X-Attribution, X-Disclaimer.

author	Richard M. Stallman <rms@gnu.org>
date	Tue, 12 May 1998 23:26:17 +0000
parents	191bddd991ef
children	7d28e1d5ea0e

comparison

equal deleted inserted replaced

-:d1cebbdf9c3d
+:2c21cfc02a7f
 ;;; rmail.el --- main code of "RMAIL" mail reader for Emacs.
-;; Copyright (C) 1985,86,87,88,93,94,95,96,97 Free Software Foundation, Inc.
+;; Copyright (C) 1985,86,87,88,93,94,95,96,97,1998
+;;		Free Software Foundation, Inc.
 ;; Maintainer: FSF
 ;; Keywords: mail
 ;; This file is part of GNU Emacs.
 `rmail-dont-reply-to-names' explicitly.  (The other part of the default
 value is the user's name.)
 It is useful to set this variable in the site customization file.")
 ;;;###autoload
-(defcustom rmail-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^references:\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:\\|^nntp-posting-host:\\|^path:\\|^x-char.*:\\|^x-face:\\|^x-mailer:\\|^delivered-to:\\|^lines:\\|^mime-version:\\|^content-transfer-encoding:"
+(defcustom rmail-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^references:\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:\\|^nntp-posting-host:\\|^path:\\|^x-char.*:\\|^x-face:\\|^x-mailer:\\|^delivered-to:\\|^lines:\\|^mime-version:\\|^content-transfer-encoding:\\|^x-coding-system:\\|^return-path:\\|^errors-to:\\|^return-receipt-to:\\|^x-attribution:\\|^x-disclaimer:"
 "*Regexp to match header fields that Rmail should normally hide."
 :type 'regexp
 :group 'rmail-headers)
 ;;;###autoload
 ;     list))
 ; I have checked that adding "-*- rmail -*-" to the BABYL OPTIONS line
 ; will not cause emacs 18.55 problems.
+;; This calls rmail-decode-babyl-format if the file is already Babyl.
 (defun rmail-convert-file ()
 (let (convert)
 (widen)
 (goto-char (point-min))
 ;; If file doesn't start like a Babyl file,
 (if (and (not rmail-enable-mime)
 	       rmail-enable-multibyte)
 	  ;; We still have to decode BABYL part.
 	  (rmail-decode-babyl-format)))))
-;;; I have checked that adding "-*- rmail -*-" to the BABYL OPTIONS line
-;;; will not cause emacs 18.55 problems.
 (defun rmail-insert-rmail-file-header ()
 (let ((buffer-read-only nil))
+;; -*-rmail-*- is here so that visiting the file normally
+;; recognizes it as an Rmail file.
 (insert "BABYL OPTIONS: -*- rmail -*-
 Version: 5
 Labels:
 Note:   This is the header of an rmail file.
 Note:   If you are seeing it in rmail,
 ;; rmail-file-coding-system, or if it is nil, do auto conversion.
 (defun rmail-decode-babyl-format ()
 (let ((modifiedp (buffer-modified-p))
 	(buffer-read-only nil)
+	(coding-system rmail-file-coding-system)
 	from to)
 (goto-char (point-min))
-(search-forward "\n\^_" nil t)	; Skip BYBYL header.
+(search-forward "\n\^_" nil t)	; Skip BABYL header.
 (setq from (point))
 (goto-char (point-max))
 (search-backward "\n\^_" from 'mv)
 (setq to (point))
-(if (not (and rmail-file-coding-system
+(unless (and coding-system
-		  (coding-system-p rmail-file-coding-system)))
+		 (coding-system-p coding-system))
-	(setq rmail-file-coding-system (detect-coding-region from to t)))
+(setq coding-system (detect-coding-region from to t)))
-(if (not (eq rmail-file-coding-system 'undecided))
+(unless (eq coding-system 'undecided)
-	(let ((count 1))
+(decode-coding-region from to coding-system)
-	  (goto-char from)
+(setq coding-system last-coding-system-used))
-	  (while (search-forward "\n\^_" nil t)
+(set-buffer-modified-p modifiedp)
-	    (decode-coding-region from (1- (point)) rmail-file-coding-system)
+(setq buffer-file-coding-system nil)
-	    (goto-char (point))
+(setq save-buffer-coding-system
-	    (setq from (point))
+	  (or coding-system 'undecided))))
-	    (if (= (% count 10) 0)
-		(message "Decoding messages...%d" count))
-	    (setq count (1+ count)))
-	  (message "Decoding messages...done")
-	  (set-buffer-file-coding-system rmail-file-coding-system)
-	  (set-buffer-modified-p modifiedp)))))
 (defvar rmail-mode-map nil)
 (if rmail-mode-map
 nil
 (setq rmail-mode-map (make-keymap))
 ;; this gets generated as needed
 (setq rmail-keywords nil))
 ;; Set up the non-permanent locals associated with Rmail mode.
 (defun rmail-variables ()
+(make-local-variable 'save-buffer-coding-system)
+;; If we don't already have a value for save-buffer-coding-system,
+;; get it from buffer-file-coding-system, and clear that
+;; because it should be determined in rmail-show-message.
+(unless save-buffer-coding-system
+(setq save-buffer-coding-system (or buffer-file-coding-system 'undecided))
+(setq buffer-file-coding-system nil))
 ;; Don't let a local variables list in a message cause confusion.
 (make-local-variable 'enable-local-variables)
 (setq enable-local-variables nil)
 (make-local-variable 'revert-buffer-function)
 (setq revert-buffer-function 'rmail-revert)
 (make-local-variable 'font-lock-defaults)
 (setq font-lock-defaults
-'(rmail-font-lock-keywords t nil nil nil
+	'(rmail-font-lock-keywords
-(font-lock-maximum-size . nil)
+	  t nil nil nil
-(font-lock-fontify-buffer-function . rmail-fontify-buffer-function)
+	  (font-lock-maximum-size . nil)
-(font-lock-unfontify-buffer-function . rmail-unfontify-buffer-function)
+	  (font-lock-fontify-buffer-function . rmail-fontify-buffer-function)
-(font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode))))
+	  (font-lock-unfontify-buffer-function . rmail-unfontify-buffer-function)
+	  (font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode))))
 (make-local-variable 'require-final-newline)
 (setq require-final-newline nil)
 (make-local-variable 'version-control)
 (setq version-control 'never)
 (make-local-variable 'kill-buffer-hook)
 	       ;; will be treated properly.
 	       (delete-region (point)
 			      (save-excursion
 				(skip-chars-forward " \t\n")
 				(point)))
+	       (setq last-coding-system-used nil)
 	       (or rmail-enable-mime
 		   (not rmail-enable-multibyte)
 		   (decode-coding-region start (point)
 					 (or rmail-file-coding-system
 					     'undecided)))
+	       ;; Add an X-Coding-System: header if we don't have one.
+	       (save-excursion
+		 (goto-char start)
+		 (forward-line 1)
+		 (if (looking-at "0")
+		     (forward-line 1)
+		   (forward-line 2))
+		 (or (save-restriction
+		       (narrow-to-region (point) (point-max))
+		       (rfc822-goto-eoh)
+		       (goto-char (point-min))
+		       (re-search-forward "^X-Coding-System:" nil t))
+		     (insert "X-Coding-System: "
+			     (symbol-name last-coding-system-used)
+			     "\n")))
 	       (narrow-to-region (point) (point-max)))
 	      ;;*** MMDF format
 	      ((let ((case-fold-search t))
 		 (looking-at rmail-mmdf-delim1))
 	       (let ((case-fold-search t))
 		 (save-restriction
 		   (narrow-to-region start (1- (point)))
 		   (goto-char (point-min))
 		   (while (search-forward "\n\^_" nil t); single char "\^_"
 		     (replace-match "\n^_")))); 2 chars: "^" and "_"
+	       (setq last-coding-system-used nil)
 	       (or rmail-enable-mime
 		   (not rmail-enable-multibyte)
 		   (decode-coding-region start (point) 'undecided))
+	       (save-excursion
+		 (goto-char start)
+		 (forward-line 3)
+		 (insert "X-Coding-System: "
+			 (symbol-name last-coding-system-used)
+			 "\n"))
 	       (narrow-to-region (point) (point-max))
 	       (setq count (1+ count)))
 	      ;;*** Mail format
 	      ((looking-at "^From ")
 	       (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
 		   (narrow-to-region start (point))
 		   (goto-char (point-min))
 		   (while (search-forward "\n\^_" nil t); single char
 		     (replace-match "\n^_")))); 2 chars: "^" and "_"
 	       (insert ?\^_)
+	       (setq last-coding-system-used nil)
 	       (or rmail-enable-mime
 		   (not rmail-enable-multibyte)
 		   (decode-coding-region start (point) 'undecided))
+	       (save-excursion
+		 (goto-char start)
+		 (forward-line 3)
+		 (insert "X-Coding-System: "
+			 (symbol-name last-coding-system-used)
+			 "\n"))
 	       (narrow-to-region (point) (point-max)))
 	      ;;
 	      ;; This kludge is because some versions of sendmail.el
 	      ;; insert an extra newline at the beginning that shouldn't
 	      ;; be there.  sendmail.el has been fixed, but old versions
 (widen)
 (if (zerop rmail-total-messages)
 (progn (narrow-to-region (point-min) (1- (point-max)))
 	     (goto-char (point-min))
 	     (setq mode-line-process nil))
-(let (blurb)
+(let (blurb coding-system)
 (if (not n)
 	  (setq n rmail-current-message)
 	(cond ((<= n 0)
 	       (setq n 1
 		     rmail-current-message 1
 	      (t
 	       (setq rmail-current-message n))))
 (let ((beg (rmail-msgbeg n)))
 	(goto-char beg)
 	(forward-line 1)
+	(save-excursion
+	  (let ((end (rmail-msgend n)))
+	    (save-restriction
+	      (if (prog1 (= (following-char) ?0)
+		    (forward-line 2)
+		    (narrow-to-region (point) end))
+		  (rfc822-goto-eoh)
+		(search-forward "\n*** EOOH ***\n" end t))
+	      (narrow-to-region beg (point))
+	      (goto-char (point-min))
+	      (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
+		  (let ((coding-system (intern (match-string 1))))
+		    (check-coding-system coding-system)
+		    (setq buffer-file-coding-system coding-system))
+		(setq buffer-file-coding-system nil)))))
 	;; Clear the "unseen" attribute when we show a message.
 	(rmail-set-attribute "unseen" nil)
-	;; Reformat the header, or else find the reformatted header.
 	(let ((end (rmail-msgend n)))
+	  ;; Reformat the header, or else find the reformatted header.
 	  (if (= (following-char) ?0)
 	      (rmail-reformat-message beg end)
 	    (search-forward "\n*** EOOH ***\n" end t)
 	    (narrow-to-region (point) end)))
 	(goto-char (point-min))

Mercurial > emacs

comparison lisp/mail/rmail.el @ 22045:2c21cfc02a7f