annotate lisp/gnus/mml.el @ 61660:b50c585113fd

*** empty log message ***
author YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
date Tue, 19 Apr 2005 12:05:04 +0000
parents b070535d2416
children 18a818a2ee7c bf0d492ea2d5
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1 ;;; mml.el --- A package for parsing and validating MML documents
59764
472e5513512f Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-58
Miles Bader <miles@gnu.org>
parents: 57581
diff changeset
2 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
3 ;; Free Software Foundation, Inc.
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
6 ;; This file is part of GNU Emacs.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
7
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
8 ;; GNU Emacs is free software; you can redistribute it and/or modify
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
9 ;; it under the terms of the GNU General Public License as published by
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
10 ;; the Free Software Foundation; either version 2, or (at your option)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
11 ;; any later version.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
12
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
13 ;; GNU Emacs is distributed in the hope that it will be useful,
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
16 ;; GNU General Public License for more details.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
17
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
18 ;; You should have received a copy of the GNU General Public License
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
19 ;; along with GNU Emacs; see the file COPYING. If not, write to the
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
21 ;; Boston, MA 02111-1307, USA.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
22
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
23 ;;; Commentary:
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
24
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
25 ;;; Code:
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
26
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
27 (require 'mm-util)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
28 (require 'mm-bodies)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
29 (require 'mm-encode)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
30 (require 'mm-decode)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
31 (require 'mml-sec)
33123
18591e92c712 *** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31764
diff changeset
32 (eval-when-compile (require 'cl))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
33
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
34 (eval-and-compile
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
35 (autoload 'message-make-message-id "message")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
36 (autoload 'gnus-setup-posting-charset "gnus-msg")
34797
b473bc6d9a55 * mml.el (gnus-add-minor-mode): Autoload.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents: 34752
diff changeset
37 (autoload 'gnus-add-minor-mode "gnus-ems")
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
38 (autoload 'gnus-make-local-hook "gnus-util")
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
39 (autoload 'message-fetch-field "message")
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
40 (autoload 'fill-flowed-encode "flow-fill")
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
41 (autoload 'message-posting-charset "message"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
42
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
43 (defcustom mml-content-type-parameters
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
44 '(name access-type expiration size permission format)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
45 "*A list of acceptable parameters in MML tag.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
46 These parameters are generated in Content-Type header if exists."
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 59764
diff changeset
47 :version "22.1"
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
48 :type '(repeat (symbol :tag "Parameter"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
49 :group 'message)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
50
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
51 (defcustom mml-content-disposition-parameters
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
52 '(filename creation-date modification-date read-date)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
53 "*A list of acceptable parameters in MML tag.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
54 These parameters are generated in Content-Disposition header if exists."
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 59764
diff changeset
55 :version "22.1"
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
56 :type '(repeat (symbol :tag "Parameter"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
57 :group 'message)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
58
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
59 (defcustom mml-insert-mime-headers-always nil
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
60 "If non-nil, always put Content-Type: text/plain at top of empty parts.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
61 It is necessary to work against a bug in certain clients."
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 59764
diff changeset
62 :version "22.1"
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
63 :type 'boolean
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
64 :group 'message)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
65
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
66 (defvar mml-tweak-type-alist nil
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
67 "A list of (TYPE . FUNCTION) for tweaking MML parts.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
68 TYPE is a string containing a regexp to match the MIME type. FUNCTION
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
69 is a Lisp function which is called with the MML handle to tweak the
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
70 part. This variable is used only when no TWEAK parameter exists in
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
71 the MML handle.")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
72
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
73 (defvar mml-tweak-function-alist nil
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
74 "A list of (NAME . FUNCTION) for tweaking MML parts.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
75 NAME is a string containing the name of the TWEAK parameter in the MML
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
76 handle. FUNCTION is a Lisp function which is called with the MML
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
77 handle to tweak the part.")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
78
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
79 (defvar mml-tweak-sexp-alist
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
80 '((mml-externalize-attachments . mml-tweak-externalize-attachments))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
81 "A list of (SEXP . FUNCTION) for tweaking MML parts.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
82 SEXP is an s-expression. If the evaluation of SEXP is non-nil, FUNCTION
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
83 is called. FUNCTION is a Lisp function which is called with the MML
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
84 handle to tweak the part.")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
85
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
86 (defvar mml-externalize-attachments nil
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
87 "*If non-nil, local-file attachments are generated as external parts.")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
88
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
89 (defvar mml-generate-multipart-alist nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
90 "*Alist of multipart generation functions.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
91 Each entry has the form (NAME . FUNCTION), where
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 43166
diff changeset
92 NAME is a string containing the name of the part (without the
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
93 leading \"/multipart/\"),
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
94 FUNCTION is a Lisp function which is called to generate the part.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
95
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
96 The Lisp function has to supply the appropriate MIME headers and the
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
97 contents of this part.")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
98
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
99 (defvar mml-syntax-table
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
100 (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
101 (modify-syntax-entry ?\\ "/" table)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
102 (modify-syntax-entry ?< "(" table)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
103 (modify-syntax-entry ?> ")" table)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
104 (modify-syntax-entry ?@ "w" table)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
105 (modify-syntax-entry ?/ "w" table)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
106 (modify-syntax-entry ?= " " table)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
107 (modify-syntax-entry ?* " " table)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
108 (modify-syntax-entry ?\; " " table)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
109 (modify-syntax-entry ?\' " " table)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
110 table))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
111
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
112 (defvar mml-boundary-function 'mml-make-boundary
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
113 "A function called to suggest a boundary.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
114 The function may be called several times, and should try to make a new
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
115 suggestion each time. The function is called with one parameter,
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
116 which is a number that says how many times the function has been
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
117 called for this message.")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
118
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
119 (defvar mml-confirmation-set nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
120 "A list of symbols, each of which disables some warning.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
121 `unknown-encoding': always send messages contain characters with
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
122 unknown encoding; `use-ascii': always use ASCII for those characters
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
123 with unknown encoding; `multipart': always send messages with more than
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
124 one charsets.")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
125
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
126 (defvar mml-generate-default-type "text/plain")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
127
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
128 (defvar mml-buffer-list nil)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
129
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 43166
diff changeset
130 (defun mml-generate-new-buffer (name)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
131 (let ((buf (generate-new-buffer name)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
132 (push buf mml-buffer-list)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
133 buf))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
134
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
135 (defun mml-destroy-buffers ()
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
136 (let (kill-buffer-hook)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
137 (mapcar 'kill-buffer mml-buffer-list)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
138 (setq mml-buffer-list nil)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
139
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
140 (defun mml-parse ()
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
141 "Parse the current buffer as an MML document."
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
142 (save-excursion
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
143 (goto-char (point-min))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
144 (let ((table (syntax-table)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
145 (unwind-protect
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
146 (progn
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
147 (set-syntax-table mml-syntax-table)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
148 (mml-parse-1))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
149 (set-syntax-table table)))))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
150
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
151 (defun mml-parse-1 ()
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
152 "Parse the current buffer as an MML document."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
153 (let (struct tag point contents charsets warn use-ascii no-markup-p raw)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
154 (while (and (not (eobp))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
155 (not (looking-at "<#/multipart")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
156 (cond
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
157 ((looking-at "<#secure")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
158 ;; The secure part is essentially a meta-meta tag, which
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
159 ;; expands to either a part tag if there are no other parts in
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
160 ;; the document or a multipart tag if there are other parts
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
161 ;; included in the message
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
162 (let* (secure-mode
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
163 (taginfo (mml-read-tag))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
164 (recipients (cdr (assq 'recipients taginfo)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
165 (sender (cdr (assq 'sender taginfo)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
166 (location (cdr (assq 'tag-location taginfo)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
167 (mode (cdr (assq 'mode taginfo)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
168 (method (cdr (assq 'method taginfo)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
169 tags)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
170 (save-excursion
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
171 (if
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
172 (re-search-forward
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
173 "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
174 (setq secure-mode "multipart")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
175 (setq secure-mode "part")))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
176 (save-excursion
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
177 (goto-char location)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
178 (re-search-forward "<#secure[^\n]*>\n"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
179 (delete-region (match-beginning 0) (match-end 0))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
180 (cond ((string= mode "sign")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
181 (setq tags (list "sign" method)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
182 ((string= mode "encrypt")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
183 (setq tags (list "encrypt" method)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
184 ((string= mode "signencrypt")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
185 (setq tags (list "sign" method "encrypt" method))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
186 (eval `(mml-insert-tag ,secure-mode
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
187 ,@tags
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
188 ,(if recipients "recipients")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
189 ,recipients
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
190 ,(if sender "sender")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
191 ,sender))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
192 ;; restart the parse
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
193 (goto-char location)))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
194 ((looking-at "<#multipart")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
195 (push (nconc (mml-read-tag) (mml-parse-1)) struct))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
196 ((looking-at "<#external")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
197 (push (nconc (mml-read-tag) (list (cons 'contents (mml-read-part))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
198 struct))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
199 (t
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
200 (if (or (looking-at "<#part") (looking-at "<#mml"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
201 (setq tag (mml-read-tag)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
202 no-markup-p nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
203 warn nil)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
204 (setq tag (list 'part '(type . "text/plain"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
205 no-markup-p t
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
206 warn t))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
207 (setq raw (cdr (assq 'raw tag))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
208 point (point)
31764
54ae1def18cf Merge from Gnus trunk.
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
209 contents (mml-read-part (eq 'mml (car tag)))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
210 charsets (cond
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
211 (raw nil)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
212 ((assq 'charset tag)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
213 (list
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
214 (intern (downcase (cdr (assq 'charset tag))))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
215 (t
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
216 (mm-find-mime-charset-region point (point)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
217 mm-hack-charsets))))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
218 (when (and (not raw) (memq nil charsets))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
219 (if (or (memq 'unknown-encoding mml-confirmation-set)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
220 (message-options-get 'unknown-encoding)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
221 (and (y-or-n-p "\
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
222 Message contains characters with unknown encoding. Really send? ")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
223 (message-options-set 'unknown-encoding t)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 43166
diff changeset
224 (if (setq use-ascii
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
225 (or (memq 'use-ascii mml-confirmation-set)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
226 (message-options-get 'use-ascii)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
227 (and (y-or-n-p "Use ASCII as charset? ")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
228 (message-options-set 'use-ascii t))))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
229 (setq charsets (delq nil charsets))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
230 (setq warn nil))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
231 (error "Edit your message to remove those characters")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
232 (if (or raw
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
233 (eq 'mml (car tag))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
234 (< (length charsets) 2))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
235 (if (or (not no-markup-p)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
236 (string-match "[^ \t\r\n]" contents))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
237 ;; Don't create blank parts.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
238 (push (nconc tag (list (cons 'contents contents)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
239 struct))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
240 (let ((nstruct (mml-parse-singlepart-with-multiple-charsets
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
241 tag point (point) use-ascii)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
242 (when (and warn
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
243 (not (memq 'multipart mml-confirmation-set))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
244 (not (message-options-get 'multipart))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
245 (not (and (y-or-n-p (format "\
35142
40698b92a36a (mml-parse-1): Frob mml-confirmation-set when proceeding
Dave Love <fx@gnu.org>
parents: 34797
diff changeset
246 A message part needs to be split into %d charset parts. Really send? "
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
247 (length nstruct)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
248 (message-options-set 'multipart t))))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
249 (error "Edit your message to use only one charset"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
250 (setq struct (nconc nstruct struct)))))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
251 (unless (eobp)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
252 (forward-line 1))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
253 (nreverse struct)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
254
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 43166
diff changeset
255 (defun mml-parse-singlepart-with-multiple-charsets
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
256 (orig-tag beg end &optional use-ascii)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
257 (save-excursion
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
258 (save-restriction
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
259 (narrow-to-region beg end)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
260 (goto-char (point-min))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
261 (let ((current (or (mm-mime-charset (mm-charset-after))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
262 (and use-ascii 'us-ascii)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
263 charset struct space newline paragraph)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
264 (while (not (eobp))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
265 (setq charset (mm-mime-charset (mm-charset-after)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
266 (cond
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
267 ;; The charset remains the same.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
268 ((eq charset 'us-ascii))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
269 ((or (and use-ascii (not charset))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
270 (eq charset current))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
271 (setq space nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
272 newline nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
273 paragraph nil))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
274 ;; The initial charset was ascii.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
275 ((eq current 'us-ascii)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
276 (setq current charset
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
277 space nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
278 newline nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
279 paragraph nil))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
280 ;; We have a change in charsets.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
281 (t
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
282 (push (append
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
283 orig-tag
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
284 (list (cons 'contents
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
285 (buffer-substring-no-properties
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
286 beg (or paragraph newline space (point))))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
287 struct)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
288 (setq beg (or paragraph newline space (point))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
289 current charset
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
290 space nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
291 newline nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
292 paragraph nil)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
293 ;; Compute places where it might be nice to break the part.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
294 (cond
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
295 ((memq (following-char) '(? ?\t))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
296 (setq space (1+ (point))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
297 ((and (eq (following-char) ?\n)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
298 (not (bobp))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
299 (eq (char-after (1- (point))) ?\n))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
300 (setq paragraph (point)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
301 ((eq (following-char) ?\n)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
302 (setq newline (1+ (point)))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
303 (forward-char 1))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
304 ;; Do the final part.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
305 (unless (= beg (point))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
306 (push (append orig-tag
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
307 (list (cons 'contents
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
308 (buffer-substring-no-properties
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
309 beg (point)))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
310 struct))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
311 struct))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
312
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
313 (defun mml-read-tag ()
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
314 "Read a tag and return the contents."
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
315 (let ((orig-point (point))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
316 contents name elem val)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
317 (forward-char 2)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
318 (setq name (buffer-substring-no-properties
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
319 (point) (progn (forward-sexp 1) (point))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
320 (skip-chars-forward " \t\n")
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
321 (while (not (looking-at ">[ \t]*\n?"))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
322 (setq elem (buffer-substring-no-properties
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
323 (point) (progn (forward-sexp 1) (point))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
324 (skip-chars-forward "= \t\n")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
325 (setq val (buffer-substring-no-properties
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
326 (point) (progn (forward-sexp 1) (point))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
327 (when (string-match "^\"\\(.*\\)\"$" val)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
328 (setq val (match-string 1 val)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
329 (push (cons (intern elem) val) contents)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
330 (skip-chars-forward " \t\n"))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
331 (goto-char (match-end 0))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
332 ;; Don't skip the leading space.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
333 ;;(skip-chars-forward " \t\n")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
334 ;; Put the tag location into the returned contents
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
335 (setq contents (append (list (cons 'tag-location orig-point)) contents))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
336 (cons (intern name) (nreverse contents))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
337
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
338 (defun mml-buffer-substring-no-properties-except-hard-newlines (start end)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
339 (let ((str (buffer-substring-no-properties start end))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
340 (bufstart start) tmp)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
341 (while (setq tmp (text-property-any start end 'hard 't))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
342 (set-text-properties (- tmp bufstart) (- tmp bufstart -1)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
343 '(hard t) str)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
344 (setq start (1+ tmp)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
345 str))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
346
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
347 (defun mml-read-part (&optional mml)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
348 "Return the buffer up till the next part, multipart or closing part or multipart.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
349 If MML is non-nil, return the buffer up till the correspondent mml tag."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
350 (let ((beg (point)) (count 1))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
351 ;; If the tag ended at the end of the line, we go to the next line.
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
352 (when (looking-at "[ \t]*\n")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
353 (forward-line 1))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
354 (if mml
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
355 (progn
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
356 (while (and (> count 0) (not (eobp)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
357 (if (re-search-forward "<#\\(/\\)?mml." nil t)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
358 (setq count (+ count (if (match-beginning 1) -1 1)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
359 (goto-char (point-max))))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
360 (mml-buffer-substring-no-properties-except-hard-newlines
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
361 beg (if (> count 0)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
362 (point)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
363 (match-beginning 0))))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
364 (if (re-search-forward
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
365 "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
366 (prog1
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
367 (mml-buffer-substring-no-properties-except-hard-newlines
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
368 beg (match-beginning 0))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
369 (if (or (not (match-beginning 1))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
370 (equal (match-string 2) "multipart"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
371 (goto-char (match-beginning 0))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
372 (when (looking-at "[ \t]*\n")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
373 (forward-line 1))))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
374 (mml-buffer-substring-no-properties-except-hard-newlines
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
375 beg (goto-char (point-max)))))))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
376
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
377 (defvar mml-boundary nil)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
378 (defvar mml-base-boundary "-=-=")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
379 (defvar mml-multipart-number 0)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
380
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
381 (defun mml-generate-mime ()
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
382 "Generate a MIME message based on the current MML document."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
383 (let ((cont (mml-parse))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
384 (mml-multipart-number mml-multipart-number))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
385 (if (not cont)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
386 nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
387 (with-temp-buffer
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
388 (if (and (consp (car cont))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
389 (= (length cont) 1))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
390 (mml-generate-mime-1 (car cont))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
391 (mml-generate-mime-1 (nconc (list 'multipart '(type . "mixed"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
392 cont)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
393 (buffer-string)))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
394
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
395 (defun mml-generate-mime-1 (cont)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
396 (let ((mm-use-ultra-safe-encoding
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
397 (or mm-use-ultra-safe-encoding (assq 'sign cont))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
398 (save-restriction
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
399 (narrow-to-region (point) (point))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
400 (mml-tweak-part cont)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
401 (cond
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
402 ((or (eq (car cont) 'part) (eq (car cont) 'mml))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
403 (let ((raw (cdr (assq 'raw cont)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
404 coded encoding charset filename type flowed)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
405 (setq type (or (cdr (assq 'type cont)) "text/plain"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
406 (if (and (not raw)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
407 (member (car (split-string type "/")) '("text" "message")))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
408 (progn
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
409 (with-temp-buffer
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
410 (setq charset (mm-charset-to-coding-system
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
411 (cdr (assq 'charset cont))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
412 (when (eq charset 'ascii)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
413 (setq charset nil))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
414 (cond
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
415 ((cdr (assq 'buffer cont))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
416 (insert-buffer-substring (cdr (assq 'buffer cont))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
417 ((and (setq filename (cdr (assq 'filename cont)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
418 (not (equal (cdr (assq 'nofile cont)) "yes")))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
419 (let ((coding-system-for-read charset))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
420 (mm-insert-file-contents filename)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
421 ((eq 'mml (car cont))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
422 (insert (cdr (assq 'contents cont))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
423 (t
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
424 (save-restriction
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
425 (narrow-to-region (point) (point))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
426 (insert (cdr (assq 'contents cont)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
427 ;; Remove quotes from quoted tags.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
428 (goto-char (point-min))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
429 (while (re-search-forward
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
430 "<#!+/?\\(part\\|multipart\\|external\\|mml\\)"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
431 nil t)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
432 (delete-region (+ (match-beginning 0) 2)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
433 (+ (match-beginning 0) 3))))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
434 (cond
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
435 ((eq (car cont) 'mml)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
436 (let ((mml-boundary (mml-compute-boundary cont))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
437 (mml-generate-default-type "text/plain"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
438 (mml-to-mime))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
439 (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
440 ;; ignore 0x1b, it is part of iso-2022-jp
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
441 (setq encoding (mm-body-7-or-8))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
442 ((string= (car (split-string type "/")) "message")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
443 (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
444 ;; ignore 0x1b, it is part of iso-2022-jp
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
445 (setq encoding (mm-body-7-or-8))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
446 (t
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
447 ;; Only perform format=flowed filling on text/plain
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
448 ;; parts where there either isn't a format parameter
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
449 ;; in the mml tag or it says "flowed" and there
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
450 ;; actually are hard newlines in the text.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
451 (let (use-hard-newlines)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
452 (when (and (string= type "text/plain")
57243
c5e16264557d Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-575
Miles Bader <miles@gnu.org>
parents: 57153
diff changeset
453 (not (string= (cdr (assq 'sign cont)) "pgp"))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
454 (or (null (assq 'format cont))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
455 (string= (cdr (assq 'format cont))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
456 "flowed"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
457 (setq use-hard-newlines
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
458 (text-property-any
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
459 (point-min) (point-max) 'hard 't)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
460 (fill-flowed-encode)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
461 ;; Indicate that `mml-insert-mime-headers' should
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
462 ;; insert a "; format=flowed" string unless the
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
463 ;; user has already specified it.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
464 (setq flowed (null (assq 'format cont)))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
465 (setq charset (mm-encode-body charset))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
466 (setq encoding (mm-body-encoding
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
467 charset (cdr (assq 'encoding cont))))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
468 (setq coded (buffer-string)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
469 (mml-insert-mime-headers cont type charset encoding flowed)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
470 (insert "\n")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
471 (insert coded))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
472 (mm-with-unibyte-buffer
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
473 (cond
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
474 ((cdr (assq 'buffer cont))
59764
472e5513512f Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-58
Miles Bader <miles@gnu.org>
parents: 57581
diff changeset
475 (insert (with-current-buffer (cdr (assq 'buffer cont))
472e5513512f Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-58
Miles Bader <miles@gnu.org>
parents: 57581
diff changeset
476 (mm-with-unibyte-current-buffer
472e5513512f Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-58
Miles Bader <miles@gnu.org>
parents: 57581
diff changeset
477 (buffer-string)))))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
478 ((and (setq filename (cdr (assq 'filename cont)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
479 (not (equal (cdr (assq 'nofile cont)) "yes")))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
480 (let ((coding-system-for-read mm-binary-coding-system))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
481 (mm-insert-file-contents filename nil nil nil nil t)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
482 (t
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
483 (insert (cdr (assq 'contents cont)))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
484 (setq encoding (mm-encode-buffer type)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
485 coded (mm-string-as-multibyte (buffer-string))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
486 (mml-insert-mime-headers cont type charset encoding nil)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
487 (insert "\n")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
488 (mm-with-unibyte-current-buffer
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
489 (insert coded)))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
490 ((eq (car cont) 'external)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
491 (insert "Content-Type: message/external-body")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
492 (let ((parameters (mml-parameter-string
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
493 cont '(expiration size permission)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
494 (name (cdr (assq 'name cont)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
495 (url (cdr (assq 'url cont))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
496 (when name
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
497 (setq name (mml-parse-file-name name))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
498 (if (stringp name)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
499 (mml-insert-parameter
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
500 (mail-header-encode-parameter "name" name)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
501 "access-type=local-file")
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
502 (mml-insert-parameter
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
503 (mail-header-encode-parameter
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
504 "name" (file-name-nondirectory (nth 2 name)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
505 (mail-header-encode-parameter "site" (nth 1 name))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
506 (mail-header-encode-parameter
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
507 "directory" (file-name-directory (nth 2 name))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
508 (mml-insert-parameter
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
509 (concat "access-type="
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
510 (if (member (nth 0 name) '("ftp@" "anonymous@"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
511 "anon-ftp"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
512 "ftp")))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
513 (when url
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
514 (mml-insert-parameter
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
515 (mail-header-encode-parameter "url" url)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
516 "access-type=url"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
517 (when parameters
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
518 (mml-insert-parameter-string
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
519 cont '(expiration size permission))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
520 (insert "\n\n")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
521 (insert "Content-Type: " (cdr (assq 'type cont)) "\n")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
522 (insert "Content-ID: " (message-make-message-id) "\n")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
523 (insert "Content-Transfer-Encoding: "
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
524 (or (cdr (assq 'encoding cont)) "binary"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
525 (insert "\n\n")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
526 (insert (or (cdr (assq 'contents cont))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
527 (insert "\n"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
528 ((eq (car cont) 'multipart)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
529 (let* ((type (or (cdr (assq 'type cont)) "mixed"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
530 (mml-generate-default-type (if (equal type "digest")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
531 "message/rfc822"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
532 "text/plain"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
533 (handler (assoc type mml-generate-multipart-alist)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
534 (if handler
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
535 (funcall (cdr handler) cont)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
536 ;; No specific handler. Use default one.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
537 (let ((mml-boundary (mml-compute-boundary cont)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
538 (insert (format "Content-Type: multipart/%s; boundary=\"%s\""
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
539 type mml-boundary)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
540 (if (cdr (assq 'start cont))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
541 (format "; start=\"%s\"\n" (cdr (assq 'start cont)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
542 "\n"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
543 (let ((cont cont) part)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
544 (while (setq part (pop cont))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
545 ;; Skip `multipart' and attributes.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
546 (when (and (consp part) (consp (cdr part)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
547 (insert "\n--" mml-boundary "\n")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
548 (mml-generate-mime-1 part))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
549 (insert "\n--" mml-boundary "--\n")))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
550 (t
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
551 (error "Invalid element: %S" cont)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
552 ;; handle sign & encrypt tags in a semi-smart way.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
553 (let ((sign-item (assoc (cdr (assq 'sign cont)) mml-sign-alist))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
554 (encrypt-item (assoc (cdr (assq 'encrypt cont))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
555 mml-encrypt-alist))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
556 sender recipients)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
557 (when (or sign-item encrypt-item)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
558 (when (setq sender (cdr (assq 'sender cont)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
559 (message-options-set 'mml-sender sender)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
560 (message-options-set 'message-sender sender))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
561 (if (setq recipients (cdr (assq 'recipients cont)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
562 (message-options-set 'message-recipients recipients))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
563 (let ((style (mml-signencrypt-style (first (or sign-item encrypt-item)))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
564 ;; check if: we're both signing & encrypting, both methods
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
565 ;; are the same (why would they be different?!), and that
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
566 ;; the signencrypt style allows for combined operation.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
567 (if (and sign-item encrypt-item (equal (first sign-item)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
568 (first encrypt-item))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
569 (equal style 'combined))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
570 (funcall (nth 1 encrypt-item) cont t)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
571 ;; otherwise, revert to the old behavior.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
572 (when sign-item
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
573 (funcall (nth 1 sign-item) cont))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
574 (when encrypt-item
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
575 (funcall (nth 1 encrypt-item) cont)))))))))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
576
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
577 (defun mml-compute-boundary (cont)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
578 "Return a unique boundary that does not exist in CONT."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
579 (let ((mml-boundary (funcall mml-boundary-function
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
580 (incf mml-multipart-number))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
581 ;; This function tries again and again until it has found
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
582 ;; a unique boundary.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
583 (while (not (catch 'not-unique
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
584 (mml-compute-boundary-1 cont))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
585 mml-boundary))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
586
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
587 (defun mml-compute-boundary-1 (cont)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
588 (let (filename)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
589 (cond
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
590 ((eq (car cont) 'part)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
591 (with-temp-buffer
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
592 (cond
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
593 ((cdr (assq 'buffer cont))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
594 (insert-buffer-substring (cdr (assq 'buffer cont))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
595 ((and (setq filename (cdr (assq 'filename cont)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
596 (not (equal (cdr (assq 'nofile cont)) "yes")))
57243
c5e16264557d Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-575
Miles Bader <miles@gnu.org>
parents: 57153
diff changeset
597 (mm-insert-file-contents filename nil nil nil nil t))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
598 (t
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
599 (insert (cdr (assq 'contents cont)))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
600 (goto-char (point-min))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
601 (when (re-search-forward (concat "^--" (regexp-quote mml-boundary))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
602 nil t)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
603 (setq mml-boundary (funcall mml-boundary-function
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
604 (incf mml-multipart-number)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
605 (throw 'not-unique nil))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
606 ((eq (car cont) 'multipart)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
607 (mapcar 'mml-compute-boundary-1 (cddr cont))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
608 t))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
609
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
610 (defun mml-make-boundary (number)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
611 (concat (make-string (% number 60) ?=)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
612 (if (> number 17)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
613 (format "%x" number)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
614 "")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
615 mml-base-boundary))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
616
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
617 (defun mml-insert-mime-headers (cont type charset encoding flowed)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
618 (let (parameters id disposition description)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
619 (setq parameters
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
620 (mml-parameter-string
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
621 cont mml-content-type-parameters))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
622 (when (or charset
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
623 parameters
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
624 flowed
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
625 (not (equal type mml-generate-default-type))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
626 mml-insert-mime-headers-always)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
627 (when (consp charset)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
628 (error
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
629 "Can't encode a part with several charsets"))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
630 (insert "Content-Type: " type)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
631 (when charset
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
632 (insert "; " (mail-header-encode-parameter
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
633 "charset" (symbol-name charset))))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
634 (when flowed
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
635 (insert "; format=flowed"))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
636 (when parameters
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
637 (mml-insert-parameter-string
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
638 cont mml-content-type-parameters))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
639 (insert "\n"))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
640 (when (setq id (cdr (assq 'id cont)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
641 (insert "Content-ID: " id "\n"))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
642 (setq parameters
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
643 (mml-parameter-string
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
644 cont mml-content-disposition-parameters))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
645 (when (or (setq disposition (cdr (assq 'disposition cont)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
646 parameters)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
647 (insert "Content-Disposition: " (or disposition "inline"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
648 (when parameters
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
649 (mml-insert-parameter-string
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
650 cont mml-content-disposition-parameters))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
651 (insert "\n"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
652 (unless (eq encoding '7bit)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
653 (insert (format "Content-Transfer-Encoding: %s\n" encoding)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
654 (when (setq description (cdr (assq 'description cont)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
655 (insert "Content-Description: "
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
656 (mail-encode-encoded-word-string description) "\n"))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
657
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
658 (defun mml-parameter-string (cont types)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
659 (let ((string "")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
660 value type)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
661 (while (setq type (pop types))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
662 (when (setq value (cdr (assq type cont)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
663 ;; Strip directory component from the filename parameter.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
664 (when (eq type 'filename)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
665 (setq value (file-name-nondirectory value)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
666 (setq string (concat string "; "
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
667 (mail-header-encode-parameter
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
668 (symbol-name type) value)))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
669 (when (not (zerop (length string)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
670 string)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
671
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
672 (defun mml-insert-parameter-string (cont types)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
673 (let (value type)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
674 (while (setq type (pop types))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
675 (when (setq value (cdr (assq type cont)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
676 ;; Strip directory component from the filename parameter.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
677 (when (eq type 'filename)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
678 (setq value (file-name-nondirectory value)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
679 (mml-insert-parameter
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
680 (mail-header-encode-parameter
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
681 (symbol-name type) value))))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
682
33301
c1c373a70748 Put some defvars in eval-when-compile.
Dave Love <fx@gnu.org>
parents: 33124
diff changeset
683 (eval-when-compile
c1c373a70748 Put some defvars in eval-when-compile.
Dave Love <fx@gnu.org>
parents: 33124
diff changeset
684 (defvar ange-ftp-name-format)
c1c373a70748 Put some defvars in eval-when-compile.
Dave Love <fx@gnu.org>
parents: 33124
diff changeset
685 (defvar efs-path-regexp))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
686 (defun mml-parse-file-name (path)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
687 (if (if (boundp 'efs-path-regexp)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
688 (string-match efs-path-regexp path)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
689 (if (boundp 'ange-ftp-name-format)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
690 (string-match (car ange-ftp-name-format) path)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
691 (list (match-string 1 path) (match-string 2 path)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
692 (substring path (1+ (match-end 2))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
693 path))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
694
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
695 (defun mml-insert-buffer (buffer)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
696 "Insert BUFFER at point and quote any MML markup."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
697 (save-restriction
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
698 (narrow-to-region (point) (point))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
699 (insert-buffer-substring buffer)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
700 (mml-quote-region (point-min) (point-max))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
701 (goto-char (point-max))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
702
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
703 ;;;
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
704 ;;; Transforming MIME to MML
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
705 ;;;
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
706
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
707 (defun mime-to-mml (&optional handles)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
708 "Translate the current buffer (which should be a message) into MML.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
709 If HANDLES is non-nil, use it instead reparsing the buffer."
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
710 ;; First decode the head.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
711 (save-restriction
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
712 (message-narrow-to-head)
60161
b070535d2416 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-111
Miles Bader <miles@gnu.org>
parents: 59996
diff changeset
713 (let ((rfc2047-quote-decoded-words-containing-tspecials t))
b070535d2416 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-111
Miles Bader <miles@gnu.org>
parents: 59996
diff changeset
714 (mail-decode-encoded-word-region (point-min) (point-max))))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
715 (unless handles
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
716 (setq handles (mm-dissect-buffer t)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
717 (goto-char (point-min))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
718 (search-forward "\n\n" nil t)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
719 (delete-region (point) (point-max))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
720 (if (stringp (car handles))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
721 (mml-insert-mime handles)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
722 (mml-insert-mime handles t))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
723 (mm-destroy-parts handles)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
724 (save-restriction
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
725 (message-narrow-to-head)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
726 ;; Remove them, they are confusing.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
727 (message-remove-header "Content-Type")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
728 (message-remove-header "MIME-Version")
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
729 (message-remove-header "Content-Disposition")
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
730 (message-remove-header "Content-Transfer-Encoding")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
731
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
732 (defun mml-to-mime ()
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
733 "Translate the current buffer from MML to MIME."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
734 (message-encode-message-body)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
735 (save-restriction
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
736 (message-narrow-to-headers-or-head)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
737 ;; Skip past any From_ headers.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
738 (while (looking-at "From ")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
739 (forward-line 1))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
740 (let ((mail-parse-charset message-default-charset))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
741 (mail-encode-encoded-word-buffer))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
742
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
743 (defun mml-insert-mime (handle &optional no-markup)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
744 (let (textp buffer mmlp)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
745 ;; Determine type and stuff.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
746 (unless (stringp (car handle))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
747 (unless (setq textp (equal (mm-handle-media-supertype handle) "text"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
748 (save-excursion
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
749 (set-buffer (setq buffer (mml-generate-new-buffer " *mml*")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
750 (mm-insert-part handle)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 43166
diff changeset
751 (if (setq mmlp (equal (mm-handle-media-type handle)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
752 "message/rfc822"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
753 (mime-to-mml)))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
754 (if mmlp
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
755 (mml-insert-mml-markup handle nil t t)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
756 (unless (and no-markup
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
757 (equal (mm-handle-media-type handle) "text/plain"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
758 (mml-insert-mml-markup handle buffer textp)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
759 (cond
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 43166
diff changeset
760 (mmlp
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
761 (insert-buffer-substring buffer)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
762 (goto-char (point-max))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
763 (insert "<#/mml>\n"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
764 ((stringp (car handle))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
765 (mapcar 'mml-insert-mime (cdr handle))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
766 (insert "<#/multipart>\n"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
767 (textp
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
768 (let ((charset (mail-content-type-get
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
769 (mm-handle-type handle) 'charset))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
770 (start (point)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
771 (if (eq charset 'gnus-decoded)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
772 (mm-insert-part handle)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
773 (insert (mm-decode-string (mm-get-part handle) charset)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
774 (mml-quote-region start (point)))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
775 (goto-char (point-max)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
776 (t
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
777 (insert "<#/part>\n")))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
778
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
779 (defun mml-insert-mml-markup (handle &optional buffer nofile mmlp)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
780 "Take a MIME handle and insert an MML tag."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
781 (if (stringp (car handle))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
782 (progn
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
783 (insert "<#multipart type=" (mm-handle-media-subtype handle))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
784 (let ((start (mm-handle-multipart-ctl-parameter handle 'start)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
785 (when start
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
786 (insert " start=\"" start "\"")))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
787 (insert ">\n"))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
788 (if mmlp
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
789 (insert "<#mml type=" (mm-handle-media-type handle))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
790 (insert "<#part type=" (mm-handle-media-type handle)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
791 (dolist (elem (append (cdr (mm-handle-type handle))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
792 (cdr (mm-handle-disposition handle))))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
793 (unless (symbolp (cdr elem))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
794 (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\"")))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
795 (when (mm-handle-id handle)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
796 (insert " id=\"" (mm-handle-id handle) "\""))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
797 (when (mm-handle-disposition handle)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
798 (insert " disposition=" (car (mm-handle-disposition handle))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
799 (when buffer
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
800 (insert " buffer=\"" (buffer-name buffer) "\""))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
801 (when nofile
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
802 (insert " nofile=yes"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
803 (when (mm-handle-description handle)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
804 (insert " description=\"" (mm-handle-description handle) "\""))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
805 (insert ">\n")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
806
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
807 (defun mml-insert-parameter (&rest parameters)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
808 "Insert PARAMETERS in a nice way."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
809 (dolist (param parameters)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
810 (insert ";")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
811 (let ((point (point)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
812 (insert " " param)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
813 (when (> (current-column) 71)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
814 (goto-char point)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
815 (insert "\n ")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
816 (end-of-line)))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
817
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
818 ;;;
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
819 ;;; Mode for inserting and editing MML forms
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
820 ;;;
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
821
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
822 (defvar mml-mode-map
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
823 (let ((sign (make-sparse-keymap))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
824 (encrypt (make-sparse-keymap))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
825 (signpart (make-sparse-keymap))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
826 (encryptpart (make-sparse-keymap))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
827 (map (make-sparse-keymap))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
828 (main (make-sparse-keymap)))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
829 (define-key sign "p" 'mml-secure-message-sign-pgpmime)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
830 (define-key sign "o" 'mml-secure-message-sign-pgp)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
831 (define-key sign "s" 'mml-secure-message-sign-smime)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
832 (define-key signpart "p" 'mml-secure-sign-pgpmime)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
833 (define-key signpart "o" 'mml-secure-sign-pgp)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
834 (define-key signpart "s" 'mml-secure-sign-smime)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
835 (define-key encrypt "p" 'mml-secure-message-encrypt-pgpmime)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
836 (define-key encrypt "o" 'mml-secure-message-encrypt-pgp)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
837 (define-key encrypt "s" 'mml-secure-message-encrypt-smime)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
838 (define-key encryptpart "p" 'mml-secure-encrypt-pgpmime)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
839 (define-key encryptpart "o" 'mml-secure-encrypt-pgp)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
840 (define-key encryptpart "s" 'mml-secure-encrypt-smime)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
841 (define-key map "\C-n" 'mml-unsecure-message)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
842 (define-key map "f" 'mml-attach-file)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
843 (define-key map "b" 'mml-attach-buffer)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
844 (define-key map "e" 'mml-attach-external)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
845 (define-key map "q" 'mml-quote-region)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
846 (define-key map "m" 'mml-insert-multipart)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
847 (define-key map "p" 'mml-insert-part)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
848 (define-key map "v" 'mml-validate)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
849 (define-key map "P" 'mml-preview)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
850 (define-key map "s" sign)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
851 (define-key map "S" signpart)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
852 (define-key map "c" encrypt)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
853 (define-key map "C" encryptpart)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
854 ;;(define-key map "n" 'mml-narrow-to-part)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
855 ;; `M-m' conflicts with `back-to-indentation'.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
856 ;; (define-key main "\M-m" map)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
857 (define-key main "\C-c\C-m" map)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
858 main))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
859
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
860 (easy-menu-define
40758
ShengHuo ZHU <zsh@cs.rochester.edu>
parents: 40757
diff changeset
861 mml-menu mml-mode-map ""
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
862 `("Attachments"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
863 ["Attach File..." mml-attach-file
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
864 ,@(if (featurep 'xemacs) '(t)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
865 '(:help "Attach a file at point"))]
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
866 ["Attach Buffer..." mml-attach-buffer t]
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
867 ["Attach External..." mml-attach-external t]
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
868 ["Insert Part..." mml-insert-part t]
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
869 ["Insert Multipart..." mml-insert-multipart t]
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
870 ["PGP/MIME Sign" mml-secure-message-sign-pgpmime t]
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
871 ["PGP/MIME Encrypt" mml-secure-message-encrypt-pgpmime t]
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
872 ["PGP Sign" mml-secure-message-sign-pgp t]
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
873 ["PGP Encrypt" mml-secure-message-encrypt-pgp t]
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
874 ["S/MIME Sign" mml-secure-message-sign-smime t]
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
875 ["S/MIME Encrypt" mml-secure-message-encrypt-smime t]
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
876 ("Secure MIME part"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
877 ["PGP/MIME Sign Part" mml-secure-sign-pgpmime t]
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
878 ["PGP/MIME Encrypt Part" mml-secure-encrypt-pgpmime t]
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
879 ["PGP Sign Part" mml-secure-sign-pgp t]
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
880 ["PGP Encrypt Part" mml-secure-encrypt-pgp t]
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
881 ["S/MIME Sign Part" mml-secure-sign-smime t]
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
882 ["S/MIME Encrypt Part" mml-secure-encrypt-smime t])
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
883 ["Encrypt/Sign off" mml-unsecure-message t]
40758
ShengHuo ZHU <zsh@cs.rochester.edu>
parents: 40757
diff changeset
884 ;;["Narrow" mml-narrow-to-part t]
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
885 ["Quote MML" mml-quote-region t]
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
886 ["Validate MML" mml-validate t]
40758
ShengHuo ZHU <zsh@cs.rochester.edu>
parents: 40757
diff changeset
887 ["Preview" mml-preview t]))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
888
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
889 (defvar mml-mode nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
890 "Minor mode for editing MML.")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
891
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
892 (defun mml-mode (&optional arg)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
893 "Minor mode for editing MML.
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
894 MML is the MIME Meta Language, a minor mode for composing MIME articles.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
895 See Info node `(emacs-mime)Composing'.
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
896
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
897 \\{mml-mode-map}"
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
898 (interactive "P")
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
899 (when (set (make-local-variable 'mml-mode)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
900 (if (null arg) (not mml-mode)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
901 (> (prefix-numeric-value arg) 0)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
902 (gnus-add-minor-mode 'mml-mode " MML" mml-mode-map)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
903 (easy-menu-add mml-menu mml-mode-map)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
904 (run-hooks 'mml-mode-hook)))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
905
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
906 ;;;
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
907 ;;; Helper functions for reading MIME stuff from the minibuffer and
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
908 ;;; inserting stuff to the buffer.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
909 ;;;
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
910
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
911 (defun mml-minibuffer-read-file (prompt)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
912 (let* ((completion-ignored-extensions nil)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
913 (file (read-file-name prompt nil nil t)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
914 ;; Prevent some common errors. This is inspired by similar code in
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
915 ;; VM.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
916 (when (file-directory-p file)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
917 (error "%s is a directory, cannot attach" file))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
918 (unless (file-exists-p file)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
919 (error "No such file: %s" file))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
920 (unless (file-readable-p file)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
921 (error "Permission denied: %s" file))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
922 file))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
923
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
924 (defun mml-minibuffer-read-type (name &optional default)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
925 (mailcap-parse-mimetypes)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
926 (let* ((default (or default
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
927 (mm-default-file-encoding name)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
928 ;; Perhaps here we should check what the file
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
929 ;; looks like, and offer text/plain if it looks
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
930 ;; like text/plain.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
931 "application/octet-stream"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
932 (string (completing-read
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
933 (format "Content type (default %s): " default)
33124
4e779ba474ee (mml-parse-1): Clarify message.
Dave Love <fx@gnu.org>
parents: 33123
diff changeset
934 (mapcar 'list (mailcap-mime-types)))))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
935 (if (not (equal string ""))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
936 string
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
937 default)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
938
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
939 (defun mml-minibuffer-read-description ()
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
940 (let ((description (read-string "One line description: ")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
941 (when (string-match "\\`[ \t]*\\'" description)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
942 (setq description nil))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
943 description))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
944
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
945 (defun mml-minibuffer-read-disposition (type &optional default)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
946 (let* ((default (or default
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
947 (if (string-match "^text/.*" type)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
948 "inline"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
949 "attachment")))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
950 (disposition (completing-read "Disposition: "
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
951 '(("attachment") ("inline") (""))
57442
2d9a1d1ac73d Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-610
Miles Bader <miles@gnu.org>
parents: 57243
diff changeset
952 nil t)))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
953 (if (not (equal disposition ""))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
954 disposition
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
955 default)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
956
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
957 (defun mml-quote-region (beg end)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
958 "Quote the MML tags in the region."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
959 (interactive "r")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
960 (save-excursion
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
961 (save-restriction
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
962 ;; Temporarily narrow the region to defend from changes
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
963 ;; invalidating END.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
964 (narrow-to-region beg end)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
965 (goto-char (point-min))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
966 ;; Quote parts.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
967 (while (re-search-forward
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
968 "<#!*/?\\(multipart\\|part\\|external\\|mml\\)" nil t)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
969 ;; Insert ! after the #.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
970 (goto-char (+ (match-beginning 0) 2))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
971 (insert "!")))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
972
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
973 (defun mml-insert-tag (name &rest plist)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
974 "Insert an MML tag described by NAME and PLIST."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
975 (when (symbolp name)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
976 (setq name (symbol-name name)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
977 (insert "<#" name)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
978 (while plist
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
979 (let ((key (pop plist))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
980 (value (pop plist)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
981 (when value
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
982 ;; Quote VALUE if it contains suspicious characters.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
983 (when (string-match "[\"'\\~/*;() \t\n]" value)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
984 (setq value (with-output-to-string
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
985 (let (print-escape-nonascii)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
986 (prin1 value)))))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
987 (insert (format " %s=%s" key value)))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
988 (insert ">\n"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
989
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
990 (defun mml-insert-empty-tag (name &rest plist)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
991 "Insert an empty MML tag described by NAME and PLIST."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
992 (when (symbolp name)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
993 (setq name (symbol-name name)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
994 (apply #'mml-insert-tag name plist)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
995 (insert "<#/" name ">\n"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
996
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
997 ;;; Attachment functions.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
998
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
999 (defun mml-attach-file (file &optional type description disposition)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1000 "Attach a file to the outgoing MIME message.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1001 The file is not inserted or encoded until you send the message with
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1002 `\\[message-send-and-exit]' or `\\[message-send]'.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1003
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1004 FILE is the name of the file to attach. TYPE is its content-type, a
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1005 string of the form \"type/subtype\". DESCRIPTION is a one-line
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1006 description of the attachment."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1007 (interactive
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1008 (let* ((file (mml-minibuffer-read-file "Attach file: "))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1009 (type (mml-minibuffer-read-type file))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1010 (description (mml-minibuffer-read-description))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1011 (disposition (mml-minibuffer-read-disposition type)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1012 (list file type description disposition)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1013 (mml-insert-empty-tag 'part
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1014 'type type
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1015 'filename file
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1016 'disposition (or disposition "attachment")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1017 'description description))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1018
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1019 (defun mml-attach-buffer (buffer &optional type description)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1020 "Attach a buffer to the outgoing MIME message.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1021 See `mml-attach-file' for details of operation."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1022 (interactive
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1023 (let* ((buffer (read-buffer "Attach buffer: "))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1024 (type (mml-minibuffer-read-type buffer "text/plain"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1025 (description (mml-minibuffer-read-description)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1026 (list buffer type description)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1027 (mml-insert-empty-tag 'part 'type type 'buffer buffer
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1028 'disposition "attachment" 'description description))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1029
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1030 (defun mml-attach-external (file &optional type description)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1031 "Attach an external file into the buffer.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1032 FILE is an ange-ftp/efs specification of the part location.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1033 TYPE is the MIME type to use."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1034 (interactive
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1035 (let* ((file (mml-minibuffer-read-file "Attach external file: "))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1036 (type (mml-minibuffer-read-type file))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1037 (description (mml-minibuffer-read-description)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1038 (list file type description)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1039 (mml-insert-empty-tag 'external 'type type 'name file
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1040 'disposition "attachment" 'description description))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1041
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1042 (defun mml-insert-multipart (&optional type)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1043 (interactive (list (completing-read "Multipart type (default mixed): "
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1044 '(("mixed") ("alternative") ("digest") ("parallel")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1045 ("signed") ("encrypted"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1046 nil nil "mixed")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1047 (or type
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1048 (setq type "mixed"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1049 (mml-insert-empty-tag "multipart" 'type type)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1050 (forward-line -1))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1051
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1052 (defun mml-insert-part (&optional type)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1053 (interactive
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1054 (list (mml-minibuffer-read-type "")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1055 (mml-insert-tag 'part 'type type 'disposition "inline")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1056 (forward-line -1))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1057
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1058 (defun mml-preview-insert-mail-followup-to ()
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1059 "Insert a Mail-Followup-To header before previewing an article.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1060 Should be adopted if code in `message-send-mail' is changed."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1061 (when (and (message-mail-p)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1062 (message-subscribed-p)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1063 (not (mail-fetch-field "mail-followup-to"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1064 (message-make-mail-followup-to))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1065 (message-position-on-field "Mail-Followup-To" "X-Draft-From")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1066 (insert (message-make-mail-followup-to))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1067
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1068 (defun mml-preview (&optional raw)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1069 "Display current buffer with Gnus, in a new buffer.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1070 If RAW, don't highlight the article."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1071 (interactive "P")
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1072 (save-excursion
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1073 (let* ((buf (current-buffer))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1074 (message-options message-options)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1075 (message-this-is-mail (message-mail-p))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1076 (message-this-is-news (message-news-p))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1077 (message-posting-charset (or (gnus-setup-posting-charset
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1078 (save-restriction
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1079 (message-narrow-to-headers-or-head)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1080 (message-fetch-field "Newsgroups")))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1081 message-posting-charset)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1082 (message-options-set-recipient)
57581
645f020dcc8a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-626
Miles Bader <miles@gnu.org>
parents: 57442
diff changeset
1083 (pop-to-buffer (generate-new-buffer
645f020dcc8a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-626
Miles Bader <miles@gnu.org>
parents: 57442
diff changeset
1084 (concat (if raw "*Raw MIME preview of "
645f020dcc8a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-626
Miles Bader <miles@gnu.org>
parents: 57442
diff changeset
1085 "*MIME preview of ") (buffer-name))))
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1086 (when (boundp 'gnus-buffers)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1087 (push (current-buffer) gnus-buffers))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1088 (erase-buffer)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1089 (insert-buffer-substring buf)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1090 (mml-preview-insert-mail-followup-to)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1091 (let ((message-deletable-headers (if (message-news-p)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1092 nil
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1093 message-deletable-headers)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1094 (message-generate-headers
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1095 (copy-sequence (if (message-news-p)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1096 message-required-news-headers
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1097 message-required-mail-headers))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1098 (if (re-search-forward
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1099 (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1100 (replace-match "\n"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1101 (let ((mail-header-separator ""));; mail-header-separator is removed.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1102 (mml-to-mime))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1103 (if raw
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1104 (when (fboundp 'set-buffer-multibyte)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1105 (let ((s (buffer-string)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1106 ;; Insert the content into unibyte buffer.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1107 (erase-buffer)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1108 (mm-disable-multibyte)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1109 (insert s)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1110 (let ((gnus-newsgroup-charset (car message-posting-charset))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1111 gnus-article-prepare-hook gnus-original-article-buffer)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1112 (run-hooks 'gnus-article-decode-hook)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1113 (let ((gnus-newsgroup-name "dummy")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1114 (gnus-newsrc-hashtb (or gnus-newsrc-hashtb
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1115 (gnus-make-hashtable 5))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1116 (gnus-article-prepare-display))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1117 ;; Disable article-mode-map.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1118 (use-local-map nil)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1119 (gnus-make-local-hook 'kill-buffer-hook)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1120 (add-hook 'kill-buffer-hook
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1121 (lambda ()
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1122 (mm-destroy-parts gnus-article-mime-handles)) nil t)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1123 (setq buffer-read-only t)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1124 (local-set-key "q" (lambda () (interactive) (kill-buffer nil)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1125 (local-set-key "=" (lambda () (interactive) (delete-other-windows)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1126 (local-set-key "\r"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1127 (lambda ()
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1128 (interactive)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1129 (widget-button-press (point))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1130 (local-set-key gnus-mouse-2
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1131 (lambda (event)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1132 (interactive "@e")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1133 (widget-button-press (widget-event-point event) event)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1134 (goto-char (point-min)))))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1135
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1136 (defun mml-validate ()
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1137 "Validate the current MML document."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1138 (interactive)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1139 (mml-parse))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1140
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1141 (defun mml-tweak-part (cont)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1142 "Tweak a MML part."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1143 (let ((tweak (cdr (assq 'tweak cont)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1144 func)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1145 (cond
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1146 (tweak
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1147 (setq func
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1148 (or (cdr (assoc tweak mml-tweak-function-alist))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1149 (intern tweak))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1150 (mml-tweak-type-alist
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1151 (let ((alist mml-tweak-type-alist)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1152 (type (or (cdr (assq 'type cont)) "text/plain")))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1153 (while alist
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1154 (if (string-match (caar alist) type)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1155 (setq func (cdar alist)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1156 alist nil)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1157 (setq alist (cdr alist)))))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1158 (if func
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1159 (funcall func cont)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1160 cont)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1161 (let ((alist mml-tweak-sexp-alist))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1162 (while alist
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1163 (if (eval (caar alist))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1164 (funcall (cdar alist) cont))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1165 (setq alist (cdr alist)))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1166 cont)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1167
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1168 (defun mml-tweak-externalize-attachments (cont)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1169 "Tweak attached files as external parts."
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1170 (let (filename-cons)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1171 (when (and (eq (car cont) 'part)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1172 (not (cdr (assq 'buffer cont)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1173 (and (setq filename-cons (assq 'filename cont))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1174 (not (equal (cdr (assq 'nofile cont)) "yes"))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1175 (setcar cont 'external)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1176 (setcar filename-cons 'name))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
1177
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1178 (provide 'mml)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1179
52401
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 49598
diff changeset
1180 ;;; arch-tag: 583c96cf-1ffe-451b-a5e5-4733ae9ddd12
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1181 ;;; mml.el ends here