X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b17f53abc28496125965f36147b76ea5f6a2b4fb..19998f14b67de66754081cacdbca5668680c41ba:/lisp/gnus/mml.el diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 1c66353f45..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 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") @@ -97,7 +94,7 @@ type (e.g., text/plain) respectively, and DISPOSITION should be either the string \"attachment\" or the string \"inline\". The value t for SUPERTYPE, SUBTYPE or TYPE matches any of those types. The first match found will be used." - :version "23.0" ;; No Gnus + :version "23.1" ;; No Gnus :type (let ((dispositions '(radio :format "DISPOSITION: %v" :value "attachment" (const :format "%v " "attachment") @@ -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 @@ -875,14 +877,19 @@ If HANDLES is non-nil, use it instead reparsing the buffer." (defun mml-to-mime () "Translate the current buffer from MML to MIME." - (message-encode-message-body) + ;; `message-encode-message-body' will insert an encoded Content-Description + ;; header in the message header if the body contains a single part + ;; that is specified by a user with a MML tag containing a description + ;; token. So, we encode the message header first to prevent the encoded + ;; Content-Description header from being encoded again. (save-restriction (message-narrow-to-headers-or-head) ;; Skip past any From_ headers. (while (looking-at "From ") (forward-line 1)) (let ((mail-parse-charset message-default-charset)) - (mail-encode-encoded-word-buffer)))) + (mail-encode-encoded-word-buffer))) + (message-encode-message-body)) (defun mml-insert-mime (handle &optional no-markup) (let (textp buffer mmlp) @@ -891,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 @@ -1020,10 +1034,34 @@ If HANDLES is non-nil, use it instead reparsing the buffer." '(:help "Attach a file at point"))] ["Attach Buffer..." mml-attach-buffer ,@(if (featurep 'xemacs) '(t) - '(:help "Attach a buffer to the outgoing MIME message"))] + '(:help "Attach a buffer to the outgoing message"))] ["Attach External..." mml-attach-external ,@(if (featurep 'xemacs) '(t) - '(:help "Attach reference to file"))] + '(:help "Attach reference to an external file"))] + ;; FIXME: Is it possible to do this without using + ;; `gnus-gcc-externalize-attachments'? + ["Externalize Attachments" + (lambda () + (interactive) + (if (not (and (boundp 'gnus-gcc-externalize-attachments) + (memq gnus-gcc-externalize-attachments + '(all t nil)))) + ;; Stupid workaround for XEmacs not honoring :visible. + (message "Can't handle this value of `gnus-gcc-externalize-attachments'") + (setq gnus-gcc-externalize-attachments + (not gnus-gcc-externalize-attachments)) + (message "gnus-gcc-externalize-attachments is `%s'." + gnus-gcc-externalize-attachments))) + ;; XEmacs barfs on :visible. + ,@(if (featurep 'xemacs) nil + '(:visible (and (boundp 'gnus-gcc-externalize-attachments) + (memq gnus-gcc-externalize-attachments + '(all t nil))))) + :style toggle + :selected gnus-gcc-externalize-attachments + ,@(if (featurep 'xemacs) nil + '(:help "Save attachments as external parts in Gcc copies"))] + "----" ;; ("Change Security Method" ["PGP/MIME" @@ -1051,6 +1089,10 @@ If HANDLES is non-nil, use it instead reparsing the buffer." ["Encrypt/Sign off" mml-unsecure-message ,@(if (featurep 'xemacs) '(t) '(:help "Don't Encrypt/Sign Message"))] + ;; Do we have separate encrypt and encrypt/sign commands for parts? + ["Sign Part" mml-secure-sign t] + ["Encrypt Part" mml-secure-encrypt t] + "----" ;; Maybe we could remove these, because people who write MML most probably ;; don't use the menu: ["Insert Part..." mml-insert-part @@ -1058,9 +1100,6 @@ If HANDLES is non-nil, use it instead reparsing the buffer." ["Insert Multipart..." mml-insert-multipart :active (message-in-body-p)] ;; - ;; Do we have separate encrypt and encrypt/sign commands for parts? - ["Sign Part" mml-secure-sign t] - ["Encrypt Part" mml-secure-encrypt t] ;;["Narrow" mml-narrow-to-part t] ["Quote MML in region" mml-quote-region :active (message-mark-active-p) @@ -1072,9 +1111,18 @@ If HANDLES is non-nil, use it instead reparsing the buffer." ["Emacs MIME manual" (lambda () (interactive) (message-info 4)) ,@(if (featurep 'xemacs) '(t) '(:help "Display the Emacs MIME manual"))] - ["PGG manual" (lambda () (interactive) (message-info 16)) + ["PGG manual" (lambda () (interactive) (message-info mml2015-use)) + ;; XEmacs barfs on :visible. + ,@(if (featurep 'xemacs) nil + '(:visible (and (boundp 'mml2015-use) (equal mml2015-use 'pgg)))) ,@(if (featurep 'xemacs) '(t) - '(:help "Display the PGG manual"))])) + '(:help "Display the PGG manual"))] + ["EasyPG manual" (lambda () (interactive) (require 'mml2015) (message-info mml2015-use)) + ;; XEmacs barfs on :visible. + ,@(if (featurep 'xemacs) nil + '(:visible (and (boundp 'mml2015-use) (equal mml2015-use 'epg)))) + ,@(if (featurep 'xemacs) '(t) + '(:help "Display the EasyPG manual"))])) (defvar mml-mode nil "Minor mode for editing MML.") @@ -1105,7 +1153,7 @@ See Info node `(emacs-mime)Composing'. "The default directory where mml will find files. If not set, `default-directory' will be used." :type '(choice directory (const :tag "Default" nil)) - :version "23.0" ;; No Gnus + :version "23.1" ;; No Gnus :group 'message) (defun mml-minibuffer-read-file (prompt) @@ -1217,7 +1265,7 @@ If it is a list, valid members are `type', `description' and don't ask for options. If it is t, ask the user whether or not to specify options." :type '(choice - (const :tag "Non" nil) + (const :tag "None" nil) (const :tag "Query" t) (list :value (type description disposition) (set :inline t @@ -1248,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))) @@ -1276,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) @@ -1477,5 +1529,5 @@ or the `pop-to-buffer' function." (provide 'mml) -;;; arch-tag: 583c96cf-1ffe-451b-a5e5-4733ae9ddd12 +;; arch-tag: 583c96cf-1ffe-451b-a5e5-4733ae9ddd12 ;;; mml.el ends here