Mercurial > emacs
diff lisp/gnus/mm-bodies.el @ 82951:0fde48feb604
Import Gnus 5.10 from the v5_10 branch of the Gnus repository.
author | Andreas Schwab <schwab@suse.de> |
---|---|
date | Thu, 22 Jul 2004 16:45:51 +0000 |
parents | 695cf19ef79e |
children | c5e16264557d cce1c0ee76ee |
line wrap: on
line diff
--- a/lisp/gnus/mm-bodies.el Thu Jul 22 14:26:26 2004 +0000 +++ b/lisp/gnus/mm-bodies.el Thu Jul 22 16:45:51 2004 +0000 @@ -1,5 +1,7 @@ -;;; mm-bodies.el --- functions for decoding MIME things -;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc. +;;; mm-bodies.el --- Functions for decoding MIME things + +;; Copyright (C) 1998, 1999, 2000, 2001, 2003 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> @@ -42,7 +44,14 @@ (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. + ;; Note: UTF-16 variants are invalid for text parts [RFC 2781], + ;; so this can't happen :-/. + (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") @@ -53,51 +62,82 @@ (const base64)))) :group 'mime) -(defun mm-encode-body () +(defun mm-encode-body (&optional charset) "Encode a body. Should be called narrowed to the body that is to be encoded. -If there is more than one non-ASCII Mule charset, then the list of found -Mule charsets is returned. +If there is more than one non-ASCII MULE charset in the body, then the +list of MULE charsets found is returned. +If CHARSET is non-nil, it is used as the MIME charset to encode the body. If successful, the MIME charset is returned. If no encoding was done, nil is returned." (if (not (mm-multibyte-p)) ;; In the non-Mule case, we search for non-ASCII chars and ;; return the value of `mail-parse-charset' if any are found. - (save-excursion - (goto-char (point-min)) - (if (re-search-forward "[^\x0-\x7f]" nil t) - (or mail-parse-charset - (mm-read-charset "Charset used in the article: ")) - ;; The logic in `mml-generate-mime-1' confirms that it's OK - ;; to return nil here. - nil)) + (or charset + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "[^\x0-\x7f]" nil t) + (or mail-parse-charset + (message-options-get 'mm-encody-body-charset) + (message-options-set + 'mm-encody-body-charset + (mm-read-coding-system "Charset used in the article: "))) + ;; The logic in `mml-generate-mime-1' confirms that it's OK + ;; to return nil here. + nil))) (save-excursion - (goto-char (point-min)) - (let ((charsets (mm-find-mime-charset-region (point-min) (point-max)))) - (cond - ;; No encoding. - ((null charsets) - nil) - ;; Too many charsets. - ((> (length charsets) 1) - charsets) - ;; We encode. - (t - (mm-encode-coding-region (point-min) (point-max) - (mm-charset-to-coding-system - (car charsets))) - (car charsets))))))) + (if charset + (progn + (mm-encode-coding-region (point-min) (point-max) charset) + charset) + (goto-char (point-min)) + (let ((charsets (mm-find-mime-charset-region (point-min) (point-max) + mm-hack-charsets))) + (cond + ;; No encoding. + ((null charsets) + nil) + ;; Too many charsets. + ((> (length charsets) 1) + charsets) + ;; We encode. + (t + (prog1 + (setq charset (car charsets)) + (mm-encode-coding-region (point-min) (point-max) + (mm-charset-to-coding-system charset)))) + )))))) -(eval-when-compile (defvar message-posting-charset)) +(defun mm-long-lines-p (length) + "Say whether any of the lines in the buffer is longer than LENGTH." + (save-excursion + (goto-char (point-min)) + (end-of-line) + (while (and (not (eobp)) + (not (> (current-column) length))) + (forward-line 1) + (end-of-line)) + (and (> (current-column) length) + (current-column)))) + +(defvar message-posting-charset) (defun mm-body-encoding (charset &optional encoding) "Do Content-Transfer-Encoding and return the encoding of the current buffer." - (let ((bits (mm-body-7-or-8))) + (when (stringp encoding) + (setq encoding (intern (downcase encoding)))) + (let ((bits (mm-body-7-or-8)) + (longp (mm-long-lines-p 1000))) (require 'message) (cond - ((and (not mm-use-ultra-safe-encoding) (eq bits '7bit)) + ((and (not longp) + (not (and mm-use-ultra-safe-encoding + (save-excursion (re-search-forward "^From " nil t)))) + (eq bits '7bit)) 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))) @@ -124,12 +164,17 @@ ;;; Functions for decoding ;;; +(eval-when-compile (defvar mm-uu-yenc-decode-function)) + (defun mm-decode-content-transfer-encoding (encoding &optional type) + "Decodes buffer encoded with ENCODING, returning success status. +If TYPE is `text/plain' CRLF->LF translation may occur." (prog1 (condition-case error (cond ((eq encoding 'quoted-printable) - (quoted-printable-decode-region (point-min) (point-max))) + (quoted-printable-decode-region (point-min) (point-max)) + t) ((eq encoding 'base64) (base64-decode-region (point-min) @@ -144,49 +189,57 @@ (delete-region (match-beginning 0) (match-end 0))) (goto-char (point-max)) (when (re-search-backward "^[A-Za-z0-9+/]+=*[\t ]*$" nil t) - (forward-line) - (delete-region (point) (point-max))) - (point-max)))) + (forward-line)) + (point)))) ((memq encoding '(7bit 8bit binary)) ;; Do nothing. - ) + t) ((null encoding) ;; Do nothing. - ) + t) ((memq encoding '(x-uuencode x-uue)) (require 'mm-uu) - (funcall mm-uu-decode-function (point-min) (point-max))) + (funcall mm-uu-decode-function (point-min) (point-max)) + t) ((eq encoding 'x-binhex) (require 'mm-uu) - (funcall mm-uu-binhex-decode-function (point-min) (point-max))) + (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))) + (funcall encoding (point-min) (point-max)) + t) (t (message "Unknown encoding %s; defaulting to 8bit" encoding))) (error (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) - "Decode the current article that has been encoded with ENCODING. -The characters in CHARSET should then be decoded." - (if (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)) + "Decode the current article that has been encoded with ENCODING to CHARSET. +ENCODING is a MIME content transfer encoding. +CHARSET is the MIME charset with which to decode the data after transfer +decoding. If it is nil, default to `mail-parse-charset'." + (when (stringp charset) + (setq charset (intern (downcase charset)))) + (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)) (save-excursion (when encoding (mm-decode-content-transfer-encoding encoding type)) - (when (featurep 'mule) + (when (featurep 'mule) ; Fixme: Wrong test for unibyte session. (let ((coding-system (mm-charset-to-coding-system charset))) (if (and (not coding-system) (listp mail-parse-ignored-charsets) @@ -201,7 +254,12 @@ (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)))))) + (mm-decode-coding-region (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-string (string charset) "Decode STRING with CHARSET."