;;; mm-bodies.el --- Functions for decoding MIME things
-;; Copyright (C) 1998, 1999, 2000, 2001
+;; Copyright (C) 1998, 1999, 2000, 2001, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(defcustom mm-body-charset-encoding-alist
'((iso-2022-jp . 7bit)
- (iso-2022-jp-2 . 7bit))
+ (iso-2022-jp-2 . 7bit)
+ ;; We MUST encode UTF-16 because it can contain \0's which is
+ ;; known to break servers.
+ (utf-16 . base64)
+ (utf-16be . base64)
+ (utf-16le . base64))
"Alist of MIME charsets to encodings.
Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'."
:type '(repeat (cons (symbol :tag "charset")
charset)
(goto-char (point-min))
(let ((charsets (mm-find-mime-charset-region (point-min) (point-max)
- mm-hack-charsets))
- start)
+ mm-hack-charsets)))
(cond
;; No encoding.
((null charsets)
charsets)
;; We encode.
(t
- (setq charset (car charsets))
- (while (not (eobp))
- (if (eq (mm-charset-after) 'ascii)
- (when start
- (save-restriction
- (narrow-to-region start (point))
- (mm-encode-coding-region
- start (point) (mm-charset-to-coding-system charset))
- (goto-char (point-max)))
- (setq start nil))
- (unless start
- (setq start (point))))
- (forward-char 1))
- (when start
- (mm-encode-coding-region start (point)
- (mm-charset-to-coding-system charset))
- (setq start nil))
- charset)))))))
+ (prog1
+ (setq charset (car charsets))
+ (mm-encode-coding-region (point-min) (point-max)
+ (mm-charset-to-coding-system charset))))
+ ))))))
(defun mm-long-lines-p (length)
"Say whether any of the lines in the buffer is longer than LINES."
bits)
((and (not mm-use-ultra-safe-encoding)
(not longp)
+ (not (cdr (assq charset mm-body-charset-encoding-alist)))
(or (eq t (cdr message-posting-charset))
(memq charset (cdr message-posting-charset))
(eq charset mail-parse-charset)))
(require 'mm-uu)
(funcall mm-uu-binhex-decode-function (point-min) (point-max))
t)
+ ((eq encoding 'x-yenc)
+ (require 'mm-uu)
+ (funcall mm-uu-yenc-decode-function (point-min) (point-max))
+ )
((functionp encoding)
(funcall encoding (point-min) (point-max))
t)
(message "Error while decoding: %s" error)
nil))
(when (and
- (memq encoding '(base64 x-uuencode x-uue x-binhex))
+ (memq encoding '(base64 x-uuencode x-uue x-binhex x-yenc))
(equal type "text/plain"))
(goto-char (point-min))
(while (search-forward "\r\n" nil t)
(replace-match "\n" t t)))))
-(defun mm-decode-body (charset &optional encoding type)
+(defun mm-decode-body (charset &optional encoding type force)
"Decode the current article that has been encoded with ENCODING.
-The characters in CHARSET should then be decoded."
- (if (stringp charset)
+The characters in CHARSET should then be decoded. If FORCE is non-nil
+use the supplied charset unconditionally."
+ (let ((charset-supplied charset))
+ (when (stringp charset)
(setq charset (intern (downcase charset))))
- (if (or (not charset)
- (eq 'gnus-all mail-parse-ignored-charsets)
- (memq 'gnus-all mail-parse-ignored-charsets)
- (memq charset mail-parse-ignored-charsets))
- (setq charset mail-parse-charset))
- (save-excursion
- (when encoding
- (mm-decode-content-transfer-encoding encoding type))
- (when (featurep 'mule)
- (let ((coding-system (mm-charset-to-coding-system charset)))
- (if (and (not coding-system)
- (listp mail-parse-ignored-charsets)
- (memq 'gnus-unknown mail-parse-ignored-charsets))
- (setq coding-system
- (mm-charset-to-coding-system mail-parse-charset)))
- (when (and charset coding-system
- ;; buffer-file-coding-system
- ;;Article buffer is nil coding system
- ;;in XEmacs
- (mm-multibyte-p)
- (or (not (eq coding-system 'ascii))
- (setq coding-system mail-parse-charset))
- (not (eq coding-system 'gnus-decoded)))
- (mm-decode-coding-region (point-min) (point-max) coding-system))))))
+ (when (or (not charset)
+ (eq 'gnus-all mail-parse-ignored-charsets)
+ (memq 'gnus-all mail-parse-ignored-charsets)
+ (memq charset mail-parse-ignored-charsets))
+ (setq charset mail-parse-charset
+ charset-supplied nil))
+ (save-excursion
+ (when encoding
+ (mm-decode-content-transfer-encoding encoding type))
+ (when (featurep 'mule)
+ (let ((coding-system (mm-charset-to-coding-system charset)))
+ (if (and (not coding-system)
+ (listp mail-parse-ignored-charsets)
+ (memq 'gnus-unknown mail-parse-ignored-charsets))
+ (setq coding-system
+ (mm-charset-to-coding-system mail-parse-charset)))
+ (when (and charset coding-system
+ ;; buffer-file-coding-system
+ ;;Article buffer is nil coding system
+ ;;in XEmacs
+ (mm-multibyte-p)
+ (or (not (eq coding-system 'ascii))
+ (setq coding-system mail-parse-charset))
+ (not (eq coding-system 'gnus-decoded)))
+ (if (or force
+ ;; If a charset was supplied, then use the
+ ;; supplied charset unconditionally.
+ charset-supplied)
+ (mm-decode-coding-region (point-min) (point-max)
+ coding-system)
+ ;; Otherwise allow Emacs to auto-detect the charset.
+ (mm-decode-coding-region-safely (point-min) (point-max)
+ coding-system)))
+ (setq buffer-file-coding-system
+ (if (boundp 'last-coding-system-used)
+ (symbol-value 'last-coding-system-used)
+ coding-system)))))))
+
+(defun mm-decode-coding-region-safely (start end coding-system)
+ "Decode region between START and END with CODING-SYSTEM.
+If CODING-SYSTEM is not a valid coding system for the text, let Emacs
+decide which coding system to use."
+ (let* ((orig (buffer-substring start end))
+ charsets)
+ (save-restriction
+ (narrow-to-region start end)
+ (mm-decode-coding-region (point-min) (point-max) coding-system)
+ (setq charsets (find-charset-region (point-min) (point-max)))
+ (when (or (memq 'eight-bit-control charsets)
+ (memq 'eight-bit-graphic charsets))
+ (delete-region (point-min) (point-max))
+ (insert orig)
+ (mm-decode-coding-region (point-min) (point-max) 'undecided)))))
(defun mm-decode-string (string charset)
"Decode STRING with CHARSET."
projects / elisp / gnus.git- / blobdiff