X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/341dd15a7bd9d0b4adff846e94289b3e1877eed1..19998f14b67de66754081cacdbca5668680c41ba:/lisp/gnus/mml.el diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index b29738da54..6028ce8b20 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -1,25 +1,23 @@ ;;; mml.el --- A package for parsing and validating MML documents -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -36,16 +34,15 @@ (require 'mml-sec) (eval-when-compile (require 'cl)) -(eval-and-compile - (autoload 'message-make-message-id "message") - (autoload 'gnus-setup-posting-charset "gnus-msg") - (autoload 'gnus-make-local-hook "gnus-util") - (autoload 'message-fetch-field "message") - (autoload 'message-mark-active-p "message") - (autoload 'message-info "message") - (autoload 'fill-flowed-encode "flow-fill") - (autoload 'message-posting-charset "message") - (autoload 'dnd-get-local-file-name "dnd")) +(autoload 'message-make-message-id "message") +(autoload 'gnus-setup-posting-charset "gnus-msg") +(autoload 'gnus-make-local-hook "gnus-util") +(autoload 'message-fetch-field "message") +(autoload 'message-mark-active-p "message") +(autoload 'message-info "message") +(autoload 'fill-flowed-encode "flow-fill") +(autoload 'message-posting-charset "message") +(autoload 'dnd-get-local-file-name "dnd") (autoload 'message-options-set "message") (autoload 'message-narrow-to-head "message") @@ -485,7 +482,12 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (setq charset nil coding nil)) (charset - (setq charset (intern (downcase charset))))) + ;; The value of `charset' might be a bogus alias that + ;; `mm-charset-synonym-alist' provides, like `utf8', + ;; so we prefer the MIME charset that Emacs knows for + ;; the coding system `coding'. + (setq charset (or (mm-coding-system-to-mime-charset coding) + (intern (downcase charset)))))) (if (and (not raw) (member (car (split-string type "/")) '("text" "message"))) (progn @@ -896,10 +898,17 @@ If HANDLES is non-nil, use it instead reparsing the buffer." (unless (setq textp (equal (mm-handle-media-supertype handle) "text")) (save-excursion (set-buffer (setq buffer (mml-generate-new-buffer " *mml*"))) - (mm-insert-part handle 'no-cache) - (if (setq mmlp (equal (mm-handle-media-type handle) - "message/rfc822")) - (mime-to-mml))))) + (if (eq (mail-content-type-get (mm-handle-type handle) 'charset) + 'gnus-decoded) + ;; A part that mm-uu dissected from a non-MIME message + ;; because of `gnus-article-emulate-mime'. + (progn + (mm-enable-multibyte) + (insert-buffer-substring (mm-handle-buffer handle))) + (mm-insert-part handle 'no-cache) + (if (setq mmlp (equal (mm-handle-media-type handle) + "message/rfc822")) + (mime-to-mml)))))) (if mmlp (mml-insert-mml-markup handle nil t t) (unless (and no-markup @@ -1105,13 +1114,13 @@ If HANDLES is non-nil, use it instead reparsing the buffer." ["PGG manual" (lambda () (interactive) (message-info mml2015-use)) ;; XEmacs barfs on :visible. ,@(if (featurep 'xemacs) nil - '(:visible (equal mml2015-use 'pgg))) + '(:visible (and (boundp 'mml2015-use) (equal mml2015-use 'pgg)))) ,@(if (featurep 'xemacs) '(t) '(:help "Display the PGG manual"))] - ["EasyPG manual" (lambda () (interactive) (message-info mml2015-use)) + ["EasyPG manual" (lambda () (interactive) (require 'mml2015) (message-info mml2015-use)) ;; XEmacs barfs on :visible. ,@(if (featurep 'xemacs) nil - '(:visible (equal mml2015-use 'epg))) + '(:visible (and (boundp 'mml2015-use) (equal mml2015-use 'epg)))) ,@(if (featurep 'xemacs) '(t) '(:help "Display the EasyPG manual"))])) @@ -1287,7 +1296,9 @@ body) or \"attachment\" (separate from the body)." (unless (message-in-body-p) (goto-char (point-max))) (mml-insert-empty-tag 'part 'type type - 'filename file + ;; icicles redefines read-file-name and returns a + ;; string w/ text properties :-/ + 'filename (mm-substring-no-properties file) 'disposition (or disposition "attachment") 'description description))) @@ -1315,18 +1326,20 @@ Ask for type, description or disposition according to (setq disposition (mml-minibuffer-read-disposition type nil file))) (mml-attach-file file type description disposition))))) -(defun mml-attach-buffer (buffer &optional type description) +(defun mml-attach-buffer (buffer &optional type description disposition) "Attach a buffer to the outgoing MIME message. -See `mml-attach-file' for details of operation." +BUFFER is the name of the buffer to attach. See +`mml-attach-file' for details of operation." (interactive (let* ((buffer (read-buffer "Attach buffer: ")) (type (mml-minibuffer-read-type buffer "text/plain")) - (description (mml-minibuffer-read-description))) - (list buffer type description))) + (description (mml-minibuffer-read-description)) + (disposition (mml-minibuffer-read-disposition type nil))) + (list buffer type description disposition))) (save-excursion (unless (message-in-body-p) (goto-char (point-max))) (mml-insert-empty-tag 'part 'type type 'buffer buffer - 'disposition "attachment" + 'disposition disposition 'description description))) (defun mml-attach-external (file &optional type description)