(rmail-redecode-body): New function.

2 files changed, 62 insertions, 0 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 403d179f34e..bd39533b70b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,7 @@
 2001-01-22  Eli Zaretskii  <eliz@is.elta.co.il>
 
+        * mail/rmail.el (rmail-redecode-body): New function.
+
         * icomplete.el (icomplete-minibuffer-setup-hook): Doc fix.
 
 2001-01-22  Gerd Moellmann  <gerd@gnu.org>
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.