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