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