;;; mml.el --- A package for parsing and validating MML documents
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; 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 2, 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
+;; For Emacs < 22.2.
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
(require 'mm-util)
(require 'mm-bodies)
(require 'mm-encode)
(require 'mm-decode)
(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 'fill-flowed-encode "flow-fill")
- (autoload 'message-posting-charset "message"))
-
(eval-when-compile
- (autoload 'dnd-get-local-file-name "dnd"))
+ (when (featurep 'xemacs)
+ (require 'easy-mmode))) ; for `define-minor-mode'
+
+(autoload 'message-make-message-id "message")
+(declare-function gnus-setup-posting-charset "gnus-msg" (group))
+(autoload 'gnus-make-local-hook "gnus-util")
+(autoload 'gnus-completing-read "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")
+(autoload 'message-in-body-p "message")
+(autoload 'message-mail-p "message")
(defvar gnus-article-mime-handles)
(defvar gnus-mouse-2)
(defvar message-posting-charset)
(defvar message-required-mail-headers)
(defvar message-required-news-headers)
+(defvar dnd-protocol-alist)
+(defvar mml-dnd-protocol-alist)
(defcustom mml-content-type-parameters
'(name access-type expiration size permission format)
:type '(repeat (symbol :tag "Parameter"))
:group 'message)
-(defcustom mml-insert-mime-headers-always nil
+(defcustom mml-content-disposition-alist
+ '((text (rtf . "attachment") (t . "inline"))
+ (t . "attachment"))
+ "Alist of MIME types or regexps matching file names and default dispositions.
+Each element should be one of the following three forms:
+
+ (REGEXP . DISPOSITION)
+ (SUPERTYPE (SUBTYPE . DISPOSITION) (SUBTYPE . DISPOSITION)...)
+ (TYPE . DISPOSITION)
+
+Where REGEXP is a string which matches the file name (if any) of an
+attachment, SUPERTYPE, SUBTYPE and TYPE should be symbols which are a
+MIME supertype (e.g., text), a MIME subtype (e.g., plain) and a MIME
+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.1" ;; No Gnus
+ :type (let ((dispositions '(radio :format "DISPOSITION: %v"
+ :value "attachment"
+ (const :format "%v " "attachment")
+ (const :format "%v\n" "inline"))))
+ `(repeat
+ :offset 0
+ (choice :format "%[Value Menu%]%v"
+ (cons :tag "(REGEXP . DISPOSITION)" :extra-offset 4
+ (regexp :tag "REGEXP" :value ".*")
+ ,dispositions)
+ (cons :tag "(SUPERTYPE (SUBTYPE . DISPOSITION)...)"
+ :indent 0
+ (symbol :tag " SUPERTYPE" :value text)
+ (repeat :format "%v%i\n" :offset 0 :extra-offset 4
+ (cons :format "%v" :extra-offset 5
+ (symbol :tag "SUBTYPE" :value t)
+ ,dispositions)))
+ (cons :tag "(TYPE . DISPOSITION)" :extra-offset 4
+ (symbol :tag "TYPE" :value t)
+ ,dispositions))))
+ :group 'message)
+
+(defcustom mml-insert-mime-headers-always t
"If non-nil, always put Content-Type: text/plain at top of empty parts.
It is necessary to work against a bug in certain clients."
- :version "22.1"
+ :version "24.1"
:type 'boolean
:group 'message)
(let* (secure-mode
(taginfo (mml-read-tag))
(keyfile (cdr (assq 'keyfile taginfo)))
- (certfile (cdr (assq 'certfile taginfo)))
+ (certfiles (delq nil (mapcar (lambda (tag)
+ (if (eq (car-safe tag) 'certfile)
+ (cdr tag)))
+ taginfo)))
(recipients (cdr (assq 'recipients taginfo)))
(sender (cdr (assq 'sender taginfo)))
(location (cdr (assq 'tag-location taginfo)))
,@tags
,(if keyfile "keyfile")
,keyfile
- ,(if certfile "certfile")
- ,certfile
+ ,@(apply #'append
+ (mapcar (lambda (certfile)
+ (list "certfile" certfile))
+ certfiles))
,(if recipients "recipients")
,recipients
,(if sender "sender")
(skip-chars-forward "= \t\n")
(setq val (buffer-substring-no-properties
(point) (progn (forward-sexp 1) (point))))
- (when (string-match "^\"\\(.*\\)\"$" val)
- (setq val (match-string 1 val)))
+ (when (string-match "\\`\"" val)
+ (setq val (read val))) ;; inverse of prin1 in mml-insert-tag
(push (cons (intern elem) val) contents)
(skip-chars-forward " \t\n"))
(goto-char (match-end 0))
(mml-multipart-number mml-multipart-number))
(if (not cont)
nil
- (with-temp-buffer
+ (mm-with-multibyte-buffer
(if (and (consp (car cont))
(= (length cont) 1))
(mml-generate-mime-1 (car cont))
(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
;; `m-g-d-t' will be bound to "message/rfc822"
;; when encoding an article to be forwarded.
(mml-generate-default-type "text/plain"))
- (mml-to-mime))
+ (mml-to-mime)
+ ;; Update handle so mml-compute-boundary can
+ ;; detect collisions with the nested parts.
+ (setcdr (assoc 'contents cont) (buffer-string)))
(let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
;; ignore 0x1b, it is part of iso-2022-jp
(setq encoding (mm-body-7-or-8))))
;; insert a "; format=flowed" string unless the
;; user has already specified it.
(setq flowed (null (assq 'format cont)))))
- (setq charset (mm-encode-body charset))
+ ;; Prefer `utf-8' for text/calendar parts.
+ (if (or charset
+ (not (string= type "text/calendar")))
+ (setq charset (mm-encode-body charset))
+ (let ((mm-coding-system-priorities
+ (cons 'utf-8 mm-coding-system-priorities)))
+ (setq charset (mm-encode-body))))
(setq encoding (mm-body-encoding
charset (cdr (assq 'encoding cont))))))
(setq coded (buffer-string)))
(mm-with-unibyte-buffer