aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorEli Zaretskii2009-02-07 16:46:27 +0000
committerEli Zaretskii2009-02-07 16:46:27 +0000
commitfc9682ad97b315f3fef0377e342aa1368b0ffe43 (patch)
treebc2518db8671b5515e9727505fe62c69d61ac82b
parent7197f5de6fc84b7da74183e2b87eab9bb593fe5c (diff)
downloademacs-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/ChangeLog10
-rw-r--r--lisp/mail/rmail.el88
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 @@
12009-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
12009-02-07 Stefan Monnier <monnier@iro.umontreal.ca> 112009-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.
2671This is useful with mail messages that have malformed or missing 2674This is useful with mail messages that have malformed or missing
2672charset= headers. 2675charset= headers.
2673 2676
2674This function assumes that the current message is already decoded 2677This function assumes that the current message is already decoded
2675and displayed in the RMAIL buffer, but the coding system used to 2678and displayed in the RMAIL buffer, but the coding system used to
2676decode it was incorrect. It then encodes the message back to its 2679decode it was incorrect. It then decodes the message again,
2677original form, and decodes it again, using the coding system CODING. 2680using the coding system CODING."
2678
2679Optional argument RAW, if non-nil, means don't encode the message
2680before decoding it with the new CODING. This is useful if the current
2681message text was produced by some function which invokes `insert',
2682since `insert' leaves unibyte character codes 128 through 255 unconverted
2683to multibyte. One example of such a situation is when the text was
2684produced by `base64-decode-region'.
2685
2686Interactively, invoke the function with a prefix argument to set RAW
2687non-nil.
2688
2689Note that if Emacs erroneously auto-detected one of the iso-2022
2690encodings in the message, this function might fail because the escape
2691sequences that switch between character sets and also single-shift and
2692locking-shift codes are impossible to recover. This function is meant
2693to be used to fix messages encoded with 8-bit encodings, such as
2694iso-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.