aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1998-05-12 23:26:17 +0000
committerRichard M. Stallman1998-05-12 23:26:17 +0000
commit578b64159bae7983efc2f943b1f4a5bcfdf9492d (patch)
treed9ae6ccada3374c8da92df7800e961b67be8942a
parent15cfd6226a422a3fa1953980cfe6ff7d0814cdae (diff)
downloademacs-578b64159bae7983efc2f943b1f4a5bcfdf9492d.tar.gz
emacs-578b64159bae7983efc2f943b1f4a5bcfdf9492d.zip
(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.
-rw-r--r--lisp/mail/rmail.el108
1 files changed, 79 insertions, 29 deletions
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 16f63ae6987..2c724a770a8 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -1,6 +1,7 @@
1;;; rmail.el --- main code of "RMAIL" mail reader for Emacs. 1;;; rmail.el --- main code of "RMAIL" mail reader for Emacs.
2 2
3;; Copyright (C) 1985,86,87,88,93,94,95,96,97 Free Software Foundation, Inc. 3;; Copyright (C) 1985,86,87,88,93,94,95,96,97,1998
4;; Free Software Foundation, Inc.
4 5
5;; Maintainer: FSF 6;; Maintainer: FSF
6;; Keywords: mail 7;; Keywords: mail
@@ -134,7 +135,7 @@ value is the user's name.)
134It is useful to set this variable in the site customization file.") 135It is useful to set this variable in the site customization file.")
135 136
136;;;###autoload 137;;;###autoload
137(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:" 138(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:"
138 "*Regexp to match header fields that Rmail should normally hide." 139 "*Regexp to match header fields that Rmail should normally hide."
139 :type 'regexp 140 :type 'regexp
140 :group 'rmail-headers) 141 :group 'rmail-headers)
@@ -556,6 +557,8 @@ If `rmail-display-summary' is non-nil, make a summary for this RMAIL file."
556; I have checked that adding "-*- rmail -*-" to the BABYL OPTIONS line 557; I have checked that adding "-*- rmail -*-" to the BABYL OPTIONS line
557; will not cause emacs 18.55 problems. 558; will not cause emacs 18.55 problems.
558 559
560;; This calls rmail-decode-babyl-format if the file is already Babyl.
561
559(defun rmail-convert-file () 562(defun rmail-convert-file ()
560 (let (convert) 563 (let (convert)
561 (widen) 564 (widen)
@@ -600,11 +603,10 @@ If `rmail-display-summary' is non-nil, make a summary for this RMAIL file."
600 ;; We still have to decode BABYL part. 603 ;; We still have to decode BABYL part.
601 (rmail-decode-babyl-format))))) 604 (rmail-decode-babyl-format)))))
602 605
603;;; I have checked that adding "-*- rmail -*-" to the BABYL OPTIONS line
604;;; will not cause emacs 18.55 problems.
605
606(defun rmail-insert-rmail-file-header () 606(defun rmail-insert-rmail-file-header ()
607 (let ((buffer-read-only nil)) 607 (let ((buffer-read-only nil))
608 ;; -*-rmail-*- is here so that visiting the file normally
609 ;; recognizes it as an Rmail file.
608 (insert "BABYL OPTIONS: -*- rmail -*- 610 (insert "BABYL OPTIONS: -*- rmail -*-
609Version: 5 611Version: 5
610Labels: 612Labels:
@@ -618,29 +620,24 @@ Note: it means the file has no messages in it.\n\^_")))
618(defun rmail-decode-babyl-format () 620(defun rmail-decode-babyl-format ()
619 (let ((modifiedp (buffer-modified-p)) 621 (let ((modifiedp (buffer-modified-p))
620 (buffer-read-only nil) 622 (buffer-read-only nil)
623 (coding-system rmail-file-coding-system)
621 from to) 624 from to)
622 (goto-char (point-min)) 625 (goto-char (point-min))
623 (search-forward "\n\^_" nil t) ; Skip BYBYL header. 626 (search-forward "\n\^_" nil t) ; Skip BABYL header.
624 (setq from (point)) 627 (setq from (point))
625 (goto-char (point-max)) 628 (goto-char (point-max))
626 (search-backward "\n\^_" from 'mv) 629 (search-backward "\n\^_" from 'mv)
627 (setq to (point)) 630 (setq to (point))
628 (if (not (and rmail-file-coding-system 631 (unless (and coding-system
629 (coding-system-p rmail-file-coding-system))) 632 (coding-system-p coding-system))
630 (setq rmail-file-coding-system (detect-coding-region from to t))) 633 (setq coding-system (detect-coding-region from to t)))
631 (if (not (eq rmail-file-coding-system 'undecided)) 634 (unless (eq coding-system 'undecided)
632 (let ((count 1)) 635 (decode-coding-region from to coding-system)
633 (goto-char from) 636 (setq coding-system last-coding-system-used))
634 (while (search-forward "\n\^_" nil t) 637 (set-buffer-modified-p modifiedp)
635 (decode-coding-region from (1- (point)) rmail-file-coding-system) 638 (setq buffer-file-coding-system nil)
636 (goto-char (point)) 639 (setq save-buffer-coding-system
637 (setq from (point)) 640 (or coding-system 'undecided))))
638 (if (= (% count 10) 0)
639 (message "Decoding messages...%d" count))
640 (setq count (1+ count)))
641 (message "Decoding messages...done")
642 (set-buffer-file-coding-system rmail-file-coding-system)
643 (set-buffer-modified-p modifiedp)))))
644 641
645(defvar rmail-mode-map nil) 642(defvar rmail-mode-map nil)
646(if rmail-mode-map 643(if rmail-mode-map
@@ -935,6 +932,13 @@ Instead, these commands are available:
935 932
936;; Set up the non-permanent locals associated with Rmail mode. 933;; Set up the non-permanent locals associated with Rmail mode.
937(defun rmail-variables () 934(defun rmail-variables ()
935 (make-local-variable 'save-buffer-coding-system)
936 ;; If we don't already have a value for save-buffer-coding-system,
937 ;; get it from buffer-file-coding-system, and clear that
938 ;; because it should be determined in rmail-show-message.
939 (unless save-buffer-coding-system
940 (setq save-buffer-coding-system (or buffer-file-coding-system 'undecided))
941 (setq buffer-file-coding-system nil))
938 ;; Don't let a local variables list in a message cause confusion. 942 ;; Don't let a local variables list in a message cause confusion.
939 (make-local-variable 'enable-local-variables) 943 (make-local-variable 'enable-local-variables)
940 (setq enable-local-variables nil) 944 (setq enable-local-variables nil)
@@ -942,11 +946,12 @@ Instead, these commands are available:
942 (setq revert-buffer-function 'rmail-revert) 946 (setq revert-buffer-function 'rmail-revert)
943 (make-local-variable 'font-lock-defaults) 947 (make-local-variable 'font-lock-defaults)
944 (setq font-lock-defaults 948 (setq font-lock-defaults
945 '(rmail-font-lock-keywords t nil nil nil 949 '(rmail-font-lock-keywords
946 (font-lock-maximum-size . nil) 950 t nil nil nil
947 (font-lock-fontify-buffer-function . rmail-fontify-buffer-function) 951 (font-lock-maximum-size . nil)
948 (font-lock-unfontify-buffer-function . rmail-unfontify-buffer-function) 952 (font-lock-fontify-buffer-function . rmail-fontify-buffer-function)
949 (font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode)))) 953 (font-lock-unfontify-buffer-function . rmail-unfontify-buffer-function)
954 (font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode))))
950 (make-local-variable 'require-final-newline) 955 (make-local-variable 'require-final-newline)
951 (setq require-final-newline nil) 956 (setq require-final-newline nil)
952 (make-local-variable 'version-control) 957 (make-local-variable 'version-control)
@@ -1459,11 +1464,27 @@ Optional DEFAULT is password to start with."
1459 (save-excursion 1464 (save-excursion
1460 (skip-chars-forward " \t\n") 1465 (skip-chars-forward " \t\n")
1461 (point))) 1466 (point)))
1467 (setq last-coding-system-used nil)
1462 (or rmail-enable-mime 1468 (or rmail-enable-mime
1463 (not rmail-enable-multibyte) 1469 (not rmail-enable-multibyte)
1464 (decode-coding-region start (point) 1470 (decode-coding-region start (point)
1465 (or rmail-file-coding-system 1471 (or rmail-file-coding-system
1466 'undecided))) 1472 'undecided)))
1473 ;; Add an X-Coding-System: header if we don't have one.
1474 (save-excursion
1475 (goto-char start)
1476 (forward-line 1)
1477 (if (looking-at "0")
1478 (forward-line 1)
1479 (forward-line 2))
1480 (or (save-restriction
1481 (narrow-to-region (point) (point-max))
1482 (rfc822-goto-eoh)
1483 (goto-char (point-min))
1484 (re-search-forward "^X-Coding-System:" nil t))
1485 (insert "X-Coding-System: "
1486 (symbol-name last-coding-system-used)
1487 "\n")))
1467 (narrow-to-region (point) (point-max))) 1488 (narrow-to-region (point) (point-max)))
1468 ;;*** MMDF format 1489 ;;*** MMDF format
1469 ((let ((case-fold-search t)) 1490 ((let ((case-fold-search t))
@@ -1478,9 +1499,16 @@ Optional DEFAULT is password to start with."
1478 (goto-char (point-min)) 1499 (goto-char (point-min))
1479 (while (search-forward "\n\^_" nil t); single char "\^_" 1500 (while (search-forward "\n\^_" nil t); single char "\^_"
1480 (replace-match "\n^_")))); 2 chars: "^" and "_" 1501 (replace-match "\n^_")))); 2 chars: "^" and "_"
1502 (setq last-coding-system-used nil)
1481 (or rmail-enable-mime 1503 (or rmail-enable-mime
1482 (not rmail-enable-multibyte) 1504 (not rmail-enable-multibyte)
1483 (decode-coding-region start (point) 'undecided)) 1505 (decode-coding-region start (point) 'undecided))
1506 (save-excursion
1507 (goto-char start)
1508 (forward-line 3)
1509 (insert "X-Coding-System: "
1510 (symbol-name last-coding-system-used)
1511 "\n"))
1484 (narrow-to-region (point) (point-max)) 1512 (narrow-to-region (point) (point-max))
1485 (setq count (1+ count))) 1513 (setq count (1+ count)))
1486 ;;*** Mail format 1514 ;;*** Mail format
@@ -1554,9 +1582,16 @@ Optional DEFAULT is password to start with."
1554 (while (search-forward "\n\^_" nil t); single char 1582 (while (search-forward "\n\^_" nil t); single char
1555 (replace-match "\n^_")))); 2 chars: "^" and "_" 1583 (replace-match "\n^_")))); 2 chars: "^" and "_"
1556 (insert ?\^_) 1584 (insert ?\^_)
1585 (setq last-coding-system-used nil)
1557 (or rmail-enable-mime 1586 (or rmail-enable-mime
1558 (not rmail-enable-multibyte) 1587 (not rmail-enable-multibyte)
1559 (decode-coding-region start (point) 'undecided)) 1588 (decode-coding-region start (point) 'undecided))
1589 (save-excursion
1590 (goto-char start)
1591 (forward-line 3)
1592 (insert "X-Coding-System: "
1593 (symbol-name last-coding-system-used)
1594 "\n"))
1560 (narrow-to-region (point) (point-max))) 1595 (narrow-to-region (point) (point-max)))
1561 ;; 1596 ;;
1562 ;; This kludge is because some versions of sendmail.el 1597 ;; This kludge is because some versions of sendmail.el
@@ -2021,7 +2056,7 @@ If summary buffer is currently displayed, update current message there also."
2021 (progn (narrow-to-region (point-min) (1- (point-max))) 2056 (progn (narrow-to-region (point-min) (1- (point-max)))
2022 (goto-char (point-min)) 2057 (goto-char (point-min))
2023 (setq mode-line-process nil)) 2058 (setq mode-line-process nil))
2024 (let (blurb) 2059 (let (blurb coding-system)
2025 (if (not n) 2060 (if (not n)
2026 (setq n rmail-current-message) 2061 (setq n rmail-current-message)
2027 (cond ((<= n 0) 2062 (cond ((<= n 0)
@@ -2037,10 +2072,25 @@ If summary buffer is currently displayed, update current message there also."
2037 (let ((beg (rmail-msgbeg n))) 2072 (let ((beg (rmail-msgbeg n)))
2038 (goto-char beg) 2073 (goto-char beg)
2039 (forward-line 1) 2074 (forward-line 1)
2075 (save-excursion
2076 (let ((end (rmail-msgend n)))
2077 (save-restriction
2078 (if (prog1 (= (following-char) ?0)
2079 (forward-line 2)
2080 (narrow-to-region (point) end))
2081 (rfc822-goto-eoh)
2082 (search-forward "\n*** EOOH ***\n" end t))
2083 (narrow-to-region beg (point))
2084 (goto-char (point-min))
2085 (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
2086 (let ((coding-system (intern (match-string 1))))
2087 (check-coding-system coding-system)
2088 (setq buffer-file-coding-system coding-system))
2089 (setq buffer-file-coding-system nil)))))
2040 ;; Clear the "unseen" attribute when we show a message. 2090 ;; Clear the "unseen" attribute when we show a message.
2041 (rmail-set-attribute "unseen" nil) 2091 (rmail-set-attribute "unseen" nil)
2042 ;; Reformat the header, or else find the reformatted header.
2043 (let ((end (rmail-msgend n))) 2092 (let ((end (rmail-msgend n)))
2093 ;; Reformat the header, or else find the reformatted header.
2044 (if (= (following-char) ?0) 2094 (if (= (following-char) ?0)
2045 (rmail-reformat-message beg end) 2095 (rmail-reformat-message beg end)
2046 (search-forward "\n*** EOOH ***\n" end t) 2096 (search-forward "\n*** EOOH ***\n" end t)