diff options
| author | Richard M. Stallman | 1998-05-12 23:26:17 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1998-05-12 23:26:17 +0000 |
| commit | 578b64159bae7983efc2f943b1f4a5bcfdf9492d (patch) | |
| tree | d9ae6ccada3374c8da92df7800e961b67be8942a | |
| parent | 15cfd6226a422a3fa1953980cfe6ff7d0814cdae (diff) | |
| download | emacs-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.el | 108 |
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.) | |||
| 134 | It is useful to set this variable in the site customization file.") | 135 | It 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 -*- |
| 609 | Version: 5 | 611 | Version: 5 |
| 610 | Labels: | 612 | Labels: |
| @@ -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) |