Mercurial > emacs

changeset 101626:feacaf76f65e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(rmail-redecode-body): New function, based on old version removed in 2009-01-22 change.
author Chong Yidong <cyd@stupidchicken.com>
date Thu, 29 Jan 2009 02:46:21 +0000
parents 735f6ac16d84
children e981ad018a7c
files lisp/mail/rmail.el
diffstat 1 files changed, 94 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/mail/rmail.el	Thu Jan 29 02:41:47 2009 +0000
+++ b/lisp/mail/rmail.el	Thu Jan 29 02:46:21 2009 +0000
@@ -2619,6 +2619,100 @@
 		(goto-char lim))))
 	   (t (error "No headers selected for display!"))))))))
 
+(defun rmail-redecode-body (coding &optional raw)
+  "Decode the body of the current message using coding system CODING.
+This is useful with mail messages that have malformed or missing
+charset= headers.
+
+This function assumes that the current message is already decoded
+and displayed in the RMAIL buffer, but the coding system used to
+decode it was incorrect.  It then encodes the message back to its
+original form, and decodes it again, using the coding system CODING.
+
+Optional argument RAW, if non-nil, means don't encode the message
+before decoding it with the new CODING.  This is useful if the current
+message text was produced by some function which invokes `insert',
+since `insert' leaves unibyte character codes 128 through 255 unconverted
+to multibyte.  One example of such a situation is when the text was
+produced by `base64-decode-region'.
+
+Interactively, invoke the function with a prefix argument to set RAW
+non-nil.
+
+Note that if Emacs erroneously auto-detected one of the iso-2022
+encodings in the message, this function might fail because the escape
+sequences that switch between character sets and also single-shift and
+locking-shift codes are impossible to recover.  This function is meant
+to be used to fix messages encoded with 8-bit encodings, such as
+iso-8859, koi8-r, etc."
+  (interactive "zCoding system for re-decoding this message: ")
+  (when (not rmail-enable-mime)
+    (save-excursion
+      (set-buffer rmail-buffer)
+      (rmail-swap-buffers-maybe)
+      (save-restriction
+	(widen)
+	(let ((raw (or raw current-prefix-arg))
+	      (msgbeg (rmail-msgbeg rmail-current-message))
+	      (msgend (rmail-msgend rmail-current-message))
+	      (buffer-read-only nil)
+	      body-start x-coding-header old-coding)
+	  (narrow-to-region msgbeg msgend)
+	  (goto-char (point-min))
+	  (unless (setq body-start (search-forward "\n\n" (point-max) 1))
+	    (error "No message body"))
+
+	  (save-restriction
+	    ;; Narrow to headers
+	    (narrow-to-region (point-min) body-start)
+	    (goto-char (point-min))
+	    (unless (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
+	      (error "No X-Coding-System header found"))
+	    (setq old-coding (intern (match-string 1)))
+	    (check-coding-system old-coding)
+	    ;; Make sure the new coding system uses the same EOL
+	    ;; conversion, to prevent ^M characters from popping up
+	    ;; all over the place.
+	    (setq coding
+		  (coding-system-change-eol-conversion
+		   coding (coding-system-eol-type old-coding)))
+	    ;; If old-coding is `undecided', encode-coding-region
+	    ;; will not encode the text at all.  Find a proper
+	    ;; non-trivial encoding to use.
+	    (when (memq (coding-system-base old-coding) '(nil undecided))
+	      (setq old-coding
+		    (car (find-coding-systems-region msgbeg msgend))))
+	    (setq x-coding-header (point)))
+
+	  (save-restriction
+	    ;; Narrow to message body
+	    (narrow-to-region body-start (point-max))
+	    (and (null raw)
+		 ;; If old and new encoding are the same, it
+		 ;; clearly doesn't make sense to encode.
+		 (not (coding-system-equal
+		       (coding-system-base old-coding)
+		       (coding-system-base coding)))
+		 ;; If the body includes only eight-bit-*
+		 ;; characters, encoding might fail, e.g. with
+		 ;; UTF-8, and isn't needed anyway.
+		 (> (length (delq 'ascii
+				  (delq 'eight-bit-graphic
+					(delq 'eight-bit-control
+					      (find-charset-region
+					       (point-min) (point-max))))))
+		    0)
+		 (encode-coding-region (point-min) (point-max) old-coding))
+	    (decode-coding-region (point-min) (point-max) coding)
+	    (setq last-coding-system-used coding))
+
+	  ;; Rewrite the coding-system header.
+	  (goto-char x-coding-header)
+	  (delete-region (line-beginning-position) (point))
+	  (insert "X-Coding-System: "
+		  (symbol-name last-coding-system-used))
+	  (rmail-show-message-maybe))))))
+
 ;; Find all occurrences of certain fields, and highlight them.
 (defun rmail-highlight-headers ()
   ;; Do this only if the system supports faces.