mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-23 07:19:15 +00:00
(rmail-redecode-body): New function, based on old version removed in
2009-01-22 change.
This commit is contained in:
parent
fce18d3861
commit
2e55c1b7bb
@ -2619,6 +2619,100 @@ buffer to the end of the headers."
|
||||
(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.
|
||||
|
Loading…
Reference in New Issue
Block a user