1 ;;; mml.el --- A package for parsing and validating MML documents
2 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5 ;; This file is part of GNU Emacs.
7 ;; GNU Emacs is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; GNU Emacs is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs; see the file COPYING. If not, write to the
19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 ;; Boston, MA 02111-1307, USA.
31 (eval-when-compile (require 'cl))
34 (autoload 'message-make-message-id "message")
35 (autoload 'gnus-setup-posting-charset "gnus-msg")
36 (autoload 'gnus-add-minor-mode "gnus-ems")
37 (autoload 'message-fetch-field "message")
38 (autoload 'fill-flowed-encode "flow-fill")
39 (autoload 'message-posting-charset "message"))
41 (defcustom mml-content-type-parameters
42 '(name access-type expiration size permission format)
43 "*A list of acceptable parameters in MML tag.
44 These parameters are generated in Content-Type header if exists."
45 :type '(repeat (symbol :tag "Parameter"))
48 (defcustom mml-content-disposition-parameters
49 '(filename creation-date modification-date read-date)
50 "*A list of acceptable parameters in MML tag.
51 These parameters are generated in Content-Disposition header if exists."
52 :type '(repeat (symbol :tag "Parameter"))
55 (defvar mml-tweak-type-alist nil
56 "A list of (TYPE . FUNCTION) for tweaking MML parts.
57 TYPE is a string containing a regexp to match the MIME type. FUNCTION
58 is a Lisp function which is called with the MML handle to tweak the
59 part. This variable is used only when no TWEAK parameter exists in
62 (defvar mml-tweak-function-alist nil
63 "A list of (NAME . FUNCTION) for tweaking MML parts.
64 NAME is a string containing the name of the TWEAK parameter in the MML
65 handle. FUNCTION is a Lisp function which is called with the MML
66 handle to tweak the part.")
68 (defvar mml-tweak-sexp-alist
69 '((mml-externalize-attachments . mml-tweak-externalize-attachments))
70 "A list of (SEXP . FUNCTION) for tweaking MML parts.
71 SEXP is a s-expression. If the evaluation of SEXP is non-nil, FUNCTION
72 is called. FUNCTION is a Lisp function which is called with the MML
73 handle to tweak the part.")
75 (defvar mml-externalize-attachments nil
76 "*If non-nil, local-file attachments are generated as external parts.")
78 (defvar mml-generate-multipart-alist nil
79 "*Alist of multipart generation functions.
80 Each entry has the form (NAME . FUNCTION), where
81 NAME is a string containing the name of the part (without the
82 leading \"/multipart/\"),
83 FUNCTION is a Lisp function which is called to generate the part.
85 The Lisp function has to supply the appropriate MIME headers and the
86 contents of this part.")
88 (defvar mml-syntax-table
89 (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
90 (modify-syntax-entry ?\\ "/" table)
91 (modify-syntax-entry ?< "(" table)
92 (modify-syntax-entry ?> ")" table)
93 (modify-syntax-entry ?@ "w" table)
94 (modify-syntax-entry ?/ "w" table)
95 (modify-syntax-entry ?= " " table)
96 (modify-syntax-entry ?* " " table)
97 (modify-syntax-entry ?\; " " table)
98 (modify-syntax-entry ?\' " " table)
101 (defvar mml-boundary-function 'mml-make-boundary
102 "A function called to suggest a boundary.
103 The function may be called several times, and should try to make a new
104 suggestion each time. The function is called with one parameter,
105 which is a number that says how many times the function has been
106 called for this message.")
108 (defvar mml-confirmation-set nil
109 "A list of symbols, each of which disables some warning.
110 `unknown-encoding': always send messages contain characters with
111 unknown encoding; `use-ascii': always use ASCII for those characters
112 with unknown encoding; `multipart': always send messages with more than
115 (defvar mml-generate-default-type "text/plain")
117 (defvar mml-buffer-list nil)
119 (defun mml-generate-new-buffer (name)
120 (let ((buf (generate-new-buffer name)))
121 (push buf mml-buffer-list)
124 (defun mml-destroy-buffers ()
125 (let (kill-buffer-hook)
126 (mapcar 'kill-buffer mml-buffer-list)
127 (setq mml-buffer-list nil)))
130 "Parse the current buffer as an MML document."
132 (goto-char (point-min))
133 (let ((table (syntax-table)))
136 (set-syntax-table mml-syntax-table)
138 (set-syntax-table table)))))
140 (defun mml-parse-1 ()
141 "Parse the current buffer as an MML document."
142 (let (struct tag point contents charsets warn use-ascii no-markup-p raw)
143 (while (and (not (eobp))
144 (not (looking-at "<#/multipart")))
146 ((looking-at "<#secure")
147 ;; The secure part is essentially a meta-meta tag, which
148 ;; expands to either a part tag if there are no other parts in
149 ;; the document or a multipart tag if there are other parts
150 ;; included in the message
152 (taginfo (mml-read-tag))
153 (recipients (cdr (assq 'recipients taginfo)))
154 (sender (cdr (assq 'sender taginfo)))
155 (location (cdr (assq 'tag-location taginfo)))
156 (mode (cdr (assq 'mode taginfo)))
157 (method (cdr (assq 'method taginfo)))
162 "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
163 (setq secure-mode "multipart")
164 (setq secure-mode "part")))
167 (re-search-forward "<#secure[^\n]*>\n"))
168 (delete-region (match-beginning 0) (match-end 0))
169 (cond ((string= mode "sign")
170 (setq tags (list "sign" method)))
171 ((string= mode "encrypt")
172 (setq tags (list "encrypt" method)))
173 ((string= mode "signencrypt")
174 (setq tags (list "sign" method "encrypt" method))))
175 (eval `(mml-insert-tag ,secure-mode
177 ,(if recipients "recipients")
179 ,(if sender "sender")
182 (goto-char location)))
183 ((looking-at "<#multipart")
184 (push (nconc (mml-read-tag) (mml-parse-1)) struct))
185 ((looking-at "<#external")
186 (push (nconc (mml-read-tag) (list (cons 'contents (mml-read-part))))
189 (if (or (looking-at "<#part") (looking-at "<#mml"))
190 (setq tag (mml-read-tag)
193 (setq tag (list 'part '(type . "text/plain"))
196 (setq raw (cdr (assq 'raw tag))
198 contents (mml-read-part (eq 'mml (car tag)))
203 (intern (downcase (cdr (assq 'charset tag))))))
205 (mm-find-mime-charset-region point (point)
207 (when (and (not raw) (memq nil charsets))
208 (if (or (memq 'unknown-encoding mml-confirmation-set)
209 (message-options-get 'unknown-encoding)
211 Message contains characters with unknown encoding. Really send?")
212 (message-options-set 'unknown-encoding t)))
214 (or (memq 'use-ascii mml-confirmation-set)
215 (message-options-get 'use-ascii)
216 (and (y-or-n-p "Use ASCII as charset?")
217 (message-options-set 'use-ascii t))))
218 (setq charsets (delq nil charsets))
220 (error "Edit your message to remove those characters")))
223 (< (length charsets) 2))
224 (if (or (not no-markup-p)
225 (string-match "[^ \t\r\n]" contents))
226 ;; Don't create blank parts.
227 (push (nconc tag (list (cons 'contents contents)))
229 (let ((nstruct (mml-parse-singlepart-with-multiple-charsets
230 tag point (point) use-ascii)))
232 (not (memq 'multipart mml-confirmation-set))
233 (not (message-options-get 'multipart))
234 (not (and (y-or-n-p (format "\
235 A message part needs to be split into %d charset parts. Really send? "
237 (message-options-set 'multipart t))))
238 (error "Edit your message to use only one charset"))
239 (setq struct (nconc nstruct struct)))))))
244 (defun mml-parse-singlepart-with-multiple-charsets
245 (orig-tag beg end &optional use-ascii)
248 (narrow-to-region beg end)
249 (goto-char (point-min))
250 (let ((current (or (mm-mime-charset (mm-charset-after))
251 (and use-ascii 'us-ascii)))
252 charset struct space newline paragraph)