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