(rmail-redecode-body): New function.

1 files changed, 60 insertions, 0 deletions

diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index dfe32731794..e6bb8b3acf7 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -2257,6 +2257,66 @@ If summary buffer is currently displayed, update current message there also."
 	(if blurb
 	    (message blurb))))))
 
+(defun rmail-redecode-body (coding)
+  "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 you
+supply at the prompt.
+
+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)
+    (or (eq major-mode 'rmail-mode)
+	(switch-to-buffer rmail-buffer))
+    (save-excursion
+      (unwind-protect
+	  (let ((msgbeg (rmail-msgbeg rmail-current-message))
+		(msgend (rmail-msgend rmail-current-message))
+		x-coding-header)
+	    (narrow-to-region msgbeg msgend)
+	    (goto-char (point-min))
+	    (when (search-forward "\n*** EOOH ***\n" (point-max) t)
+	      (narrow-to-region msgbeg (point)))
+	    (goto-char (point-min))
+	    (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
+		(let ((old-coding (intern (match-string 1)))
+		      (buffer-read-only nil))
+		  (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)))
+		  (setq x-coding-header (point-marker))
+		  (narrow-to-region msgbeg msgend)
+		  (encode-coding-region (point) msgend old-coding)
+		  (decode-coding-region (point) msgend coding)
+		  (setq last-coding-system-used coding)
+		  ;; Rewrite the coding-system header according
+		  ;; to what we did.
+ 		  (goto-char x-coding-header)
+		  (delete-region (point)
+				 (save-excursion
+				   (beginning-of-line)
+				   (point)))
+		  (insert "X-Coding-System: "
+			  (symbol-name last-coding-system-used))
+		  (set-marker x-coding-header nil)
+		  (rmail-show-message))
+	      (error "No X-Coding-System header found")))))))
+
 ;; Find all occurrences of certain fields, and highlight them.
 (defun rmail-highlight-headers ()
   ;; Do this only if the system supports faces.