1 ;;; mml.el --- A package for parsing and validating MML documents
2 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
3 ;; Free Software Foundation, Inc.
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; This file is part of GNU Emacs.
8 ;; GNU Emacs is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; GNU Emacs is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with GNU Emacs; see the file COPYING. If not, write to the
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 ;; Boston, MA 02111-1307, USA.
32 (eval-when-compile (require 'cl))
35 (autoload 'message-make-message-id "message")
36 (autoload 'gnus-setup-posting-charset "gnus-msg")
37 (autoload 'gnus-make-local-hook "gnus-util")
38 (autoload 'message-fetch-field "message")
39 (autoload 'message-mark-active-p "message")
40 (autoload 'fill-flowed-encode "flow-fill")
41 (autoload 'message-posting-charset "message")
42 (autoload 'x-dnd-get-local-file-name "x-dnd"))
44 (defcustom mml-content-type-parameters
45 '(name access-type expiration size permission format)
46 "*A list of acceptable parameters in MML tag.
47 These parameters are generated in Content-Type header if exists."
49 :type '(repeat (symbol :tag "Parameter"))
52 (defcustom mml-content-disposition-parameters
53 '(filename creation-date modification-date read-date)
54 "*A list of acceptable parameters in MML tag.
55 These parameters are generated in Content-Disposition header if exists."
57 :type '(repeat (symbol :tag "Parameter"))
60 (defcustom mml-insert-mime-headers-always nil
61 "If non-nil, always put Content-Type: text/plain at top of empty parts.
62 It is necessary to work against a bug in certain clients."
67 (defvar mml-tweak-type-alist nil
68 "A list of (TYPE . FUNCTION) for tweaking MML parts.
69 TYPE is a string containing a regexp to match the MIME type. FUNCTION
70 is a Lisp function which is called with the MML handle to tweak the
71 part. This variable is used only when no TWEAK parameter exists in
74 (defvar mml-tweak-function-alist nil
75 "A list of (NAME . FUNCTION) for tweaking MML parts.
76 NAME is a string containing the name of the TWEAK parameter in the MML
77 handle. FUNCTION is a Lisp function which is called with the MML
78 handle to tweak the part.")
80 (defvar mml-tweak-sexp-alist
81 '((mml-externalize-attachments . mml-tweak-externalize-attachments))
82 "A list of (SEXP . FUNCTION) for tweaking MML parts.
83 SEXP is an s-expression. If the evaluation of SEXP is non-nil, FUNCTION
84 is called. FUNCTION is a Lisp function which is called with the MML
85 handle to tweak the part.")
87 (defvar mml-externalize-attachments nil
88 "*If non-nil, local-file attachments are generated as external parts.")
90 (defvar mml-generate-multipart-alist nil
91 "*Alist of multipart generation functions.
92 Each entry has the form (NAME . FUNCTION), where
93 NAME is a string containing the name of the part (without the
94 leading \"/multipart/\"),
95 FUNCTION is a Lisp function which is called to generate the part.
97 The Lisp function has to supply the appropriate MIME headers and the
98 contents of this part.")
100 (defvar mml-syntax-table
101 (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
102 (modify-syntax-entry ?\\ "/" table)
103 (modify-syntax-entry ?< "(" table)
104 (modify-syntax-entry ?> ")" table)
105 (modify-syntax-entry ?@ "w" table)
106 (modify-syntax-entry ?/ "w" table)
107 (modify-syntax-entry ?= " " table)
108 (modify-syntax-entry ?* " " table)
109 (modify-syntax-entry ?\; " " table)
110 (modify-syntax-entry ?\' " " table)
113 (defvar mml-boundary-function 'mml-make-boundary
114 "A function called to suggest a boundary.
115 The function may be called several times, and should try to make a new
116 suggestion each time. The function is called with one parameter,
117 which is a number that says how many times the function has been
118 called for this message.")
120 (defvar mml-confirmation-set nil
121 "A list of symbols, each of which disables some warning.
122 `unknown-encoding': always send messages contain characters with
123 unknown encoding; `use-ascii': always use ASCII for those characters
124 with unknown encoding; `multipart': always send messages with more than
127 (defvar mml-generate-default-type "text/plain")
129 (defvar mml-buffer-list nil)
131 (defun mml-generate-new-buffer (name)
132 (let ((buf (generate-new-buffer name)))
133 (push buf mml-buffer-list)
136 (defun mml-destroy-buffers ()
137 (let (kill-buffer-hook)
138 (mapc 'kill-buffer mml-buffer-list)
139 (setq mml-buffer-list nil)))
142 "Parse the current buffer as an MML document."
144 (goto-char (point-min))
145 (with-syntax-table mml-syntax-table
148 (defun mml-parse-1 ()
149 "Parse the current buffer as an MML document."
150 (let (struct tag point contents charsets warn use-ascii no-markup-p raw)
151 (while (and (not (eobp))
152 (not (looking-at "<#/multipart")))
154 ((looking-at "<#secure")
155 ;; The secure part is essentially a meta-meta tag, which
156 ;; expands to either a part tag if there are no other parts in
157 ;; the document or a multipart tag if there are other parts
158 ;; included in the message
160 (taginfo (mml-read-tag))
161 (recipients (cdr (assq 'recipients taginfo)))
162 (sender (cdr (assq 'sender taginfo)))
163 (location (cdr (assq 'tag-location taginfo)))
164 (mode (cdr (assq 'mode taginfo)))
165 (method (cdr (assq 'method taginfo)))
168 (if (re-search-forward
169 "<#/?\\(multipart\\|part\\|external\\|mml\\)." nil t)
170 (setq secure-mode "multipart")
171 (setq secure-mode "part")))
174 (re-search-forward "<#secure[^\n]*>\n"))
175 (delete-region (match-beginning 0) (match-end 0))
176 (cond ((string= mode "sign")
177 (setq tags (list "sign" method)))
178 ((string= mode "encrypt")
179 (setq tags (list "encrypt" method)))
180 ((string= mode "signencrypt")
181 (setq tags (list "sign" method "encrypt" method))))
182 (eval `(mml-insert-tag ,secure-mode
184 ,(if recipients "recipients")
186 ,(if sender "sender")
189 (goto-char location)))
190 ((looking-at "<#multipart")
191 (push (nconc (mml-read-tag) (mml-parse-1)) struct))
192 ((looking-at "<#external")
193 (push (nconc (mml-read-tag) (list (cons 'contents (mml-read-part))))
196 (if (or (looking-at "<#part") (looking-at "<#mml"))
197 (setq tag (mml-read-tag)
200 (setq tag (list 'part '(type . "text/plain"))
203 (setq raw (cdr (assq 'raw tag))
205 contents (mml-read-part (eq 'mml (car tag)))
210 (intern (downcase (cdr (assq 'charset tag))))))
212 (mm-find-mime-charset-region point (point)
214 (when (and (not raw) (memq nil charsets))
215 (if (or (memq 'unknown-encoding mml-confirmation-set)
216 (message-options-get 'unknown-encoding)
218 Message contains characters with unknown encoding. Really send? ")
219 (message-options-set 'unknown-encoding t)))
221 (or (memq 'use-ascii mml-confirmation-set)
222 (message-options-get 'use-ascii)
223 (and (y-or-n-p "Use ASCII as charset? ")
224 (message-options-set 'use-ascii t))))
225 (setq charsets (delq nil charsets))
227 (error "Edit your message to remove those characters")))