Mercurial > emacs
annotate lisp/gnus/mml.el @ 90667:dbe3f29e61d6
Merge from emacs--devo--0
Patches applied:
* emacs--devo--0 (patch 505-522)
- Update from CVS
- Merge from gnus--rel--5.10
- Update from CVS: etc/TUTORIAL.cn: Updated.
- Merge from erc--emacs--22
* gnus--rel--5.10 (patch 164-167)
- Update from CVS
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-137
author | Miles Bader <miles@gnu.org> |
---|---|
date | Tue, 21 Nov 2006 08:56:38 +0000 |
parents | 2ecafc6d5db7 234305495123 |
children | 95d0cdf160ea |
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 |
64754
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64712
diff
changeset
|
2 |
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64712
diff
changeset
|
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
68606
5ea0e0a7dd38
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-42
Miles Bader <miles@gnu.org>
parents:
68380
diff
changeset
|
4 ;; 2005, 2006 Free Software Foundation, Inc. |
31717 | 5 |
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | |
7 ;; This file is part of GNU Emacs. | |
8 | |
9 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
10 ;; it under the terms of the GNU General Public License as published by | |
11 ;; the Free Software Foundation; either version 2, or (at your option) | |
12 ;; any later version. | |
13 | |
14 ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 ;; GNU General Public License for more details. | |
18 | |
19 ;; You should have received a copy of the GNU General Public License | |
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
64085 | 21 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
22 ;; Boston, MA 02110-1301, USA. | |
31717 | 23 |
24 ;;; Commentary: | |
25 | |
26 ;;; Code: | |
27 | |
28 (require 'mm-util) | |
29 (require 'mm-bodies) | |
30 (require 'mm-encode) | |
31 (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
|
32 (require 'mml-sec) |
33123
18591e92c712
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31764
diff
changeset
|
33 (eval-when-compile (require 'cl)) |
31717 | 34 |
35 (eval-and-compile | |
36 (autoload 'message-make-message-id "message") | |
37 (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
|
38 (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
|
39 (autoload 'gnus-make-local-hook "gnus-util") |
31717 | 40 (autoload 'message-fetch-field "message") |
68380
e1843613ecb8
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-14
Miles Bader <miles@gnu.org>
parents:
66808
diff
changeset
|
41 (autoload 'message-info "message") |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
42 (autoload 'fill-flowed-encode "flow-fill") |
70245
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
43 (autoload 'message-posting-charset "message") |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
44 (autoload 'dnd-get-local-file-name "dnd")) |
31717 | 45 |
65280
4ec96459e1b5
(gnus-article-mime-handles, gnus-mouse-2, gnus-newsrc-hashtb,
Juanma Barranquero <lekktu@gmail.com>
parents:
64754
diff
changeset
|
46 (defvar gnus-article-mime-handles) |
4ec96459e1b5
(gnus-article-mime-handles, gnus-mouse-2, gnus-newsrc-hashtb,
Juanma Barranquero <lekktu@gmail.com>
parents:
64754
diff
changeset
|
47 (defvar gnus-mouse-2) |
4ec96459e1b5
(gnus-article-mime-handles, gnus-mouse-2, gnus-newsrc-hashtb,
Juanma Barranquero <lekktu@gmail.com>
parents:
64754
diff
changeset
|
48 (defvar gnus-newsrc-hashtb) |
4ec96459e1b5
(gnus-article-mime-handles, gnus-mouse-2, gnus-newsrc-hashtb,
Juanma Barranquero <lekktu@gmail.com>
parents:
64754
diff
changeset
|
49 (defvar message-default-charset) |
4ec96459e1b5
(gnus-article-mime-handles, gnus-mouse-2, gnus-newsrc-hashtb,
Juanma Barranquero <lekktu@gmail.com>
parents:
64754
diff
changeset
|
50 (defvar message-deletable-headers) |
4ec96459e1b5
(gnus-article-mime-handles, gnus-mouse-2, gnus-newsrc-hashtb,
Juanma Barranquero <lekktu@gmail.com>
parents:
64754
diff
changeset
|
51 (defvar message-options) |
4ec96459e1b5
(gnus-article-mime-handles, gnus-mouse-2, gnus-newsrc-hashtb,
Juanma Barranquero <lekktu@gmail.com>
parents:
64754
diff
changeset
|
52 (defvar message-posting-charset) |
4ec96459e1b5
(gnus-article-mime-handles, gnus-mouse-2, gnus-newsrc-hashtb,
Juanma Barranquero <lekktu@gmail.com>
parents:
64754
diff
changeset
|
53 (defvar message-required-mail-headers) |
4ec96459e1b5
(gnus-article-mime-handles, gnus-mouse-2, gnus-newsrc-hashtb,
Juanma Barranquero <lekktu@gmail.com>
parents:
64754
diff
changeset
|
54 (defvar message-required-news-headers) |
70245
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
55 (defvar dnd-protocol-alist) |
65280
4ec96459e1b5
(gnus-article-mime-handles, gnus-mouse-2, gnus-newsrc-hashtb,
Juanma Barranquero <lekktu@gmail.com>
parents:
64754
diff
changeset
|
56 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
57 (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
|
58 '(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
|
59 "*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
|
60 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
|
61 :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
|
62 :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
|
63 :group 'message) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
64 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
65 (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
|
66 '(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
|
67 "*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
|
68 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
|
69 :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
|
70 :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
|
71 :group 'message) |
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 (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
|
74 "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
|
75 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
|
76 :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
|
77 :type 'boolean |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
78 :group 'message) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
79 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
80 (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
|
81 "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
|
82 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
|
83 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
|
84 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
|
85 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
|
86 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
87 (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
|
88 "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
|
89 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
|
90 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
|
91 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
|
92 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
93 (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
|
94 '((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
|
95 "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
|
96 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
|
97 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
|
98 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
|
99 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
100 (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
|
101 "*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
|
102 |
31717 | 103 (defvar mml-generate-multipart-alist nil |
104 "*Alist of multipart generation functions. | |
105 Each entry has the form (NAME . FUNCTION), where | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43166
diff
changeset
|
106 NAME is a string containing the name of the part (without the |
31717 | 107 leading \"/multipart/\"), |
108 FUNCTION is a Lisp function which is called to generate the part. | |
109 | |
110 The Lisp function has to supply the appropriate MIME headers and the | |
111 contents of this part.") | |
112 | |
113 (defvar mml-syntax-table | |
114 (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) | |
115 (modify-syntax-entry ?\\ "/" table) | |
116 (modify-syntax-entry ?< "(" table) | |
117 (modify-syntax-entry ?> ")" table) | |
118 (modify-syntax-entry ?@ "w" table) | |
119 (modify-syntax-entry ?/ "w" table) | |
120 (modify-syntax-entry ?= " " table) | |
121 (modify-syntax-entry ?* " " table) | |
122 (modify-syntax-entry ?\; " " table) | |
123 (modify-syntax-entry ?\' " " table) | |
124 table)) | |
125 | |
126 (defvar mml-boundary-function 'mml-make-boundary | |
127 "A function called to suggest a boundary. | |
128 The function may be called several times, and should try to make a new | |
129 suggestion each time. The function is called with one parameter, | |
130 which is a number that says how many times the function has been | |
131 called for this message.") | |
132 | |
133 (defvar mml-confirmation-set nil | |
134 "A list of symbols, each of which disables some warning. | |
135 `unknown-encoding': always send messages contain characters with | |
136 unknown encoding; `use-ascii': always use ASCII for those characters | |
137 with unknown encoding; `multipart': always send messages with more than | |
138 one charsets.") | |
139 | |
64693
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
140 (defvar mml-generate-default-type "text/plain" |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
141 "Content type by which the Content-Type header can be omitted. |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
142 The Content-Type header will not be put in the MIME part if the type |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
143 equals the value and there's no parameter (e.g. charset, format, etc.) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
144 and `mml-insert-mime-headers-always' is nil. The value will be bound |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
145 to \"message/rfc822\" when encoding an article to be forwarded as a MIME |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
146 part. This is for the internal use, you should never modify the value.") |
31717 | 147 |
148 (defvar mml-buffer-list nil) | |
149 | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43166
diff
changeset
|
150 (defun mml-generate-new-buffer (name) |
31717 | 151 (let ((buf (generate-new-buffer name))) |
152 (push buf mml-buffer-list) | |
153 buf)) | |
154 | |
155 (defun mml-destroy-buffers () | |
156 (let (kill-buffer-hook) | |
157 (mapcar 'kill-buffer mml-buffer-list) | |
158 (setq mml-buffer-list nil))) | |
159 | |
160 (defun mml-parse () | |
161 "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
|
162 (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
163 (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
|
164 (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
|
165 (unwind-protect |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
166 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
167 (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
|
168 (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
|
169 (set-syntax-table table))))) |
31717 | 170 |
171 (defun mml-parse-1 () | |
172 "Parse the current buffer as an MML document." | |
173 (let (struct tag point contents charsets warn use-ascii no-markup-p raw) | |
174 (while (and (not (eobp)) | |
175 (not (looking-at "<#/multipart"))) | |
176 (cond | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
177 ((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
|
178 ;; 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
|
179 ;; 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
|
180 ;; 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
|
181 ;; 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
|
182 (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
|
183 (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
|
184 (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
|
185 (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
|
186 (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
|
187 (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
|
188 (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
|
189 tags) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
190 (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
191 (if |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
192 (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
|
193 "<#\\(/\\)?\\(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
|
194 (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
|
195 (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
|
196 (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
197 (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
|
198 (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
|
199 (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
|
200 (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
|
201 (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
|
202 ((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
|
203 (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
|
204 ((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
|
205 (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
|
206 (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
|
207 ,@tags |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
208 ,(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
|
209 ,recipients |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
210 ,(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
|
211 ,sender)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
212 ;; 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
|
213 (goto-char location))) |
31717 | 214 ((looking-at "<#multipart") |
215 (push (nconc (mml-read-tag) (mml-parse-1)) struct)) | |
216 ((looking-at "<#external") | |
217 (push (nconc (mml-read-tag) (list (cons 'contents (mml-read-part)))) | |
218 struct)) | |
219 (t | |
220 (if (or (looking-at "<#part") (looking-at "<#mml")) | |
221 (setq tag (mml-read-tag) | |
222 no-markup-p nil | |
223 warn nil) | |
224 (setq tag (list 'part '(type . "text/plain")) | |
225 no-markup-p t | |
226 warn t)) | |
227 (setq raw (cdr (assq 'raw tag)) | |
228 point (point) | |
31764 | 229 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
|
230 charsets (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
231 (raw nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
232 ((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
|
233 (list |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
234 (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
|
235 (t |
89986
eebcd044d7bc
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-45
Miles Bader <miles@gnu.org>
parents:
89983
diff
changeset
|
236 (mm-find-mime-charset-region point (point))))) |
31717 | 237 (when (and (not raw) (memq nil charsets)) |
238 (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
|
239 (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
|
240 (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
|
241 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
|
242 (message-options-set 'unknown-encoding t))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43166
diff
changeset
|
243 (if (setq use-ascii |
31717 | 244 (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
|
245 (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
|
246 (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
|
247 (message-options-set 'use-ascii t)))) |
31717 | 248 (setq charsets (delq nil charsets)) |
249 (setq warn nil)) | |
250 (error "Edit your message to remove those characters"))) | |
251 (if (or raw | |
252 (eq 'mml (car tag)) | |
253 (< (length charsets) 2)) | |
254 (if (or (not no-markup-p) | |
255 (string-match "[^ \t\r\n]" contents)) | |
256 ;; Don't create blank parts. | |
257 (push (nconc tag (list (cons 'contents contents))) | |
258 struct)) | |
259 (let ((nstruct (mml-parse-singlepart-with-multiple-charsets | |
260 tag point (point) use-ascii))) | |
261 (when (and warn | |
262 (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
|
263 (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
|
264 (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
|
265 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
|
266 (length nstruct))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
267 (message-options-set 'multipart t)))) |
31717 | 268 (error "Edit your message to use only one charset")) |
269 (setq struct (nconc nstruct struct))))))) | |
270 (unless (eobp) | |
271 (forward-line 1)) | |
272 (nreverse struct))) | |
273 | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43166
diff
changeset
|
274 (defun mml-parse-singlepart-with-multiple-charsets |
31717 | 275 (orig-tag beg end &optional use-ascii) |
276 (save-excursion | |
277 (save-restriction | |
278 (narrow-to-region beg end) | |
279 (goto-char (point-min)) | |
280 (let ((current (or (mm-mime-charset (mm-charset-after)) | |
281 (and use-ascii 'us-ascii))) | |
282 charset struct space newline paragraph) | |
283 (while (not (eobp)) | |
284 (setq charset (mm-mime-charset (mm-charset-after))) | |
285 (cond | |
286 ;; The charset remains the same. | |
287 ((eq charset 'us-ascii)) | |
288 ((or (and use-ascii (not charset)) | |
289 (eq charset current)) | |
290 (setq space nil | |
291 newline nil | |
292 paragraph nil)) | |
293 ;; The initial charset was ascii. | |
294 ((eq current 'us-ascii) | |
295 (setq current charset | |
296 space nil | |
297 newline nil | |
298 paragraph nil)) | |
299 ;; We have a change in charsets. | |
300 (t | |
301 (push (append | |
302 orig-tag | |
303 (list (cons 'contents | |
304 (buffer-substring-no-properties | |
305 beg (or paragraph newline space (point)))))) | |
306 struct) | |
307 (setq beg (or paragraph newline space (point)) | |
308 current charset | |
309 space nil | |
310 newline nil | |
311 paragraph nil))) | |
312 ;; Compute places where it might be nice to break the part. | |
313 (cond | |
314 ((memq (following-char) '(? ?\t)) | |
315 (setq space (1+ (point)))) | |
316 ((and (eq (following-char) ?\n) | |
317 (not (bobp)) | |
318 (eq (char-after (1- (point))) ?\n)) | |
319 (setq paragraph (point))) | |
320 ((eq (following-char) ?\n) | |
321 (setq newline (1+ (point))))) | |
322 (forward-char 1)) | |
323 ;; Do the final part. | |
324 (unless (= beg (point)) | |
325 (push (append orig-tag | |
326 (list (cons 'contents | |
327 (buffer-substring-no-properties | |
328 beg (point))))) | |
329 struct)) | |
330 struct)))) | |
331 | |
332 (defun mml-read-tag () | |
333 "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
|
334 (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
|
335 contents name elem val) |
31717 | 336 (forward-char 2) |
337 (setq name (buffer-substring-no-properties | |
338 (point) (progn (forward-sexp 1) (point)))) | |
339 (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
|
340 (while (not (looking-at ">[ \t]*\n?")) |
31717 | 341 (setq elem (buffer-substring-no-properties |
342 (point) (progn (forward-sexp 1) (point)))) | |
343 (skip-chars-forward "= \t\n") | |
344 (setq val (buffer-substring-no-properties | |
345 (point) (progn (forward-sexp 1) (point)))) | |
346 (when (string-match "^\"\\(.*\\)\"$" val) | |
347 (setq val (match-string 1 val))) | |
348 (push (cons (intern elem) val) contents) | |
349 (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
|
350 (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
|
351 ;; 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
|
352 ;;(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
|
353 ;; 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
|
354 (setq contents (append (list (cons 'tag-location orig-point)) contents)) |
31717 | 355 (cons (intern name) (nreverse contents)))) |
356 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
357 (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
|
358 (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
|
359 (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
|
360 (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
|
361 (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
|
362 '(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
|
363 (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
|
364 str)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
365 |
31717 | 366 (defun mml-read-part (&optional mml) |
367 "Return the buffer up till the next part, multipart or closing part or multipart. | |
368 If MML is non-nil, return the buffer up till the correspondent mml tag." | |
369 (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
|
370 ;; If the tag ended at the end of the line, we go to the next line. |
31717 | 371 (when (looking-at "[ \t]*\n") |
372 (forward-line 1)) | |
373 (if mml | |
374 (progn | |
375 (while (and (> count 0) (not (eobp))) | |
376 (if (re-search-forward "<#\\(/\\)?mml." nil t) | |
377 (setq count (+ count (if (match-beginning 1) -1 1))) | |
378 (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
|
379 (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
|
380 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
|
381 (point) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
382 (match-beginning 0)))) |
31717 | 383 (if (re-search-forward |
384 "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t) | |
385 (prog1 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
386 (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
|
387 beg (match-beginning 0)) |
31717 | 388 (if (or (not (match-beginning 1)) |
389 (equal (match-string 2) "multipart")) | |
390 (goto-char (match-beginning 0)) | |
391 (when (looking-at "[ \t]*\n") | |
392 (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
|
393 (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
|
394 beg (goto-char (point-max))))))) |
31717 | 395 |
396 (defvar mml-boundary nil) | |
397 (defvar mml-base-boundary "-=-=") | |
398 (defvar mml-multipart-number 0) | |
399 | |
400 (defun mml-generate-mime () | |
401 "Generate a MIME message based on the current MML document." | |
402 (let ((cont (mml-parse)) | |
403 (mml-multipart-number mml-multipart-number)) | |
404 (if (not cont) | |
405 nil | |
406 (with-temp-buffer | |
407 (if (and (consp (car cont)) | |
408 (= (length cont) 1)) | |
409 (mml-generate-mime-1 (car cont)) | |
410 (mml-generate-mime-1 (nconc (list 'multipart '(type . "mixed")) | |
411 cont))) | |
412 (buffer-string))))) | |
413 | |
414 (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
|
415 (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
|
416 (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
|
417 (save-restriction |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
418 (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
|
419 (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
|
420 (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
421 ((or (eq (car cont) 'part) (eq (car cont) 'mml)) |
64693
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
422 (let* ((raw (cdr (assq 'raw cont))) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
423 (filename (cdr (assq 'filename cont))) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
424 (type (or (cdr (assq 'type cont)) |
64712
4db92b217e85
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-507
Miles Bader <miles@gnu.org>
parents:
64693
diff
changeset
|
425 (if filename |
4db92b217e85
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-507
Miles Bader <miles@gnu.org>
parents:
64693
diff
changeset
|
426 (or (mm-default-file-encoding filename) |
4db92b217e85
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-507
Miles Bader <miles@gnu.org>
parents:
64693
diff
changeset
|
427 "application/octet-stream") |
4db92b217e85
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-507
Miles Bader <miles@gnu.org>
parents:
64693
diff
changeset
|
428 "text/plain"))) |
64693
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
429 coded encoding charset flowed) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
430 (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
|
431 (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
|
432 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
433 (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
|
434 (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
|
435 (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
|
436 (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
|
437 (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
|
438 (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
439 ((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
|
440 (insert-buffer-substring (cdr (assq 'buffer cont)))) |
64693
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
441 ((and filename |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
442 (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
|
443 (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
|
444 (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
|
445 ((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
|
446 (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
|
447 (t |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
448 (save-restriction |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
449 (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
|
450 (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
|
451 ;; 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
|
452 (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
|
453 (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
|
454 "<#!+/?\\(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
|
455 nil t) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
456 (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
|
457 (+ (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
|
458 (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
459 ((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
|
460 (let ((mml-boundary (mml-compute-boundary cont)) |
64693
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
461 ;; It is necessary for the case where this |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
462 ;; function is called recursively since |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
463 ;; `m-g-d-t' will be bound to "message/rfc822" |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
464 ;; when encoding an article to be forwarded. |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
465 (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
|
466 (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
|
467 (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
|
468 ;; 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
|
469 (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
|
470 ((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
|
471 (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
|
472 ;; 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
|
473 (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
|
474 (t |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
475 ;; 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
|
476 ;; 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
|
477 ;; 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
|
478 ;; 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
|
479 (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
|
480 (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
|
481 (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
|
482 (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
|
483 (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
|
484 "flowed")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
485 (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
|
486 (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
|
487 (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
|
488 (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
|
489 ;; 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
|
490 ;; 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
|
491 ;; 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
|
492 (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
|
493 (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
|
494 (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
|
495 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
|
496 (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
|
497 (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
|
498 (insert "\n") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
499 (insert coded)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
500 (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
|
501 (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
502 ((cdr (assq 'buffer cont)) |
74021 | 503 (insert (mm-string-as-unibyte |
504 (with-current-buffer (cdr (assq 'buffer cont)) | |
505 (buffer-string))))) | |
64693
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
506 ((and filename |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
507 (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
|
508 (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
|
509 (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
|
510 (t |
69247
6580c61aced7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-134
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
511 (let ((contents (cdr (assq 'contents cont)))) |
6580c61aced7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-134
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
512 (if (if (featurep 'xemacs) |
6580c61aced7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-134
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
513 (string-match "[^\000-\377]" contents) |
6580c61aced7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-134
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
514 (mm-multibyte-string-p contents)) |
6580c61aced7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-134
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
515 (progn |
6580c61aced7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-134
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
516 (mm-enable-multibyte) |
6580c61aced7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-134
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
517 (insert contents) |
6580c61aced7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-134
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
518 (setq charset (mm-encode-body))) |
6580c61aced7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-134
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
519 (insert contents))))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
520 (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
|
521 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
|
522 (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
|
523 (insert "\n") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
524 (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
|
525 (insert coded))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
526 ((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
|
527 (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
|
528 (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
|
529 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
|
530 (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
|
531 (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
|
532 (when name |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
533 (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
|
534 (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
|
535 (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
|
536 (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
|
537 "access-type=local-file") |
31717 | 538 (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
|
539 (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
|
540 "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
|
541 (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
|
542 (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
|
543 "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
|
544 (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
|
545 (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
|
546 (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
|
547 "anon-ftp" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
548 "ftp"))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
549 (when url |
31717 | 550 (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
|
551 (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
|
552 "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
|
553 (when parameters |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
554 (mml-insert-parameter-string |
64693
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
555 cont '(expiration size permission))) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
556 (insert "\n\n") |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
557 (insert "Content-Type: " |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
558 (or (cdr (assq 'type cont)) |
64712
4db92b217e85
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-507
Miles Bader <miles@gnu.org>
parents:
64693
diff
changeset
|
559 (if name |
4db92b217e85
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-507
Miles Bader <miles@gnu.org>
parents:
64693
diff
changeset
|
560 (or (mm-default-file-encoding name) |
4db92b217e85
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-507
Miles Bader <miles@gnu.org>
parents:
64693
diff
changeset
|
561 "application/octet-stream") |
4db92b217e85
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-507
Miles Bader <miles@gnu.org>
parents:
64693
diff
changeset
|
562 "text/plain")) |
64693
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
563 "\n") |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
564 (insert "Content-ID: " (message-make-message-id) "\n") |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
565 (insert "Content-Transfer-Encoding: " |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
566 (or (cdr (assq 'encoding cont)) "binary")) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
567 (insert "\n\n") |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
568 (insert (or (cdr (assq 'contents cont)))) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
569 (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
|
570 ((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
|
571 (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
|
572 (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
|
573 "message/rfc822" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
574 "text/plain")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
575 (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
|
576 (if handler |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
577 (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
|
578 ;; 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
|
579 (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
|
580 (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
|
581 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
|
582 (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
|
583 (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
|
584 "\n")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
585 (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
|
586 (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
|
587 ;; 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
|
588 (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
|
589 (insert "\n--" mml-boundary "\n") |
68606
5ea0e0a7dd38
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-42
Miles Bader <miles@gnu.org>
parents:
68380
diff
changeset
|
590 (mml-generate-mime-1 part) |
5ea0e0a7dd38
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-42
Miles Bader <miles@gnu.org>
parents:
68380
diff
changeset
|
591 (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
|
592 (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
|
593 (t |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
594 (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
|
595 ;; 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
|
596 (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
|
597 (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
|
598 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
|
599 sender recipients) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
600 (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
|
601 (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
|
602 (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
|
603 (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
|
604 (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
|
605 (message-options-set 'message-recipients recipients)) |
64693
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
606 (let ((style (mml-signencrypt-style |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64582
diff
changeset
|
607 (first (or sign-item encrypt-item))))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
608 ;; 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
|
609 ;; 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
|
610 ;; 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
|
611 (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
|
612 (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
|
613 (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
|
614 (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
|
615 ;; 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
|
616 (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
|
617 (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
|
618 (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
|
619 (funcall (nth 1 encrypt-item) cont))))))))) |
31717 | 620 |
621 (defun mml-compute-boundary (cont) | |
622 "Return a unique boundary that does not exist in CONT." | |
623 (let ((mml-boundary (funcall mml-boundary-function | |
624 (incf mml-multipart-number)))) | |
625 ;; This function tries again and again until it has found | |
626 ;; a unique boundary. | |
627 (while (not (catch 'not-unique | |
628 (mml-compute-boundary-1 cont)))) | |
629 mml-boundary)) | |
630 | |
631 (defun mml-compute-boundary-1 (cont) | |
632 (let (filename) | |
633 (cond | |
634 ((eq (car cont) 'part) | |
635 (with-temp-buffer | |
636 (cond | |
637 ((cdr (assq 'buffer cont)) | |
638 (insert-buffer-substring (cdr (assq 'buffer cont)))) | |
639 ((and (setq filename (cdr (assq 'filename cont))) | |
640 (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
|
641 (mm-insert-file-contents filename nil nil nil nil t)) |
31717 | 642 (t |
643 (insert (cdr (assq 'contents cont))))) | |
644 (goto-char (point-min)) | |
645 (when (re-search-forward (concat "^--" (regexp-quote mml-boundary)) | |
646 nil t) | |
647 (setq mml-boundary (funcall mml-boundary-function | |
648 (incf mml-multipart-number))) | |
649 (throw 'not-unique nil)))) | |
650 ((eq (car cont) 'multipart) | |
651 (mapcar 'mml-compute-boundary-1 (cddr cont)))) | |
652 t)) | |
653 | |
654 (defun mml-make-boundary (number) | |
655 (concat (make-string (% number 60) ?=) | |
656 (if (> number 17) | |
657 (format "%x" number) | |
658 "") | |
659 mml-base-boundary)) | |
660 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
661 (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
|
662 (let (parameters id disposition description) |
31717 | 663 (setq parameters |
664 (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
|
665 cont mml-content-type-parameters)) |
31717 | 666 (when (or charset |
667 parameters | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
668 flowed |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
669 (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
|
670 mml-insert-mime-headers-always) |
31717 | 671 (when (consp charset) |
672 (error | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
673 "Can't encode a part with several charsets")) |
31717 | 674 (insert "Content-Type: " type) |
675 (when charset | |
68720
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
676 (mml-insert-parameter |
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
677 (mail-header-encode-parameter "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
|
678 (when flowed |
68720
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
679 (mml-insert-parameter "format=flowed")) |
31717 | 680 (when parameters |
681 (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
|
682 cont mml-content-type-parameters)) |
31717 | 683 (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
|
684 (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
|
685 (insert "Content-ID: " id "\n")) |
31717 | 686 (setq parameters |
687 (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
|
688 cont mml-content-disposition-parameters)) |
31717 | 689 (when (or (setq disposition (cdr (assq 'disposition cont))) |
690 parameters) | |
691 (insert "Content-Disposition: " (or disposition "inline")) | |
692 (when parameters | |
693 (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
|
694 cont mml-content-disposition-parameters)) |
31717 | 695 (insert "\n")) |
696 (unless (eq encoding '7bit) | |
697 (insert (format "Content-Transfer-Encoding: %s\n" encoding))) | |
698 (when (setq description (cdr (assq 'description cont))) | |
68720
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
699 (insert "Content-Description: ") |
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
700 (setq description (prog1 |
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
701 (point) |
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
702 (insert description "\n"))) |
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
703 (mail-encode-encoded-word-region description (point))))) |
31717 | 704 |
705 (defun mml-parameter-string (cont types) | |
706 (let ((string "") | |
707 value type) | |
708 (while (setq type (pop types)) | |
709 (when (setq value (cdr (assq type cont))) | |
710 ;; Strip directory component from the filename parameter. | |
711 (when (eq type 'filename) | |
712 (setq value (file-name-nondirectory value))) | |
713 (setq string (concat string "; " | |
714 (mail-header-encode-parameter | |
715 (symbol-name type) value))))) | |
716 (when (not (zerop (length string))) | |
717 string))) | |
718 | |
719 (defun mml-insert-parameter-string (cont types) | |
720 (let (value type) | |
721 (while (setq type (pop types)) | |
722 (when (setq value (cdr (assq type cont))) | |
723 ;; Strip directory component from the filename parameter. | |
724 (when (eq type 'filename) | |
725 (setq value (file-name-nondirectory value))) | |
726 (mml-insert-parameter | |
727 (mail-header-encode-parameter | |
728 (symbol-name type) value)))))) | |
729 | |
33301
c1c373a70748
Put some defvars in eval-when-compile.
Dave Love <fx@gnu.org>
parents:
33124
diff
changeset
|
730 (eval-when-compile |
c1c373a70748
Put some defvars in eval-when-compile.
Dave Love <fx@gnu.org>
parents:
33124
diff
changeset
|
731 (defvar ange-ftp-name-format) |
c1c373a70748
Put some defvars in eval-when-compile.
Dave Love <fx@gnu.org>
parents:
33124
diff
changeset
|
732 (defvar efs-path-regexp)) |
31717 | 733 (defun mml-parse-file-name (path) |
734 (if (if (boundp 'efs-path-regexp) | |
735 (string-match efs-path-regexp path) | |
736 (if (boundp 'ange-ftp-name-format) | |
737 (string-match (car ange-ftp-name-format) path))) | |
738 (list (match-string 1 path) (match-string 2 path) | |
739 (substring path (1+ (match-end 2)))) | |
740 path)) | |
741 | |
742 (defun mml-insert-buffer (buffer) | |
743 "Insert BUFFER at point and quote any MML markup." | |
744 (save-restriction | |
745 (narrow-to-region (point) (point)) | |
746 (insert-buffer-substring buffer) | |
747 (mml-quote-region (point-min) (point-max)) | |
748 (goto-char (point-max)))) | |
749 | |
750 ;;; | |
751 ;;; Transforming MIME to MML | |
752 ;;; | |
753 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
754 (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
|
755 "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
|
756 If HANDLES is non-nil, use it instead reparsing the buffer." |
31717 | 757 ;; First decode the head. |
758 (save-restriction | |
759 (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
|
760 (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
|
761 (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
|
762 (unless handles |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
763 (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
|
764 (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
|
765 (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
|
766 (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
|
767 (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
|
768 (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
|
769 (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
|
770 (mm-destroy-parts handles) |
31717 | 771 (save-restriction |
772 (message-narrow-to-head) | |
773 ;; Remove them, they are confusing. | |
774 (message-remove-header "Content-Type") | |
775 (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
|
776 (message-remove-header "Content-Disposition") |
31717 | 777 (message-remove-header "Content-Transfer-Encoding"))) |
778 | |
779 (defun mml-to-mime () | |
780 "Translate the current buffer from MML to MIME." | |
781 (message-encode-message-body) | |
782 (save-restriction | |
783 (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
|
784 ;; 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
|
785 (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
|
786 (forward-line 1)) |
31717 | 787 (let ((mail-parse-charset message-default-charset)) |
788 (mail-encode-encoded-word-buffer)))) | |
789 | |
790 (defun mml-insert-mime (handle &optional no-markup) | |
791 (let (textp buffer mmlp) | |
792 ;; Determine type and stuff. | |
793 (unless (stringp (car handle)) | |
794 (unless (setq textp (equal (mm-handle-media-supertype handle) "text")) | |
795 (save-excursion | |
796 (set-buffer (setq buffer (mml-generate-new-buffer " *mml*"))) | |
69649
ab0b847baba4
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-176
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
797 (mm-insert-part handle 'no-cache) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43166
diff
changeset
|
798 (if (setq mmlp (equal (mm-handle-media-type handle) |
31717 | 799 "message/rfc822")) |
800 (mime-to-mml))))) | |
801 (if mmlp | |
802 (mml-insert-mml-markup handle nil t t) | |
803 (unless (and no-markup | |
804 (equal (mm-handle-media-type handle) "text/plain")) | |
805 (mml-insert-mml-markup handle buffer textp))) | |
806 (cond | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43166
diff
changeset
|
807 (mmlp |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
808 (insert-buffer-substring buffer) |
31717 | 809 (goto-char (point-max)) |
810 (insert "<#/mml>\n")) | |
811 ((stringp (car handle)) | |
812 (mapcar 'mml-insert-mime (cdr handle)) | |
813 (insert "<#/multipart>\n")) | |
814 (textp | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
815 (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
|
816 (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
|
817 (start (point))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
818 (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
|
819 (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
|
820 (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
|
821 (mml-quote-region start (point))) |
31717 | 822 (goto-char (point-max))) |
823 (t | |
824 (insert "<#/part>\n"))))) | |
825 | |
826 (defun mml-insert-mml-markup (handle &optional buffer nofile mmlp) | |
827 "Take a MIME handle and insert an MML tag." | |
828 (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
|
829 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
830 (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
|
831 (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
|
832 (when start |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
833 (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
|
834 (insert ">\n")) |
31717 | 835 (if mmlp |
836 (insert "<#mml type=" (mm-handle-media-type handle)) | |
837 (insert "<#part type=" (mm-handle-media-type handle))) | |
838 (dolist (elem (append (cdr (mm-handle-type handle)) | |
839 (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
|
840 (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
|
841 (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
|
842 (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
|
843 (insert " id=\"" (mm-handle-id handle) "\"")) |
31717 | 844 (when (mm-handle-disposition handle) |
845 (insert " disposition=" (car (mm-handle-disposition handle)))) | |
846 (when buffer | |
847 (insert " buffer=\"" (buffer-name buffer) "\"")) | |
848 (when nofile | |
849 (insert " nofile=yes")) | |
850 (when (mm-handle-description handle) | |
851 (insert " description=\"" (mm-handle-description handle) "\"")) | |
852 (insert ">\n"))) | |
853 | |
854 (defun mml-insert-parameter (&rest parameters) | |
855 "Insert PARAMETERS in a nice way." | |
68720
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
856 (let (start end) |
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
857 (dolist (param parameters) |
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
858 (insert ";") |
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
859 (setq start (point)) |
31717 | 860 (insert " " param) |
68720
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
861 (setq end (point)) |
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
862 (goto-char start) |
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
863 (end-of-line) |
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
864 (if (> (current-column) 76) |
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
865 (progn |
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
866 (goto-char start) |
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
867 (insert "\n") |
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
868 (goto-char (1+ end))) |
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68606
diff
changeset
|
869 (goto-char end))))) |
31717 | 870 |
871 ;;; | |
872 ;;; Mode for inserting and editing MML forms | |
873 ;;; | |
874 | |
875 (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
|
876 (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
|
877 (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
|
878 (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
|
879 (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
|
880 (map (make-sparse-keymap)) |
31717 | 881 (main (make-sparse-keymap))) |
70245
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
882 (define-key map "\C-s" 'mml-secure-message-sign) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
883 (define-key map "\C-c" 'mml-secure-message-encrypt) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
884 (define-key map "\C-e" 'mml-secure-message-sign-encrypt) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
885 (define-key map "\C-p\C-s" 'mml-secure-sign) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
886 (define-key map "\C-p\C-c" 'mml-secure-encrypt) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
887 (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
|
888 (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
|
889 (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
|
890 (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
|
891 (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
|
892 (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
|
893 (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
|
894 (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
|
895 (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
|
896 (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
|
897 (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
|
898 (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
|
899 (define-key map "\C-n" 'mml-unsecure-message) |
31717 | 900 (define-key map "f" 'mml-attach-file) |
901 (define-key map "b" 'mml-attach-buffer) | |
902 (define-key map "e" 'mml-attach-external) | |
903 (define-key map "q" 'mml-quote-region) | |
904 (define-key map "m" 'mml-insert-multipart) | |
905 (define-key map "p" 'mml-insert-part) | |
906 (define-key map "v" 'mml-validate) | |
907 (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
|
908 (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
|
909 (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
|
910 (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
|
911 (define-key map "C" encryptpart) |
31717 | 912 ;;(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
|
913 ;; `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
|
914 ;; (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
|
915 (define-key main "\C-c\C-m" map) |
31717 | 916 main)) |
917 | |
918 (easy-menu-define | |
40758 | 919 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
|
920 `("Attachments" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
921 ["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
|
922 ,@(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
|
923 '(:help "Attach a file at point"))] |
70245
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
924 ["Attach Buffer..." mml-attach-buffer |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
925 ,@(if (featurep 'xemacs) '(t) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
926 '(:help "Attach a buffer to the outgoing MIME message"))] |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
927 ["Attach External..." mml-attach-external |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
928 ,@(if (featurep 'xemacs) '(t) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
929 '(:help "Attach reference to file"))] |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
930 ;; |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
931 ("Change Security Method" |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
932 ["PGP/MIME" |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
933 (lambda () (interactive) (setq mml-secure-method "pgpmime")) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
934 ,@(if (featurep 'xemacs) nil |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
935 '(:help "Set Security Method to PGP/MIME")) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
936 :style radio |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
937 :selected (equal mml-secure-method "pgpmime") ] |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
938 ["S/MIME" |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
939 (lambda () (interactive) (setq mml-secure-method "smime")) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
940 ,@(if (featurep 'xemacs) nil |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
941 '(:help "Set Security Method to S/MIME")) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
942 :style radio |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
943 :selected (equal mml-secure-method "smime") ] |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
944 ["Inline PGP" |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
945 (lambda () (interactive) (setq mml-secure-method "pgp")) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
946 ,@(if (featurep 'xemacs) nil |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
947 '(:help "Set Security Method to inline PGP")) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
948 :style radio |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
949 :selected (equal mml-secure-method "pgp") ] ) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
950 ;; |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
951 ["Sign Message" mml-secure-message-sign t] |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
952 ["Encrypt Message" mml-secure-message-encrypt t] |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
953 ["Sign and Encrypt Message" mml-secure-message-sign-encrypt t] |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
954 ["Encrypt/Sign off" mml-unsecure-message |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
955 ,@(if (featurep 'xemacs) '(t) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
956 '(:help "Don't Encrypt/Sign Message"))] |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
957 ;; Maybe we could remove these, because people who write MML most probably |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
958 ;; don't use the menu: |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
959 ["Insert Part..." mml-insert-part |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
960 :active (message-in-body-p)] |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
961 ["Insert Multipart..." mml-insert-multipart |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
962 :active (message-in-body-p)] |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
963 ;; |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
964 ;; Do we have separate encrypt and encrypt/sign commands for parts? |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
965 ["Sign Part" mml-secure-sign t] |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
966 ["Encrypt Part" mml-secure-encrypt t] |
40758 | 967 ;;["Narrow" mml-narrow-to-part t] |
70245
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
968 ["Quote MML in region" mml-quote-region |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
969 :active (message-mark-active-p) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
970 ,@(if (featurep 'xemacs) nil |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
971 '(:help "Quote MML tags in region"))] |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
972 ["Validate MML" mml-validate t] |
68380
e1843613ecb8
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-14
Miles Bader <miles@gnu.org>
parents:
66808
diff
changeset
|
973 ["Preview" mml-preview t] |
e1843613ecb8
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-14
Miles Bader <miles@gnu.org>
parents:
66808
diff
changeset
|
974 "----" |
e1843613ecb8
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-14
Miles Bader <miles@gnu.org>
parents:
66808
diff
changeset
|
975 ["Emacs MIME manual" (lambda () (interactive) (message-info 4)) |
e1843613ecb8
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-14
Miles Bader <miles@gnu.org>
parents:
66808
diff
changeset
|
976 ,@(if (featurep 'xemacs) '(t) |
e1843613ecb8
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-14
Miles Bader <miles@gnu.org>
parents:
66808
diff
changeset
|
977 '(:help "Display the Emacs MIME manual"))] |
e1843613ecb8
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-14
Miles Bader <miles@gnu.org>
parents:
66808
diff
changeset
|
978 ["PGG manual" (lambda () (interactive) (message-info 16)) |
e1843613ecb8
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-14
Miles Bader <miles@gnu.org>
parents:
66808
diff
changeset
|
979 ,@(if (featurep 'xemacs) '(t) |
e1843613ecb8
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-14
Miles Bader <miles@gnu.org>
parents:
66808
diff
changeset
|
980 '(:help "Display the PGG manual"))])) |
31717 | 981 |
982 (defvar mml-mode nil | |
983 "Minor mode for editing MML.") | |
984 | |
985 (defun mml-mode (&optional arg) | |
986 "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
|
987 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
|
988 See Info node `(emacs-mime)Composing'. |
31717 | 989 |
990 \\{mml-mode-map}" | |
991 (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
|
992 (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
|
993 (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
|
994 (> (prefix-numeric-value arg) 0))) |
70245
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
995 (add-minor-mode 'mml-mode " MML" 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
|
996 (easy-menu-add mml-menu mml-mode-map) |
70245
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
997 (when (boundp 'dnd-protocol-alist) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
998 (set (make-local-variable 'dnd-protocol-alist) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
999 (append mml-dnd-protocol-alist dnd-protocol-alist))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1000 (run-hooks 'mml-mode-hook))) |
31717 | 1001 |
1002 ;;; | |
1003 ;;; Helper functions for reading MIME stuff from the minibuffer and | |
1004 ;;; inserting stuff to the buffer. | |
1005 ;;; | |
1006 | |
1007 (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
|
1008 (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
|
1009 (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
|
1010 ;; Prevent some common errors. This is inspired by similar code in |
31717 | 1011 ;; VM. |
1012 (when (file-directory-p file) | |
1013 (error "%s is a directory, cannot attach" file)) | |
1014 (unless (file-exists-p file) | |
1015 (error "No such file: %s" file)) | |
1016 (unless (file-readable-p file) | |
1017 (error "Permission denied: %s" file)) | |
1018 file)) | |
1019 | |
1020 (defun mml-minibuffer-read-type (name &optional default) | |
1021 (mailcap-parse-mimetypes) | |
1022 (let* ((default (or default | |
1023 (mm-default-file-encoding name) | |
1024 ;; Perhaps here we should check what the file | |
1025 ;; looks like, and offer text/plain if it looks | |
1026 ;; like text/plain. | |
1027 "application/octet-stream")) | |
1028 (string (completing-read | |
1029 (format "Content type (default %s): " default) | |
33124 | 1030 (mapcar 'list (mailcap-mime-types))))) |
31717 | 1031 (if (not (equal string "")) |
1032 string | |
1033 default))) | |
1034 | |
1035 (defun mml-minibuffer-read-description () | |
1036 (let ((description (read-string "One line description: "))) | |
1037 (when (string-match "\\`[ \t]*\\'" description) | |
1038 (setq description nil)) | |
1039 description)) | |
1040 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1041 (defun mml-minibuffer-read-disposition (type &optional default) |
64582
3196fbe99547
(mml-minibuffer-read-disposition): Don't use inline by default
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64085
diff
changeset
|
1042 (unless default (setq default |
3196fbe99547
(mml-minibuffer-read-disposition): Don't use inline by default
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64085
diff
changeset
|
1043 (if (and (string-match "\\`text/" type) |
3196fbe99547
(mml-minibuffer-read-disposition): Don't use inline by default
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64085
diff
changeset
|
1044 (not (string-match "\\`text/rtf\\'" type))) |
3196fbe99547
(mml-minibuffer-read-disposition): Don't use inline by default
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64085
diff
changeset
|
1045 "inline" |
3196fbe99547
(mml-minibuffer-read-disposition): Don't use inline by default
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64085
diff
changeset
|
1046 "attachment"))) |
3196fbe99547
(mml-minibuffer-read-disposition): Don't use inline by default
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64085
diff
changeset
|
1047 (let ((disposition (completing-read |
3196fbe99547
(mml-minibuffer-read-disposition): Don't use inline by default
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64085
diff
changeset
|
1048 (format "Disposition (default %s): " default) |
3196fbe99547
(mml-minibuffer-read-disposition): Don't use inline by default
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64085
diff
changeset
|
1049 '(("attachment") ("inline") ("")) |
3196fbe99547
(mml-minibuffer-read-disposition): Don't use inline by default
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
64085
diff
changeset
|
1050 nil t nil nil default))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1051 (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
|
1052 disposition |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1053 default))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1054 |
31717 | 1055 (defun mml-quote-region (beg end) |
1056 "Quote the MML tags in the region." | |
1057 (interactive "r") | |
1058 (save-excursion | |
1059 (save-restriction | |
1060 ;; Temporarily narrow the region to defend from changes | |
1061 ;; invalidating END. | |
1062 (narrow-to-region beg end) | |
1063 (goto-char (point-min)) | |
1064 ;; Quote parts. | |
1065 (while (re-search-forward | |
1066 "<#!*/?\\(multipart\\|part\\|external\\|mml\\)" nil t) | |
1067 ;; Insert ! after the #. | |
1068 (goto-char (+ (match-beginning 0) 2)) | |
1069 (insert "!"))))) | |
1070 | |
1071 (defun mml-insert-tag (name &rest plist) | |
1072 "Insert an MML tag described by NAME and PLIST." | |
1073 (when (symbolp name) | |
1074 (setq name (symbol-name name))) | |
1075 (insert "<#" name) | |
1076 (while plist | |
1077 (let ((key (pop plist)) | |
1078 (value (pop plist))) | |
1079 (when value | |
1080 ;; Quote VALUE if it contains suspicious characters. | |
1081 (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
|
1082 (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
|
1083 (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
|
1084 (prin1 value))))) |
31717 | 1085 (insert (format " %s=%s" key value))))) |
1086 (insert ">\n")) | |
1087 | |
1088 (defun mml-insert-empty-tag (name &rest plist) | |
1089 "Insert an empty MML tag described by NAME and PLIST." | |
1090 (when (symbolp name) | |
1091 (setq name (symbol-name name))) | |
1092 (apply #'mml-insert-tag name plist) | |
1093 (insert "<#/" name ">\n")) | |
1094 | |
1095 ;;; Attachment functions. | |
1096 | |
70245
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1097 (defcustom mml-dnd-protocol-alist |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1098 '(("^file:///" . mml-dnd-attach-file) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1099 ("^file://" . dnd-open-file) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1100 ("^file:" . mml-dnd-attach-file)) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1101 "The functions to call when a drop in `mml-mode' is made. |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1102 See `dnd-protocol-alist' for more information. When nil, behave |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1103 as in other buffers." |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1104 :type '(choice (repeat (cons (regexp) (function))) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1105 (const :tag "Behave as in other buffers" nil)) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1106 :version "22.1" ;; Gnus 5.10.9 |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1107 :group 'message) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1108 |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1109 (defcustom mml-dnd-attach-options nil |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1110 "Which options should be queried when attaching a file via drag and drop. |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1111 |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1112 If it is a list, valid members are `type', `description' and |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1113 `disposition'. `disposition' implies `type'. If it is nil, |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1114 don't ask for options. If it is t, ask the user whether or not |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1115 to specify options." |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1116 :type '(choice |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1117 (const :tag "Non" nil) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1118 (const :tag "Query" t) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1119 (list :value (type description disposition) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1120 (set :inline t |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1121 (const type) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1122 (const description) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1123 (const disposition)))) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1124 :version "22.1" ;; Gnus 5.10.9 |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1125 :group 'message) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1126 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1127 (defun mml-attach-file (file &optional type description disposition) |
31717 | 1128 "Attach a file to the outgoing MIME message. |
1129 The file is not inserted or encoded until you send the message with | |
1130 `\\[message-send-and-exit]' or `\\[message-send]'. | |
1131 | |
68380
e1843613ecb8
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-14
Miles Bader <miles@gnu.org>
parents:
66808
diff
changeset
|
1132 FILE is the name of the file to attach. TYPE is its |
e1843613ecb8
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-14
Miles Bader <miles@gnu.org>
parents:
66808
diff
changeset
|
1133 content-type, a string of the form \"type/subtype\". DESCRIPTION |
e1843613ecb8
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-14
Miles Bader <miles@gnu.org>
parents:
66808
diff
changeset
|
1134 is a one-line description of the attachment. The DISPOSITION |
e1843613ecb8
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-14
Miles Bader <miles@gnu.org>
parents:
66808
diff
changeset
|
1135 specifies how the attachment is intended to be displayed. It can |
e1843613ecb8
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-14
Miles Bader <miles@gnu.org>
parents:
66808
diff
changeset
|
1136 be either \"inline\" (displayed automatically within the message |
e1843613ecb8
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-14
Miles Bader <miles@gnu.org>
parents:
66808
diff
changeset
|
1137 body) or \"attachment\" (separate from the body)." |
31717 | 1138 (interactive |
1139 (let* ((file (mml-minibuffer-read-file "Attach file: ")) | |
1140 (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
|
1141 (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
|
1142 (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
|
1143 (list file type description disposition))) |
70245
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1144 (save-excursion |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1145 (unless (message-in-body-p) (goto-char (point-max))) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1146 (mml-insert-empty-tag 'part |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1147 'type type |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1148 'filename file |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1149 'disposition (or disposition "attachment") |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1150 'description description))) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1151 |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1152 (defun mml-dnd-attach-file (uri action) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1153 "Attach a drag and drop file. |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1154 |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1155 Ask for type, description or disposition according to |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1156 `mml-dnd-attach-options'." |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1157 (let ((file (dnd-get-local-file-name uri t))) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1158 (when (and file (file-regular-p file)) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1159 (let ((mml-dnd-attach-options mml-dnd-attach-options) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1160 type description disposition) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1161 (setq mml-dnd-attach-options |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1162 (when (and (eq mml-dnd-attach-options t) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1163 (not |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1164 (y-or-n-p |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1165 "Use default type, disposition and description? "))) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1166 '(type description disposition))) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1167 (when (or (memq 'type mml-dnd-attach-options) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1168 (memq 'disposition mml-dnd-attach-options)) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1169 (setq type (mml-minibuffer-read-type file))) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1170 (when (memq 'description mml-dnd-attach-options) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1171 (setq description (mml-minibuffer-read-description))) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1172 (when (memq 'disposition mml-dnd-attach-options) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1173 (setq disposition (mml-minibuffer-read-disposition type))) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1174 (mml-attach-file file type description disposition))))) |
31717 | 1175 |
1176 (defun mml-attach-buffer (buffer &optional type description) | |
1177 "Attach a buffer to the outgoing MIME message. | |
1178 See `mml-attach-file' for details of operation." | |
1179 (interactive | |
1180 (let* ((buffer (read-buffer "Attach buffer: ")) | |
1181 (type (mml-minibuffer-read-type buffer "text/plain")) | |
1182 (description (mml-minibuffer-read-description))) | |
1183 (list buffer type description))) | |
70245
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1184 (save-excursion |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1185 (unless (message-in-body-p) (goto-char (point-max))) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1186 (mml-insert-empty-tag 'part 'type type 'buffer buffer |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1187 'disposition "attachment" |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1188 'description description))) |
31717 | 1189 |
1190 (defun mml-attach-external (file &optional type description) | |
1191 "Attach an external file into the buffer. | |
1192 FILE is an ange-ftp/efs specification of the part location. | |
1193 TYPE is the MIME type to use." | |
1194 (interactive | |
1195 (let* ((file (mml-minibuffer-read-file "Attach external file: ")) | |
1196 (type (mml-minibuffer-read-type file)) | |
1197 (description (mml-minibuffer-read-description))) | |
1198 (list file type description))) | |
70245
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1199 (save-excursion |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1200 (unless (message-in-body-p) (goto-char (point-max))) |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1201 (mml-insert-empty-tag 'external 'type type 'name file |
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
1202 'disposition "attachment" 'description description))) |
31717 | 1203 |
1204 (defun mml-insert-multipart (&optional type) | |
1205 (interactive (list (completing-read "Multipart type (default mixed): " | |
1206 '(("mixed") ("alternative") ("digest") ("parallel") | |
1207 ("signed") ("encrypted")) | |
1208 nil nil "mixed"))) | |
1209 (or type | |
1210 (setq type "mixed")) | |
1211 (mml-insert-empty-tag "multipart" 'type type) | |
1212 (forward-line -1)) | |
1213 | |
1214 (defun mml-insert-part (&optional type) | |
1215 (interactive | |
1216 (list (mml-minibuffer-read-type ""))) | |
1217 (mml-insert-tag 'part 'type type 'disposition "inline") | |
1218 (forward-line -1)) | |
1219 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1220 (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
|
1221 "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
|
1222 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
|
1223 (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
|
1224 (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
|
1225 (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
|
1226 (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
|
1227 (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
|
1228 (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
|
1229 |
31717 | 1230 (defun mml-preview (&optional raw) |
1231 "Display current buffer with Gnus, in a new buffer. | |
66808
a93385a3e7a2
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-646
Miles Bader <miles@gnu.org>
parents:
65280
diff
changeset
|
1232 If RAW, display a raw encoded MIME message." |
31717 | 1233 (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
|
1234 (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1235 (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
|
1236 (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
|
1237 (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
|
1238 (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
|
1239 (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
|
1240 (save-restriction |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1241 (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
|
1242 (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
|
1243 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
|
1244 (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
|
1245 (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
|
1246 (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
|
1247 "*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
|
1248 (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
|
1249 (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
|
1250 (erase-buffer) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1251 (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
|
1252 (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
|
1253 (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
|
1254 nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1255 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
|
1256 (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
|
1257 (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
|
1258 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
|
1259 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
|
1260 (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
|
1261 (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
|
1262 (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
|
1263 (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
|
1264 (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
|
1265 (if raw |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1266 (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
|
1267 (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
|
1268 ;; 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
|
1269 (erase-buffer) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1270 (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
|
1271 (insert s))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1272 (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
|
1273 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
|
1274 (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
|
1275 (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
|
1276 (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
|
1277 (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
|
1278 (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
|
1279 ;; 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
|
1280 (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
|
1281 (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
|
1282 (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
|
1283 (lambda () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1284 (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
|
1285 (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
|
1286 (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
|
1287 (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
|
1288 (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
|
1289 (lambda () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1290 (interactive) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1291 (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
|
1292 (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
|
1293 (lambda (event) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1294 (interactive "@e") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1295 (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
|
1296 (goto-char (point-min))))) |
31717 | 1297 |
1298 (defun mml-validate () | |
1299 "Validate the current MML document." | |
1300 (interactive) | |
1301 (mml-parse)) | |
1302 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1303 (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
|
1304 "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
|
1305 (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
|
1306 func) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1307 (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1308 (tweak |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1309 (setq func |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1310 (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
|
1311 (intern tweak)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1312 (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
|
1313 (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
|
1314 (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
|
1315 (while alist |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1316 (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
|
1317 (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
|
1318 alist nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1319 (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
|
1320 (if func |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1321 (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
|
1322 cont) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1323 (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
|
1324 (while alist |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1325 (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
|
1326 (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
|
1327 (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
|
1328 cont) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1329 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1330 (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
|
1331 "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
|
1332 (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
|
1333 (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
|
1334 (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
|
1335 (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
|
1336 (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
|
1337 (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
|
1338 (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
|
1339 |
31717 | 1340 (provide 'mml) |
1341 | |
52401 | 1342 ;;; arch-tag: 583c96cf-1ffe-451b-a5e5-4733ae9ddd12 |
31717 | 1343 ;;; mml.el ends here |