[Emacs-diffs] emacs/lisp/mail rmail.el

[Chong Yidong]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Chong Yidong <cyd>      09/01/29 02:46:21

Modified files:
        lisp/mail      : rmail.el 

Log message:
        (rmail-redecode-body): New function, based on old version removed in
        2009-01-22 change.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/mail/rmail.el?cvsroot=emacs&r1=1.475&r2=1.476

Patches:
Index: rmail.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/mail/rmail.el,v
retrieving revision 1.475
retrieving revision 1.476
diff -u -b -r1.475 -r1.476
--- rmail.el    28 Jan 2009 15:54:46 -0000      1.475
+++ rmail.el    29 Jan 2009 02:46:21 -0000      1.476
@@ -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.