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