X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmm-bodies.el;h=80e910ffab64a7cd2ced250d8c943d2984438a6e;hb=c6627e16c2d70435726f15bb606c7dee407c494f;hp=810185c7993e6edb498118bd1d1ed936d312df5e;hpb=4f50fd1d90e44dd18352db42a90994350c4c0515;p=gnus diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 810185c79..80e910ffa 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -1,7 +1,7 @@ ;;; mm-bodies.el --- Functions for decoding MIME things -;; Copyright (C) 1998, 1999, 2000, 2001, 2003 -;; Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -9,7 +9,7 @@ ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -19,17 +19,13 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: ;;; Code: -(eval-and-compile - (or (fboundp 'base64-decode-region) - (require 'base64))) - (eval-when-compile (defvar mm-uu-decode-function) (defvar mm-uu-binhex-decode-function)) @@ -38,9 +34,16 @@ (require 'rfc2047) (require 'mm-encode) -;; 8bit treatment gets any char except: 0x32 - 0x7f, CR, LF, TAB, BEL, +;; 8bit treatment gets any char except: 0x32 - 0x7f, LF, TAB, BEL, ;; BS, vertical TAB, form feed, and ^_ -(defvar mm-7bit-chars "\x20-\x7f\r\n\t\x7\x8\xb\xc\x1f") +;; +;; Note that CR is *not* included, as that would allow a non-paired CR +;; in the body contrary to RFC 2822: +;; +;; - CR and LF MUST only occur together as CRLF; they MUST NOT +;; appear independently in the body. + +(defvar mm-7bit-chars "\x20-\x7f\n\t\x7\x8\xb\xc\x1f") (defcustom mm-body-charset-encoding-alist '((iso-2022-jp . 7bit) @@ -49,6 +52,8 @@ ;; known to break servers. ;; Note: UTF-16 variants are invalid for text parts [RFC 2781], ;; so this can't happen :-/. + ;; PPS: Yes, it can happen if the user specifies UTF-16 in the MML + ;; markup. - jh. (utf-16 . base64) (utf-16be . base64) (utf-16le . base64)) @@ -88,7 +93,8 @@ If no encoding was done, nil is returned." (save-excursion (if charset (progn - (mm-encode-coding-region (point-min) (point-max) charset) + (mm-encode-coding-region (point-min) (point-max) + (mm-charset-to-coding-system charset)) charset) (goto-char (point-min)) (let ((charsets (mm-find-mime-charset-region (point-min) (point-max) @@ -131,6 +137,9 @@ If no encoding was done, nil is returned." (require 'message) (cond ((and (not longp) + (not (and mm-use-ultra-safe-encoding + (or (save-excursion (re-search-forward " $" nil t)) + (save-excursion (re-search-forward "^From " nil t))))) (eq bits '7bit)) bits) ((and (not mm-use-ultra-safe-encoding) @@ -216,8 +225,9 @@ If TYPE is `text/plain' CRLF->LF translation may occur." (message "Error while decoding: %s" error) nil)) (when (and + type (memq encoding '(base64 x-uuencode x-uue x-binhex x-yenc)) - (equal type "text/plain")) + (string-match "\\`text/" type)) (goto-char (point-min)) (while (search-forward "\r\n" nil t) (replace-match "\n" t t))))) @@ -237,8 +247,12 @@ decoding. If it is nil, default to `mail-parse-charset'." (save-excursion (when encoding (mm-decode-content-transfer-encoding encoding type)) - (when (featurep 'mule) ; Fixme: Wrong test for unibyte session. - (let ((coding-system (mm-charset-to-coding-system charset))) + (when (and (featurep 'mule) ;; Fixme: Wrong test for unibyte session. + (not (eq charset 'gnus-decoded))) + (let ((coding-system (mm-charset-to-coding-system + ;; Allow overwrite using + ;; `mm-charset-override-alist'. + charset nil t))) (if (and (not coding-system) (listp mail-parse-ignored-charsets) (memq 'gnus-unknown mail-parse-ignored-charsets)) @@ -250,8 +264,7 @@ decoding. If it is nil, default to `mail-parse-charset'." ;;in XEmacs (mm-multibyte-p) (or (not (eq coding-system 'ascii)) - (setq coding-system mail-parse-charset)) - (not (eq coding-system 'gnus-decoded))) + (setq coding-system mail-parse-charset))) (mm-decode-coding-region (point-min) (point-max) coding-system)) (setq buffer-file-coding-system @@ -270,7 +283,11 @@ decoding. If it is nil, default to `mail-parse-charset'." (setq charset mail-parse-charset)) (or (when (featurep 'mule) - (let ((coding-system (mm-charset-to-coding-system charset))) + (let ((coding-system (mm-charset-to-coding-system + charset + ;; Allow overwrite using + ;; `mm-charset-override-alist'. + nil t))) (if (and (not coding-system) (listp mail-parse-ignored-charsets) (memq 'gnus-unknown mail-parse-ignored-charsets)) @@ -285,4 +302,5 @@ decoding. If it is nil, default to `mail-parse-charset'." (provide 'mm-bodies) +;;; arch-tag: 41104bb6-4443-4ca9-8d5c-ff87ecf27d8d ;;; mm-bodies.el ends here