1 ;;; mml.el --- A package for parsing and validating MML documents
2 ;; Copyright (C) 1998, 1999, 2000 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.
30 (eval-when-compile 'cl)
33 (autoload 'message-make-message-id "message")
34 (autoload 'gnus-setup-posting-charset "gnus-msg")
35 (autoload 'message-fetch-field "message")
36 (autoload 'message-posting-charset "message"))
38 (defvar mml-generate-multipart-alist nil
39 "*Alist of multipart generation functions.
40 Each entry has the form (NAME . FUNCTION), where
41 NAME is a string containing the name of the part (without the
42 leading \"/multipart/\"),
43 FUNCTION is a Lisp function which is called to generate the part.
45 The Lisp function has to supply the appropriate MIME headers and the
46 contents of this part.")
48 (defvar mml-syntax-table
49 (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
50 (modify-syntax-entry ?\\ "/" table)
51 (modify-syntax-entry ?< "(" table)
52 (modify-syntax-entry ?> ")" table)
53 (modify-syntax-entry ?@ "w" table)
54 (modify-syntax-entry ?/ "w" table)
55 (modify-syntax-entry ?= " " table)
56 (modify-syntax-entry ?* " " table)
57 (modify-syntax-entry ?\; " " table)
58 (modify-syntax-entry ?\' " " table)
61 (defvar mml-boundary-function 'mml-make-boundary
62 "A function called to suggest a boundary.
63 The function may be called several times, and should try to make a new
64 suggestion each time. The function is called with one parameter,
65 which is a number that says how many times the function has been
66 called for this message.")
68 (defvar mml-confirmation-set nil
69 "A list of symbols, each of which disables some warning.
70 `unknown-encoding': always send messages contain characters with
71 unknown encoding; `use-ascii': always use ASCII for those characters
72 with unknown encoding; `multipart': always send messages with more than
76 "Parse the current buffer as an MML document."
77 (goto-char (point-min))
78 (let ((table (syntax-table)))
81 (set-syntax-table mml-syntax-table)
83 (set-syntax-table table))))
86 "Parse the current buffer as an MML document."
87 (let (struct tag point contents charsets warn use-ascii no-markup-p)
88 (while (and (not (eobp))
89 (not (looking-at "<#/multipart")))
91 ((looking-at "<#multipart")
92 (push (nconc (mml-read-tag) (mml-parse-1)) struct))
93 ((looking-at "<#external")
94 (push (nconc (mml-read-tag) (list (cons 'contents (mml-read-part))))
97 (if (or (looking-at "<#part") (looking-at "<#mml"))
98 (setq tag (mml-read-tag)
101 (setq tag (list 'part '(type . "text/plain"))
105 contents (mml-read-part (eq 'mml (car tag)))
106 charsets (mm-find-mime-charset-region point (point)))
107 (when (memq nil charsets)
108 (if (or (memq 'unknown-encoding mml-confirmation-set)
110 "Warning: You message contains characters with unknown encoding. Really send?"))
112 (or (memq 'use-ascii mml-confirmation-set)
113 (y-or-n-p "Use ASCII as charset?")))
114 (setq charsets (delq nil charsets))
116 (error "Edit your message to remove those characters")))
117 (if (< (length charsets) 2)
118 (if (or (not no-markup-p)
119 (string-match "[^ \t\r\n]" contents))
120 ;; Don't create blank parts.
121 (push (nconc tag (list (cons 'contents contents)))
123 (let ((nstruct (mml-parse-singlepart-with-multiple-charsets
124 tag point (point) use-ascii)))
126 (not (memq 'multipart mml-confirmation-set))
130 "Warning: Your message contains more than %d parts. Really send? "
132 (error "Edit your message to use only one charset"))
133 (setq struct (nconc nstruct struct)))))))
138 (defun mml-parse-singlepart-with-multiple-charsets
139 (orig-tag beg end &optional use-ascii)
142 (narrow-to-region beg end)
143 (goto-char (point-min))
144 (let ((current (or (mm-mime-charset (mm-charset-after))
145 (and use-ascii 'us-ascii)))
146 charset struct space newline paragraph)
148 (setq charset (mm-mime-charset (mm-charset-after)))
150 ;; The charset remains the same.
151 ((eq charset 'us-ascii))
152 ((or (and use-ascii (not charset))
153 (eq charset current))
157 ;; The initial charset was ascii.
158 ((eq current 'us-ascii)
159 (setq current charset
163 ;; We have a change in charsets.
167 (list (cons 'contents
168 (buffer-substring-no-properties
169 beg (or paragraph newline space (point))))))
171 (setq beg (or paragraph newline space (point))
176 ;; Compute places where it might be nice to break the part.
178 ((memq (following-char) '(? ?\t))
179 (setq space (1+ (point))))
180 ((and (eq (following-char) ?\n)
182 (eq (char-after (1- (point))) ?\n))
183 (setq paragraph (point)))
184 ((eq (following-char) ?\n)
185 (setq newline (1+ (point)))))
187 ;; Do the final part.
188 (unless (= beg (point))
189 (push (append orig-tag
190 (list (cons 'contents
191 (buffer-substring-no-properties
196 (defun mml-read-tag ()
197 "Read a tag and return the contents."
198 (let (contents name elem val)
200 (setq name (buffer-substring-no-properties
201 (point) (progn (forward-sexp 1) (point))))
202 (skip-chars-forward " \t\n")
203 (while (not (looking-at ">"))
204 (setq elem (buffer-substring-no-properties
205 (point) (progn (forward-sexp 1) (point))))
206 (skip-chars-forward "= \t\n")
207 (setq val (buffer-substring-no-properties
208 (point) (progn (forward-sexp 1) (point))))
209 (when (string-match "^\"\\(.*\\)\"$" val)
210 (setq val (match-string 1 val)))
211 (push (cons (intern elem) val) contents)
212 (skip-chars-forward " \t\n"))
214 (skip-chars-forward " \t\n")
215 (cons (intern name) (nreverse contents))))
217 (defun mml-read-part (&optional mml)
218 "Return the buffer up till the next part, multipart or closing part or multipart.
219 If MML is non-nil, return the buffer up till the correspondent mml tag."
220 (let ((beg (point)) (count 1))
221 ;; If the tag ended at the end of the line, we go to the next line.
222 (when (looking-at "[ \t]*\n")
226 (while (and (> count 0) (not (eobp)))
227 (if (re-search-forward "<#\\(/\\)?mml." nil t)
228 (setq count (+ count (if (match-beginning 1) -1 1)))
229 (goto-char (point-max))))
230 (buffer-substring-no-properties beg (if (> count 0)
232 (match-beginning 0))))
233 (if (re-search-forward
234 "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
236 (buffer-substring-no-properties beg (match-beginning 0))
237 (if (or (not (match-beginning 1))
238 (equal (match-string 2) "multipart"))
239 (goto-char (match-beginning 0))
240 (when (looking-at "[ \t]*\n")
242 (buffer-substring-no-properties beg (goto-char (point-max)))))))
244 (defvar mml-boundary nil)
245 (defvar mml-base-boundary "-=-=")
246 (defvar mml-multipart-number 0)
248 (defun mml-generate-mime ()
249 "Generate a MIME message based on the current MML document."
250 (let ((cont (mml-parse))
251 (mml-multipart-number mml-multipart-number))
255 (if (and (consp (car cont))
257 (mml-generate-mime-1 (car cont))
258 (mml-generate-mime-1 (nconc (list 'multipart '(type . "mixed"))
262 (defun mml-generate-mime-1 (cont)
264 ((or (eq (car cont) 'part) (eq (car cont) 'mml))
265 (let (coded encoding charset filename type)
266 (setq type (or (cdr (assq 'type cont)) "text/plain"))
267 (if (member (car (split-string type "/")) '("text" "message"))
270 ((cdr (assq 'buffer cont))
271 (insert-buffer-substring (cdr (assq 'buffer cont))))
272 ((and (setq filename (cdr (assq 'filename cont)))
273 (not (equal (cdr (assq 'nofile cont)) "yes")))
274 (mm-insert-file-contents filename))
275 ((eq 'mml (car cont))
276 (insert (cdr (assq 'contents cont))))
279 (narrow-to-region (point) (point))
280 (insert (cdr (assq 'contents cont)))
281 ;; Remove quotes from quoted tags.
282 (goto-char (point-min))
283 (while (re-search-forward
284 "<#!+/?\\(part\\|multipart\\|external\\|mml\\)" nil t)
285 (delete-region (+ (match-beginning 0) 2)
286 (+ (match-beginning 0) 3))))))
288 ((eq (car cont) 'mml)
289 (let ((mml-boundary (funcall mml-boundary-function
290 (incf mml-multipart-number))))
292 (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
293 ;; ignore 0x1b, it is part of iso-2022-jp
294 (setq encoding (mm-body-7-or-8))))
295 ((string= (car (split-string type "/")) "message")
296 (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
297 ;; ignore 0x1b, it is part of iso-2022-jp
298 (setq encoding (mm-body-7-or-8))))
300 (setq charset (mm-encode-body))
301 (setq encoding (mm-body-encoding
302 charset (cdr (assq 'encoding cont))))))
303 (setq coded (buffer-string)))
304 (mm-with-unibyte-buffer
306 ((cdr (assq 'buffer cont))
307 (insert-buffer-substring (cdr (assq 'buffer cont))))
308 ((and (setq filename (cdr (assq 'filename cont)))
309 (not (equal (cdr (assq 'nofile cont)) "yes")))
310 (let ((coding-system-for-read mm-binary-coding-system))
311 (mm-insert-file-contents filename nil nil nil nil t)))
313 (insert (cdr (assq 'contents cont)))))
314 (setq encoding (mm-encode-buffer type)
315 coded (buffer-string))))
316 (mml-insert-mime-headers cont type charset encoding)
319 ((eq (car cont) 'external)
320 (insert "Content-Type: message/external-body")
321 (let ((parameters (mml-parameter-string
322 cont '(expiration size permission)))
323 (name (cdr (assq 'name cont))))
325 (setq name (mml-parse-file-name name))
327 (mml-insert-parameter
328 (mail-header-encode-parameter "name" name)
329 "access-type=local-file")
330 (mml-insert-parameter
331 (mail-header-encode-parameter
332 "name" (file-name-nondirectory (nth 2 name)))
333 (mail-header-encode-parameter "site" (nth 1 name))
334 (mail-header-encode-parameter
335 "directory" (file-name-directory (nth 2 name))))
336 (mml-insert-parameter
337 (concat "access-type="
338 (if (member (nth 0 name) '("ftp@" "anonymous@"))
342 (mml-insert-parameter-string
343 cont '(expiration size permission))))
345 (insert "Content-Type: " (cdr (assq 'type cont)) "\n")
346 (insert "Content-ID: " (message-make-message-id) "\n")
347 (insert "Content-Transfer-Encoding: "
348 (or (cdr (assq 'encoding cont)) "binary"))
350 (insert (or (cdr (assq 'contents cont))))
352 ((eq (car cont) 'multipart)
353 (let* ((type (or (cdr (assq 'type cont)) "mixed"))
354 (handler (assoc type mml-generate-multipart-alist)))
356 (funcall (cdr handler) cont)
357 ;; No specific handler. Use default one.
358 (let ((mml-boundary (mml-compute-boundary cont)))
359 (insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n"
361 ;; Skip `multipart' and `type' elements.
362 (setq cont (cddr cont))
364 (insert "\n--" mml-boundary "\n")
365 (mml-generate-mime-1 (pop cont)))
366 (insert "\n--" mml-boundary "--\n")))))
368 (error "Invalid element: %S" cont))))
370 (defun mml-compute-boundary (cont)
371 "Return a unique boundary that does not exist in CONT."
372 (let ((mml-boundary (funcall mml-boundary-function
373 (incf mml-multipart-number))))
374 ;; This function tries again and again until it has found
375 ;; a unique boundary.
376 (while (not (catch 'not-unique
377 (mml-compute-boundary-1 cont))))
380 (defun mml-compute-boundary-1 (cont)
383 ((eq (car cont) 'part)
386 ((cdr (assq 'buffer cont))
387 (insert-buffer-substring (cdr (assq 'buffer cont))))
388 ((and (setq filename (cdr (assq 'filename cont)))
389 (not (equal (cdr (assq 'nofile cont)) "yes")))
390 (mm-insert-file-contents filename))
392 (insert (cdr (assq 'contents cont)))))
393 (goto-char (point-min))
394 (when (re-search-forward (concat "^--" (regexp-quote mml-boundary))
396 (setq mml-boundary (funcall mml-boundary-function
397 (incf mml-multipart-number)))
398 (throw 'not-unique nil))))
399 ((eq (car cont) 'multipart)
400 (mapcar 'mml-compute-boundary-1 (cddr cont))))
403 (defun mml-make-boundary (number)
404 (concat (make-string (% number 60) ?=)
410 (defun mml-make-string (num string)
412 (while (not (zerop (decf num)))
413 (setq out (concat out string)))
416 (defun mml-insert-mime-headers (cont type charset encoding)
417 (let (parameters disposition description)
419 (mml-parameter-string
420 cont '(name access-type expiration size permission)))
423 (not (equal type "text/plain")))
424 (when (consp charset)
426 "Can't encode a part with several charsets."))
427 (insert "Content-Type: " type)
429 (insert "; " (mail-header-encode-parameter
430 "charset" (symbol-name charset))))
432 (mml-insert-parameter-string
433 cont '(name access-type expiration size permission)))
436 (mml-parameter-string
437 cont '(filename creation-date modification-date read-date)))
438 (when (or (setq disposition (cdr (assq 'disposition cont)))
440 (insert "Content-Disposition: " (or disposition "inline"))
442 (mml-insert-parameter-string
443 cont '(filename creation-date modification-date read-date)))
445 (unless (eq encoding '7bit)
446 (insert (format "Content-Transfer-Encoding: %s\n" encoding)))
447 (when (setq description (cdr (assq 'description cont)))
448 (insert "Content-Description: "
449 (mail-encode-encoded-word-string description) "\n"))))
451 (defun mml-parameter-string (cont types)
454 (while (setq type (pop types))
455 (when (setq value (cdr (assq type cont)))
456 ;; Strip directory component from the filename parameter.
457 (when (eq type 'filename)
458 (setq value (file-name-nondirectory value)))
459 (setq string (concat string "; "
460 (mail-header-encode-parameter
461 (symbol-name type) value)))))
462 (when (not (zerop (length string)))
465 (defun mml-insert-parameter-string (cont types)
467 (while (setq type (pop types))
468 (when (setq value (cdr (assq type cont)))
469 ;; Strip directory component from the filename parameter.
470 (when (eq type 'filename)
471 (setq value (file-name-nondirectory value)))
472 (mml-insert-parameter
473 (mail-header-encode-parameter
474 (symbol-name type) value))))))
476 (defvar ange-ftp-path-format)
477 (defvar efs-path-regexp)
478 (defun mml-parse-file-name (path)
479 (if (if (boundp 'efs-path-regexp)
480 (string-match efs-path-regexp path)
481 (if (boundp 'ange-ftp-path-format)
482 (string-match (car ange-ftp-path-format))))
483 (list (match-string 1 path) (match-string 2 path)
484 (substring path (1+ (match-end 2))))
487 (defun mml-insert-buffer (buffer)
488 "Insert BUFFER at point and quote any MML markup."
490 (narrow-to-region (point) (point))
491 (insert-buffer-substring buffer)
492 (mml-quote-region (point-min) (point-max))
493 (goto-char (point-max))))
496 ;;; Transforming MIME to MML
499 (defun mime-to-mml ()
500 "Translate the current buffer (which should be a message) into MML."
501 ;; First decode the head.
503 (message-narrow-to-head)
504 (mail-decode-encoded-word-region (point-min) (point-max)))
505 (let ((handles (mm-dissect-buffer t)))
506 (goto-char (point-min))
507 (search-forward "\n\n" nil t)
508 (delete-region (point) (point-max))
509 (if (stringp (car handles))
510 (mml-insert-mime handles)
511 (mml-insert-mime handles t))
512 (mm-destroy-parts handles))
514 (message-narrow-to-head)
515 ;; Remove them, they are confusing.
516 (message-remove-header "Content-Type")
517 (message-remove-header "MIME-Version")
518 (message-remove-header "Content-Transfer-Encoding")))
520 (defun mml-to-mime ()
521 "Translate the current buffer from MML to MIME."
522 (message-encode-message-body)
524 (message-narrow-to-headers-or-head)
525 (let ((mail-parse-charset message-default-charset))
526 (mail-encode-encoded-word-buffer))))
528 (defun mml-insert-mime (handle &optional no-markup)
529 (let (textp buffer mmlp)
530 ;; Determine type and stuff.
531 (unless (stringp (car handle))
532 (unless (setq textp (equal (mm-handle-media-supertype handle) "text"))
534 (set-buffer (setq buffer (generate-new-buffer " *mml*")))
535 (mm-insert-part handle)
536 (if (setq mmlp (equal (mm-handle-media-type handle)
540 (mml-insert-mml-markup handle nil t t)
541 (unless (and no-markup
542 (equal (mm-handle-media-type handle) "text/plain"))
543 (mml-insert-mml-markup handle buffer textp)))
546 (insert-buffer buffer)
547 (goto-char (point-max))
548 (insert "<#/mml>\n"))
549 ((stringp (car handle))
550 (mapcar 'mml-insert-mime (cdr handle))
551 (insert "<#/multipart>\n"))
553 (let ((text (mm-get-part handle))
554 (charset (mail-content-type-get
555 (mm-handle-type handle) 'charset)))
556 (insert (mm-decode-string text charset)))
557 (goto-char (point-max)))
559 (insert "<#/part>\n")))))
561 (defun mml-insert-mml-markup (handle &optional buffer nofile mmlp)
562 "Take a MIME handle and insert an MML tag."
563 (if (stringp (car handle))
564 (insert "<#multipart type=" (mm-handle-media-subtype handle)
567 (insert "<#mml type=" (mm-handle-media-type handle))
568 (insert "<#part type=" (mm-handle-media-type handle)))
569 (dolist (elem (append (cdr (mm-handle-type handle))
570 (cdr (mm-handle-disposition handle))))
571 (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\""))
572 (when (mm-handle-disposition handle)
573 (insert " disposition=" (car (mm-handle-disposition handle))))
575 (insert " buffer=\"" (buffer-name buffer) "\""))
577 (insert " nofile=yes"))
578 (when (mm-handle-description handle)
579 (insert " description=\"" (mm-handle-description handle) "\""))
582 (defun mml-insert-parameter (&rest parameters)
583 "Insert PARAMETERS in a nice way."
584 (dolist (param parameters)
586 (let ((point (point)))
588 (when (> (current-column) 71)
594 ;;; Mode for inserting and editing MML forms
598 (let ((map (make-sparse-keymap))
599 (main (make-sparse-keymap)))
600 (define-key map "f" 'mml-attach-file)
601 (define-key map "b" 'mml-attach-buffer)
602 (define-key map "e" 'mml-attach-external)
603 (define-key map "q" 'mml-quote-region)
604 (define-key map "m" 'mml-insert-multipart)
605 (define-key map "p" 'mml-insert-part)
606 (define-key map "v" 'mml-validate)
607 (define-key map "P" 'mml-preview)
608 (define-key map "n" 'mml-narrow-to-part)
609 (define-key main "\M-m" map)
613 mml-menu mml-mode-map ""
616 ["File" mml-attach-file t]
617 ["Buffer" mml-attach-buffer t]
618 ["External" mml-attach-external t])
620 ["Multipart" mml-insert-multipart t]
621 ["Part" mml-insert-part t])
622 ["Narrow" mml-narrow-to-part t]
623 ["Quote" mml-quote-region t]
624 ["Validate" mml-validate t]
625 ["Preview" mml-preview t]))
628 "Minor mode for editing MML.")
630 (defun mml-mode (&optional arg)
631 "Minor mode for editing MML.
635 (if (not (set (make-local-variable 'mml-mode)
636 (if (null arg) (not mml-mode)
637 (> (prefix-numeric-value arg) 0))))
639 (set (make-local-variable 'mml-mode) t)
640 (unless (assq 'mml-mode minor-mode-alist)
641 (push `(mml-mode " MML") minor-mode-alist))
642 (unless (assq 'mml-mode minor-mode-map-alist)
643 (push (cons 'mml-mode mml-mode-map)
644 minor-mode-map-alist)))
645 (run-hooks 'mml-mode-hook))
648 ;;; Helper functions for reading MIME stuff from the minibuffer and
649 ;;; inserting stuff to the buffer.
652 (defun mml-minibuffer-read-file (prompt)
653 (let ((file (read-file-name prompt nil nil t)))
654 ;; Prevent some common errors. This is inspired by similar code in
656 (when (file-directory-p file)
657 (error "%s is a directory, cannot attach" file))
658 (unless (file-exists-p file)
659 (error "No such file: %s" file))
660 (unless (file-readable-p file)
661 (error "Permission denied: %s" file))
664 (defun mml-minibuffer-read-type (name &optional default)
665 (let* ((default (or default
666 (mm-default-file-encoding name)
667 ;; Perhaps here we should check what the file
668 ;; looks like, and offer text/plain if it looks
670 "application/octet-stream"))
671 (string (completing-read
672 (format "Content type (default %s): " default)
675 (mm-delete-duplicates
677 (mapcar 'cdr mailcap-mime-extensions)
685 (let ((type (cdr (assq 'type (cdr m)))))
686 (if (equal (cadr (split-string type "/"))
691 mailcap-mime-data))))))))
692 (if (not (equal string ""))
696 (defun mml-minibuffer-read-description ()
697 (let ((description (read-string "One line description: ")))
698 (when (string-match "\\`[ \t]*\\'" description)
699 (setq description nil))
702 (defun mml-quote-region (beg end)
703 "Quote the MML tags in the region."
707 ;; Temporarily narrow the region to defend from changes
709 (narrow-to-region beg end)
710 (goto-char (point-min))
712 (while (re-search-forward
713 "<#/?!*\\(multipart\\|part\\|external\\|mml\\)" nil t)
714 ;; Insert ! after the #.
715 (goto-char (+ (match-beginning 0) 2))
718 (defun mml-insert-tag (name &rest plist)
719 "Insert an MML tag described by NAME and PLIST."
721 (setq name (symbol-name name)))
724 (let ((key (pop plist))
727 ;; Quote VALUE if it contains suspicious characters.
728 (when (string-match "[\"'\\~/*;() \t\n]" value)
729 (setq value (prin1-to-string value)))
730 (insert (format " %s=%s" key value)))))
733 (defun mml-insert-empty-tag (name &rest plist)
734 "Insert an empty MML tag described by NAME and PLIST."
736 (setq name (symbol-name name)))
737 (apply #'mml-insert-tag name plist)
738 (insert "<#/" name ">\n"))
740 ;;; Attachment functions.
742 (defun mml-attach-file (file &optional type description)
743 "Attach a file to the outgoing MIME message.
744 The file is not inserted or encoded until you send the message with
745 `\\[message-send-and-exit]' or `\\[message-send]'.
747 FILE is the name of the file to attach. TYPE is its content-type, a
748 string of the form \"type/subtype\". DESCRIPTION is a one-line
749 description of the attachment."
751 (let* ((file (mml-minibuffer-read-file "Attach file: "))
752 (type (mml-minibuffer-read-type file))
753 (description (mml-minibuffer-read-description)))
754 (list file type description)))
755 (mml-insert-empty-tag 'part 'type type 'filename file
756 'disposition "attachment" 'description description))
758 (defun mml-attach-buffer (buffer &optional type description)
759 "Attach a buffer to the outgoing MIME message.
760 See `mml-attach-file' for details of operation."
762 (let* ((buffer (read-buffer "Attach buffer: "))
763 (type (mml-minibuffer-read-type buffer "text/plain"))
764 (description (mml-minibuffer-read-description)))
765 (list buffer type description)))
766 (mml-insert-empty-tag 'part 'type type 'buffer buffer
767 'disposition "attachment" 'description description))
769 (defun mml-attach-external (file &optional type description)
770 "Attach an external file into the buffer.
771 FILE is an ange-ftp/efs specification of the part location.
772 TYPE is the MIME type to use."
774 (let* ((file (mml-minibuffer-read-file "Attach external file: "))
775 (type (mml-minibuffer-read-type file))
776 (description (mml-minibuffer-read-description)))
777 (list file type description)))
778 (mml-insert-empty-tag 'external 'type type 'name file
779 'disposition "attachment" 'description description))
781 (defun mml-insert-multipart (&optional type)
782 (interactive (list (completing-read "Multipart type (default mixed): "
783 '(("mixed") ("alternative") ("digest") ("parallel")
784 ("signed") ("encrypted"))
788 (mml-insert-empty-tag "multipart" 'type type)
791 (defun mml-insert-part (&optional type)
793 (list (mml-minibuffer-read-type "")))
794 (mml-insert-tag 'part 'type type 'disposition "inline")
797 (defun mml-preview (&optional raw)
798 "Display current buffer with Gnus, in a new buffer.
799 If RAW, don't highlight the article."
801 (let ((buf (current-buffer))
802 (message-posting-charset (or (gnus-setup-posting-charset
804 (message-narrow-to-headers-or-head)
805 (message-fetch-field "Newsgroups")))
806 message-posting-charset)))
807 (switch-to-buffer (get-buffer-create
808 (concat (if raw "*Raw MIME preview of "
809 "*MIME preview of ") (buffer-name))))
812 (if (re-search-forward
813 (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
814 (replace-match "\n"))
817 (mm-disable-multibyte)
818 (let ((gnus-newsgroup-charset (car message-posting-charset)))
819 (run-hooks 'gnus-article-decode-hook)
820 (let ((gnus-newsgroup-name "dummy"))
821 (gnus-article-prepare-display))))
823 (setq buffer-read-only t)
824 (goto-char (point-min))))
826 (defun mml-validate ()
827 "Validate the current MML document."