X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmm-bodies.el;h=ee14049e3601e878846dc354abd54082f6fec3b0;hb=30e5707a7503b9147f566e53163484a99bdb83e9;hp=19cd5a498a826fa7af73787121c25871c3b9b54f;hpb=3738187cad20787b5b99c4061256e30e19ee721a;p=elisp%2Fgnus.git- diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 19cd5a4..ee14049 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -1,6 +1,6 @@ ;;; 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 @@ -44,7 +44,12 @@ (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") @@ -85,8 +90,7 @@ If no encoding was done, nil is returned." 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) @@ -96,24 +100,11 @@ If no encoding was done, nil is returned." 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." @@ -143,6 +134,7 @@ If no encoding was done, nil is returned." 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))) @@ -223,6 +215,10 @@ If TYPE is `text/plain' CRLF->LF translation may occur." (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) @@ -232,41 +228,72 @@ If TYPE is `text/plain' CRLF->LF translation may occur." (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."