diff options
| author | Eli Zaretskii | 2009-02-07 16:46:27 +0000 |
|---|---|---|
| committer | Eli Zaretskii | 2009-02-07 16:46:27 +0000 |
| commit | fc9682ad97b315f3fef0377e342aa1368b0ffe43 (patch) | |
| tree | bc2518db8671b5515e9727505fe62c69d61ac82b | |
| parent | 7197f5de6fc84b7da74183e2b87eab9bb593fe5c (diff) | |
| download | emacs-fc9682ad97b315f3fef0377e342aa1368b0ffe43.tar.gz emacs-fc9682ad97b315f3fef0377e342aa1368b0ffe43.zip | |
(rmail-redecode-body): Don't encode/decode the message; instead, just rewrite
the X-Coding-System header with the new encoding, and let rmail-show-message
do the rest. Remove unused argument RAW. Fix doc string to be consistent
with the new implementation.
(rmail-show-message): Honor X-Coding-System header, if present, in preference
to Content-Type header.
| -rw-r--r-- | lisp/ChangeLog | 10 | ||||
| -rw-r--r-- | lisp/mail/rmail.el | 88 |
2 files changed, 36 insertions, 62 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d9ff7e63911..a15576965b5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,13 @@ | |||
| 1 | 2009-02-07 Eli Zaretskii <eliz@gnu.org> | ||
| 2 | |||
| 3 | * mail/rmail.el (rmail-redecode-body): Don't encode/decode the | ||
| 4 | message; instead, just rewrite the X-Coding-System header with the | ||
| 5 | new encoding, and let rmail-show-message do the rest. Remove | ||
| 6 | unused argument RAW. Fix doc string to be consistent with the new | ||
| 7 | implementation. | ||
| 8 | (rmail-show-message): Honor X-Coding-System header, if present, in | ||
| 9 | preference to Content-Type header. | ||
| 10 | |||
| 1 | 2009-02-07 Stefan Monnier <monnier@iro.umontreal.ca> | 11 | 2009-02-07 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 12 | ||
| 3 | * server.el (server-execute): Enable quit. | 13 | * server.el (server-execute): Enable quit. |
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index ab8490938d3..947564773ff 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el | |||
| @@ -2549,9 +2549,12 @@ The current mail message becomes the message displayed." | |||
| 2549 | (setq body-start (search-forward "\n\n" nil t)) | 2549 | (setq body-start (search-forward "\n\n" nil t)) |
| 2550 | (narrow-to-region beg (point)) | 2550 | (narrow-to-region beg (point)) |
| 2551 | (goto-char beg) | 2551 | (goto-char beg) |
| 2552 | (save-excursion | ||
| 2553 | (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) | ||
| 2554 | (setq coding-system (intern (match-string 1))) | ||
| 2555 | (setq coding-system (rmail-get-coding-system)))) | ||
| 2552 | (setq character-coding (mail-fetch-field "content-transfer-encoding") | 2556 | (setq character-coding (mail-fetch-field "content-transfer-encoding") |
| 2553 | is-text-message (rmail-is-text-p) | 2557 | is-text-message (rmail-is-text-p)) |
| 2554 | coding-system (rmail-get-coding-system)) | ||
| 2555 | (if character-coding | 2558 | (if character-coding |
| 2556 | (setq character-coding (downcase character-coding))) | 2559 | (setq character-coding (downcase character-coding))) |
| 2557 | (narrow-to-region beg end) | 2560 | (narrow-to-region beg end) |
| @@ -2666,40 +2669,22 @@ buffer to the end of the headers." | |||
| 2666 | (goto-char lim)))) | 2669 | (goto-char lim)))) |
| 2667 | (t (error "No headers selected for display!")))))))) | 2670 | (t (error "No headers selected for display!")))))))) |
| 2668 | 2671 | ||
| 2669 | (defun rmail-redecode-body (coding &optional raw) | 2672 | (defun rmail-redecode-body (coding) |
| 2670 | "Decode the body of the current message using coding system CODING. | 2673 | "Decode the body of the current message using coding system CODING. |
| 2671 | This is useful with mail messages that have malformed or missing | 2674 | This is useful with mail messages that have malformed or missing |
| 2672 | charset= headers. | 2675 | charset= headers. |
| 2673 | 2676 | ||
| 2674 | This function assumes that the current message is already decoded | 2677 | This function assumes that the current message is already decoded |
| 2675 | and displayed in the RMAIL buffer, but the coding system used to | 2678 | and displayed in the RMAIL buffer, but the coding system used to |
| 2676 | decode it was incorrect. It then encodes the message back to its | 2679 | decode it was incorrect. It then decodes the message again, |
| 2677 | original form, and decodes it again, using the coding system CODING. | 2680 | using the coding system CODING." |
| 2678 | |||
| 2679 | Optional argument RAW, if non-nil, means don't encode the message | ||
| 2680 | before decoding it with the new CODING. This is useful if the current | ||
| 2681 | message text was produced by some function which invokes `insert', | ||
| 2682 | since `insert' leaves unibyte character codes 128 through 255 unconverted | ||
| 2683 | to multibyte. One example of such a situation is when the text was | ||
| 2684 | produced by `base64-decode-region'. | ||
| 2685 | |||
| 2686 | Interactively, invoke the function with a prefix argument to set RAW | ||
| 2687 | non-nil. | ||
| 2688 | |||
| 2689 | Note that if Emacs erroneously auto-detected one of the iso-2022 | ||
| 2690 | encodings in the message, this function might fail because the escape | ||
| 2691 | sequences that switch between character sets and also single-shift and | ||
| 2692 | locking-shift codes are impossible to recover. This function is meant | ||
| 2693 | to be used to fix messages encoded with 8-bit encodings, such as | ||
| 2694 | iso-8859, koi8-r, etc." | ||
| 2695 | (interactive "zCoding system for re-decoding this message: ") | 2681 | (interactive "zCoding system for re-decoding this message: ") |
| 2696 | (when (not rmail-enable-mime) | 2682 | (when (not rmail-enable-mime) |
| 2697 | (with-current-buffer rmail-buffer | 2683 | (with-current-buffer rmail-buffer |
| 2698 | (rmail-swap-buffers-maybe) | 2684 | (rmail-swap-buffers-maybe) |
| 2699 | (save-restriction | 2685 | (save-restriction |
| 2700 | (widen) | 2686 | (widen) |
| 2701 | (let ((raw (or raw current-prefix-arg)) | 2687 | (let ((msgbeg (rmail-msgbeg rmail-current-message)) |
| 2702 | (msgbeg (rmail-msgbeg rmail-current-message)) | ||
| 2703 | (msgend (rmail-msgend rmail-current-message)) | 2688 | (msgend (rmail-msgend rmail-current-message)) |
| 2704 | (buffer-read-only nil) | 2689 | (buffer-read-only nil) |
| 2705 | body-start x-coding-header old-coding) | 2690 | body-start x-coding-header old-coding) |
| @@ -2711,10 +2696,11 @@ iso-8859, koi8-r, etc." | |||
| 2711 | (save-restriction | 2696 | (save-restriction |
| 2712 | ;; Narrow to headers | 2697 | ;; Narrow to headers |
| 2713 | (narrow-to-region (point-min) body-start) | 2698 | (narrow-to-region (point-min) body-start) |
| 2714 | (goto-char (point-min)) | 2699 | (setq x-coding-header (goto-char (point-min))) |
| 2715 | (unless (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) | 2700 | (if (not (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)) |
| 2716 | (error "No X-Coding-System header found")) | 2701 | (setq old-coding (rmail-get-coding-system)) |
| 2717 | (setq old-coding (intern (match-string 1))) | 2702 | (setq old-coding (intern (match-string 1))) |
| 2703 | (setq x-coding-header (point))) | ||
| 2718 | (check-coding-system old-coding) | 2704 | (check-coding-system old-coding) |
| 2719 | ;; Make sure the new coding system uses the same EOL | 2705 | ;; Make sure the new coding system uses the same EOL |
| 2720 | ;; conversion, to prevent ^M characters from popping up | 2706 | ;; conversion, to prevent ^M characters from popping up |
| @@ -2723,40 +2709,18 @@ iso-8859, koi8-r, etc." | |||
| 2723 | (if (numberp eol-type) | 2709 | (if (numberp eol-type) |
| 2724 | (setq coding | 2710 | (setq coding |
| 2725 | (coding-system-change-eol-conversion coding eol-type)))) | 2711 | (coding-system-change-eol-conversion coding eol-type)))) |
| 2726 | ;; If old-coding is `undecided', encode-coding-region | 2712 | (when (not (coding-system-equal |
| 2727 | ;; will not encode the text at all. Find a proper | 2713 | (coding-system-base old-coding) |
| 2728 | ;; non-trivial encoding to use. | 2714 | (coding-system-base coding))) |
| 2729 | (when (memq (coding-system-base old-coding) '(nil undecided)) | 2715 | ;; Rewrite the coding-system header. |
| 2730 | (setq old-coding | 2716 | (goto-char x-coding-header) |
| 2731 | (car (find-coding-systems-region msgbeg msgend)))) | 2717 | (if (> (point) (point-min)) |
| 2732 | (setq x-coding-header (point))) | 2718 | (delete-region (line-beginning-position) (point)) |
| 2733 | 2719 | (forward-line) | |
| 2734 | (save-restriction | 2720 | (insert "\n") |
| 2735 | ;; Narrow to message body | 2721 | (forward-line -1)) |
| 2736 | (narrow-to-region body-start (point-max)) | 2722 | (insert "X-Coding-System: " |
| 2737 | (and (null raw) | 2723 | (symbol-name coding)))) |
| 2738 | ;; If old and new encoding are the same, it | ||
| 2739 | ;; clearly doesn't make sense to encode. | ||
| 2740 | (not (coding-system-equal | ||
| 2741 | (coding-system-base old-coding) | ||
| 2742 | (coding-system-base coding))) | ||
| 2743 | ;; If the body includes only eight-bit characters, | ||
| 2744 | ;; encoding might fail, e.g. with UTF-8, and isn't | ||
| 2745 | ;; needed anyway. | ||
| 2746 | (> (length (delq 'ascii | ||
| 2747 | (delq 'eight-bit | ||
| 2748 | (find-charset-region | ||
| 2749 | (point-min) (point-max))))) | ||
| 2750 | 0) | ||
| 2751 | (encode-coding-region (point-min) (point-max) old-coding)) | ||
| 2752 | (decode-coding-region (point-min) (point-max) coding) | ||
| 2753 | (setq last-coding-system-used coding)) | ||
| 2754 | |||
| 2755 | ;; Rewrite the coding-system header. | ||
| 2756 | (goto-char x-coding-header) | ||
| 2757 | (delete-region (line-beginning-position) (point)) | ||
| 2758 | (insert "X-Coding-System: " | ||
| 2759 | (symbol-name last-coding-system-used)) | ||
| 2760 | (rmail-show-message-maybe)))))) | 2724 | (rmail-show-message-maybe)))))) |
| 2761 | 2725 | ||
| 2762 | ;; Find all occurrences of certain fields, and highlight them. | 2726 | ;; Find all occurrences of certain fields, and highlight them. |