Mercurial > emacs
annotate lisp/gnus/mm-decode.el @ 95212:a6a4ada91449
* dispextern.h, xfaces.c (xstrcasecmp): Renamed from xstricmp.
* dosfns.c, fileio.c, font.c, fontset.c, image.c, macfns.c:
* macterm.c, process.c, w32.c, w32fns.c, w32proc.c, xfaces.c:
* xfns.c, xfont.c: Callers changed.
author | Jason Rumney <jasonr@gnu.org> |
---|---|
date | Thu, 22 May 2008 14:52:37 +0000 |
parents | f42ef85caf91 |
children | 64da3838a9aa |
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 ;;; mm-decode.el --- Functions for decoding MIME things |
64754
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64693
diff
changeset
|
2 |
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64693
diff
changeset
|
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
79708 | 4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
31717 | 5 |
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | |
7 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> | |
8 ;; This file is part of GNU Emacs. | |
9 | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94209
diff
changeset
|
10 ;; GNU Emacs is free software: you can redistribute it and/or modify |
31717 | 11 ;; 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:
94209
diff
changeset
|
12 ;; 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:
94209
diff
changeset
|
13 ;; (at your option) any later version. |
31717 | 14 |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; 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:
94209
diff
changeset
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
31717 | 18 ;; GNU General Public License for more details. |
19 | |
20 ;; 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:
94209
diff
changeset
|
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
31717 | 22 |
23 ;;; Commentary: | |
24 | |
25 ;;; Code: | |
26 | |
87243
23ea76295829
Add declare-function compatibility definition.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
27 ;; For Emacs < 22.2. |
23ea76295829
Add declare-function compatibility definition.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
28 (eval-and-compile |
23ea76295829
Add declare-function compatibility definition.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
29 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) |
23ea76295829
Add declare-function compatibility definition.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
30 |
31717 | 31 (require 'mail-parse) |
32 (require 'mailcap) | |
33 (require 'mm-bodies) | |
87243
23ea76295829
Add declare-function compatibility definition.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
34 (require 'gnus-util) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
35 (eval-when-compile (require 'cl) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
36 (require 'term)) |
31717 | 37 |
38 (eval-and-compile | |
33296 | 39 (autoload 'mm-inline-partial "mm-partial") |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
40 (autoload 'mm-inline-external-body "mm-extern") |
69572
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
41 (autoload 'mm-extern-cache-contents "mm-extern") |
33296 | 42 (autoload 'mm-insert-inline "mm-view")) |
31717 | 43 |
65275
285f667dc098
(gnus-current-window-configuration): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents:
64754
diff
changeset
|
44 (defvar gnus-current-window-configuration) |
285f667dc098
(gnus-current-window-configuration): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents:
64754
diff
changeset
|
45 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
46 (add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
47 |
31717 | 48 (defgroup mime-display () |
49 "Display of MIME in mail and news articles." | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
50 :link '(custom-manual "(emacs-mime)Display Customization") |
31717 | 51 :version "21.1" |
52 :group 'mail | |
53 :group 'news | |
54 :group 'multimedia) | |
55 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
56 (defgroup mime-security () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
57 "MIME security in mail and news articles." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
58 :link '(custom-manual "(emacs-mime)Display Customization") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
59 :group 'mail |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
60 :group 'news |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
61 :group 'multimedia) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
62 |
31717 | 63 ;;; Convenience macros. |
64 | |
65 (defmacro mm-handle-buffer (handle) | |
66 `(nth 0 ,handle)) | |
67 (defmacro mm-handle-type (handle) | |
68 `(nth 1 ,handle)) | |
69 (defsubst mm-handle-media-type (handle) | |
70 (if (stringp (car handle)) | |
71 (car handle) | |
72 (car (mm-handle-type handle)))) | |
73 (defsubst mm-handle-media-supertype (handle) | |
74 (car (split-string (mm-handle-media-type handle) "/"))) | |
75 (defsubst mm-handle-media-subtype (handle) | |
76 (cadr (split-string (mm-handle-media-type handle) "/"))) | |
77 (defmacro mm-handle-encoding (handle) | |
78 `(nth 2 ,handle)) | |
79 (defmacro mm-handle-undisplayer (handle) | |
80 `(nth 3 ,handle)) | |
81 (defmacro mm-handle-set-undisplayer (handle function) | |
82 `(setcar (nthcdr 3 ,handle) ,function)) | |
83 (defmacro mm-handle-disposition (handle) | |
84 `(nth 4 ,handle)) | |
85 (defmacro mm-handle-description (handle) | |
86 `(nth 5 ,handle)) | |
87 (defmacro mm-handle-cache (handle) | |
88 `(nth 6 ,handle)) | |
89 (defmacro mm-handle-set-cache (handle contents) | |
90 `(setcar (nthcdr 6 ,handle) ,contents)) | |
91 (defmacro mm-handle-id (handle) | |
92 `(nth 7 ,handle)) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
93 (defmacro mm-handle-multipart-original-buffer (handle) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
94 `(get-text-property 0 'buffer (car ,handle))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
95 (defmacro mm-handle-multipart-from (handle) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
96 `(get-text-property 0 'from (car ,handle))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
97 (defmacro mm-handle-multipart-ctl-parameter (handle parameter) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
98 `(get-text-property 0 ,parameter (car ,handle))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
99 |
31717 | 100 (defmacro mm-make-handle (&optional buffer type encoding undisplayer |
101 disposition description cache | |
102 id) | |
103 `(list ,buffer ,type ,encoding ,undisplayer | |
104 ,disposition ,description ,cache ,id)) | |
105 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
106 (defcustom mm-text-html-renderer |
92694 | 107 (cond ((executable-find "w3m") |
108 (if (locate-library "w3m") | |
109 'w3m | |
110 'w3m-standalone)) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
111 ((executable-find "links") 'links) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
112 ((executable-find "lynx") 'lynx) |
92694 | 113 ((locate-library "w3") 'w3) |
114 ((locate-library "html2text") 'html2text) | |
115 (t nil)) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
116 "Render of HTML contents. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
117 It is one of defined renderer types, or a rendering function. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
118 The defined renderer types are: |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
119 `w3m' : use emacs-w3m; |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
120 `w3m-standalone': use w3m; |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
121 `links': use links; |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
122 `lynx' : use lynx; |
92694 | 123 `w3' : use Emacs/W3; |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
124 `html2text' : use html2text; |
92694 | 125 nil : use external viewer (default web browser)." |
126 :version "23.0" ;; No Gnus | |
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 '(choice (const w3) |
92694 | 128 (const w3m :tag "emacs-w3m") |
129 (const w3m-standalone :tag "standalone w3m" ) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
130 (const links) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
131 (const lynx) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
132 (const html2text) |
92694 | 133 (const nil :tag "External viewer") |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
134 (function)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
135 :group 'mime-display) |
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 mm-inline-text-html-renderer nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
138 "Function used for rendering inline HTML contents. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
139 It is suggested to customize `mm-text-html-renderer' instead.") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
140 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
141 (defcustom mm-inline-text-html-with-images nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
142 "If non-nil, Gnus will allow retrieving images in HTML contents with |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
143 the <img> tags. It has no effect on Emacs/w3. See also the |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
144 documentation for the `mm-w3m-safe-url-regexp' variable." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
59690
diff
changeset
|
145 :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
|
146 :type 'boolean |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
147 :group 'mime-display) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
148 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
149 (defcustom mm-w3m-safe-url-regexp "\\`cid:" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
150 "Regexp matching URLs which are considered to be safe. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
151 Some HTML mails might contain a nasty trick used by spammers, using |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
152 the <img> tag which is far more evil than the [Click Here!] button. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
153 It is most likely intended to check whether the ominous spam mail has |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
154 reached your eyes or not, in which case the spammer knows for sure |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
155 that your email address is valid. It is done by embedding an |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
156 identifier string into a URL that you might automatically retrieve |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
157 when displaying the image. The default value is \"\\\\`cid:\" which only |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
158 matches parts embedded to the Multipart/Related type MIME contents and |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
159 Gnus will never connect to the spammer's site arbitrarily. You may |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
160 set this variable to nil if you consider all urls to be safe." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
59690
diff
changeset
|
161 :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
|
162 :type '(choice (regexp :tag "Regexp") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
163 (const :tag "All URLs are safe" nil)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
164 :group 'mime-display) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
165 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
166 (defcustom mm-inline-text-html-with-w3m-keymap t |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
167 "If non-nil, use emacs-w3m command keys in the article buffer." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
59690
diff
changeset
|
168 :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
|
169 :type 'boolean |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
170 :group 'mime-display) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
171 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
172 (defcustom mm-enable-external t |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
173 "Indicate whether external MIME handlers should be used. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
174 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
175 If t, all defined external MIME handlers are used. If nil, files are saved by |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
176 `mailcap-save-binary-file'. If it is the symbol `ask', you are prompted |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
177 before the external MIME handler is invoked." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
59690
diff
changeset
|
178 :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
|
179 :type '(choice (const :tag "Always" t) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
180 (const :tag "Never" nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
181 (const :tag "Ask" ask)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
182 :group 'mime-display) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
183 |
31717 | 184 (defcustom mm-inline-media-tests |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
185 '(("image/p?jpeg" |
31717 | 186 mm-inline-image |
187 (lambda (handle) | |
188 (mm-valid-and-fit-image-p 'jpeg handle))) | |
189 ("image/png" | |
190 mm-inline-image | |
191 (lambda (handle) | |
192 (mm-valid-and-fit-image-p 'png handle))) | |
193 ("image/gif" | |
194 mm-inline-image | |
195 (lambda (handle) | |
196 (mm-valid-and-fit-image-p 'gif handle))) | |
197 ("image/tiff" | |
198 mm-inline-image | |
199 (lambda (handle) | |
200 (mm-valid-and-fit-image-p 'tiff handle)) ) | |
201 ("image/xbm" | |
202 mm-inline-image | |
203 (lambda (handle) | |
204 (mm-valid-and-fit-image-p 'xbm handle))) | |
205 ("image/x-xbitmap" | |
206 mm-inline-image | |
207 (lambda (handle) | |
208 (mm-valid-and-fit-image-p 'xbm handle))) | |
209 ("image/xpm" | |
210 mm-inline-image | |
211 (lambda (handle) | |
212 (mm-valid-and-fit-image-p 'xpm handle))) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
213 ("image/x-xpixmap" |
31717 | 214 mm-inline-image |
215 (lambda (handle) | |
216 (mm-valid-and-fit-image-p 'xpm handle))) | |
217 ("image/bmp" | |
218 mm-inline-image | |
219 (lambda (handle) | |
220 (mm-valid-and-fit-image-p 'bmp handle))) | |
35048 | 221 ("image/x-portable-bitmap" |
222 mm-inline-image | |
223 (lambda (handle) | |
224 (mm-valid-and-fit-image-p 'pbm handle))) | |
31717 | 225 ("text/plain" mm-inline-text identity) |
226 ("text/enriched" mm-inline-text identity) | |
227 ("text/richtext" mm-inline-text identity) | |
228 ("text/x-patch" mm-display-patch-inline | |
229 (lambda (handle) | |
65767
1b9137e0ecc1
(mm-inline-media-tests): Check presence of the diff-mode
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65719
diff
changeset
|
230 ;; If the diff-mode.el package is installed, the function is |
1b9137e0ecc1
(mm-inline-media-tests): Check presence of the diff-mode
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65719
diff
changeset
|
231 ;; autoloaded. Checking (locate-library "diff-mode") would be trying |
1b9137e0ecc1
(mm-inline-media-tests): Check presence of the diff-mode
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65719
diff
changeset
|
232 ;; to cater to broken installations. OTOH checking the function |
1b9137e0ecc1
(mm-inline-media-tests): Check presence of the diff-mode
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65719
diff
changeset
|
233 ;; makes it possible to install another package which provides an |
1b9137e0ecc1
(mm-inline-media-tests): Check presence of the diff-mode
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65719
diff
changeset
|
234 ;; alternative implementation of diff-mode. --Stef |
1b9137e0ecc1
(mm-inline-media-tests): Check presence of the diff-mode
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65719
diff
changeset
|
235 (fboundp 'diff-mode))) |
93723
2da1f95ea11c
(mm-inline-media-tests): Add entry for x-diff.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93107
diff
changeset
|
236 ;; In case mime.types uses x-diff (as does Debian's mime-support-3.40). |
2da1f95ea11c
(mm-inline-media-tests): Add entry for x-diff.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93107
diff
changeset
|
237 ("text/x-diff" mm-display-patch-inline |
2da1f95ea11c
(mm-inline-media-tests): Add entry for x-diff.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93107
diff
changeset
|
238 (lambda (handle) (fboundp 'diff-mode))) |
31764 | 239 ("application/emacs-lisp" mm-display-elisp-inline identity) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
240 ("application/x-emacs-lisp" mm-display-elisp-inline identity) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
241 ("text/dns" mm-display-dns-inline identity) |
31717 | 242 ("text/html" |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
243 mm-inline-text-html |
31717 | 244 (lambda (handle) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
245 (or mm-inline-text-html-renderer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
246 mm-text-html-renderer))) |
31717 | 247 ("text/x-vcard" |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
248 mm-inline-text-vcard |
31717 | 249 (lambda (handle) |
250 (or (featurep 'vcard) | |
251 (locate-library "vcard")))) | |
252 ("message/delivery-status" mm-inline-text identity) | |
253 ("message/rfc822" mm-inline-message identity) | |
254 ("message/partial" mm-inline-partial identity) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
255 ("message/external-body" mm-inline-external-body identity) |
31717 | 256 ("text/.*" mm-inline-text identity) |
257 ("audio/wav" mm-inline-audio | |
258 (lambda (handle) | |
259 (and (or (featurep 'nas-sound) (featurep 'native-sound)) | |
260 (device-sound-enabled-p)))) | |
261 ("audio/au" | |
262 mm-inline-audio | |
263 (lambda (handle) | |
264 (and (or (featurep 'nas-sound) (featurep 'native-sound)) | |
265 (device-sound-enabled-p)))) | |
266 ("application/pgp-signature" ignore identity) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
267 ("application/x-pkcs7-signature" ignore identity) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
268 ("application/pkcs7-signature" ignore identity) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
269 ("application/x-pkcs7-mime" ignore identity) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
270 ("application/pkcs7-mime" ignore identity) |
31717 | 271 ("multipart/alternative" ignore identity) |
272 ("multipart/mixed" ignore identity) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
273 ("multipart/related" ignore identity) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
274 ;; Disable audio and image |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
275 ("audio/.*" ignore ignore) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
276 ("image/.*" ignore ignore) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
277 ;; Default to displaying as text |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
278 (".*" mm-inline-text mm-readable-p)) |
31717 | 279 "Alist of media types/tests saying whether types can be displayed inline." |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
280 :type '(repeat (list (regexp :tag "MIME type") |
31717 | 281 (function :tag "Display function") |
282 (function :tag "Display test"))) | |
283 :group 'mime-display) | |
284 | |
285 (defcustom mm-inlined-types | |
286 '("image/.*" "text/.*" "message/delivery-status" "message/rfc822" | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
287 "message/partial" "message/external-body" "application/emacs-lisp" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
288 "application/x-emacs-lisp" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
289 "application/pgp-signature" "application/x-pkcs7-signature" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
290 "application/pkcs7-signature" "application/x-pkcs7-mime" |
68287
dbc43cabc13b
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-5
Miles Bader <miles@gnu.org>
parents:
67643
diff
changeset
|
291 "application/pkcs7-mime" |
dbc43cabc13b
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-5
Miles Bader <miles@gnu.org>
parents:
67643
diff
changeset
|
292 ;; Mutt still uses this even though it has already been withdrawn. |
dbc43cabc13b
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-5
Miles Bader <miles@gnu.org>
parents:
67643
diff
changeset
|
293 "application/pgp") |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
294 "List of media types that are to be displayed inline. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
295 See also `mm-inline-media-tests', which says how to display a media |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
296 type inline." |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
67418
diff
changeset
|
297 :type '(repeat regexp) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
298 :group 'mime-display) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
299 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
300 (defcustom mm-keep-viewer-alive-types |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
301 '("application/postscript" "application/msword" "application/vnd.ms-excel" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
302 "application/pdf" "application/x-dvi") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
303 "List of media types for which the external viewer will not be killed |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
304 when selecting a different article." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
59690
diff
changeset
|
305 :version "22.1" |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
67418
diff
changeset
|
306 :type '(repeat regexp) |
31717 | 307 :group 'mime-display) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44075
diff
changeset
|
308 |
31717 | 309 (defcustom mm-automatic-display |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
310 '("text/plain" "text/enriched" "text/richtext" "text/html" "text/x-verbatim" |
31717 | 311 "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*" |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
312 "message/rfc822" "text/x-patch" "text/dns" "application/pgp-signature" |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
313 "application/emacs-lisp" "application/x-emacs-lisp" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
314 "application/x-pkcs7-signature" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
315 "application/pkcs7-signature" "application/x-pkcs7-mime" |
68287
dbc43cabc13b
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-5
Miles Bader <miles@gnu.org>
parents:
67643
diff
changeset
|
316 "application/pkcs7-mime" |
dbc43cabc13b
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-5
Miles Bader <miles@gnu.org>
parents:
67643
diff
changeset
|
317 ;; Mutt still uses this even though it has already been withdrawn. |
70245
322c5c5027dc
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-249
Miles Bader <miles@gnu.org>
parents:
69949
diff
changeset
|
318 "application/pgp\\'") |
31717 | 319 "A list of MIME types to be displayed automatically." |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
67418
diff
changeset
|
320 :type '(repeat regexp) |
31717 | 321 :group 'mime-display) |
322 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
323 (defcustom mm-attachment-override-types '("text/x-vcard" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
324 "application/pkcs7-mime" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
325 "application/x-pkcs7-mime" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
326 "application/pkcs7-signature" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
327 "application/x-pkcs7-signature") |
31717 | 328 "Types to have \"attachment\" ignored if they can be displayed inline." |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
67418
diff
changeset
|
329 :type '(repeat regexp) |
31717 | 330 :group 'mime-display) |
331 | |
332 (defcustom mm-inline-override-types nil | |
333 "Types to be treated as attachments even if they can be displayed inline." | |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
67418
diff
changeset
|
334 :type '(repeat regexp) |
31717 | 335 :group 'mime-display) |
336 | |
337 (defcustom mm-automatic-external-display nil | |
338 "List of MIME type regexps that will be displayed externally automatically." | |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
67418
diff
changeset
|
339 :type '(repeat regexp) |
31717 | 340 :group 'mime-display) |
341 | |
342 (defcustom mm-discouraged-alternatives nil | |
343 "List of MIME types that are discouraged when viewing multipart/alternative. | |
344 Viewing agents are supposed to view the last possible part of a message, | |
345 as that is supposed to be the richest. However, users may prefer other | |
346 types instead, and this list says what types are most unwanted. If, | |
347 for instance, text/html parts are very unwanted, and text/richtext are | |
348 somewhat unwanted, then the value of this variable should be set | |
349 to: | |
350 | |
67418
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
351 (\"text/html\" \"text/richtext\") |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
352 |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
353 Adding \"image/.*\" might also be useful. Spammers use it as the |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
67418
diff
changeset
|
354 prefered part of multipart/alternative messages. See also |
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
67418
diff
changeset
|
355 `gnus-buttonized-mime-types', to which adding \"multipart/alternative\" |
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
67418
diff
changeset
|
356 enables you to choose manually one of two types those mails include." |
67418
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
357 :type '(repeat regexp) ;; See `mm-preferred-alternative-precedence'. |
31717 | 358 :group 'mime-display) |
359 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
360 (defcustom mm-tmp-directory |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
361 (if (fboundp 'temp-directory) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
362 (temp-directory) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
363 (if (boundp 'temporary-file-directory) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
364 temporary-file-directory |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
365 "/tmp/")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
366 "Where mm will store its temporary files." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
367 :type 'directory |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
368 :group 'mime-display) |
31717 | 369 |
370 (defcustom mm-inline-large-images nil | |
371 "If non-nil, then all images fit in the buffer." | |
372 :type 'boolean | |
373 :group 'mime-display) | |
374 | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
375 (defcustom mm-file-name-rewrite-functions |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
376 '(mm-file-name-delete-control mm-file-name-delete-gotchas) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
377 "List of functions used for rewriting file names of MIME parts. |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
378 Each function takes a file name as input and returns a file name. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
379 |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
380 Ready-made functions include `mm-file-name-delete-control', |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
381 `mm-file-name-delete-gotchas' (you should not remove these two |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
382 functions), `mm-file-name-delete-whitespace', |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
383 `mm-file-name-trim-whitespace', `mm-file-name-collapse-whitespace', |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
384 `mm-file-name-replace-whitespace', `capitalize', `downcase', |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
385 `upcase', and `upcase-initials'." |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
386 :type '(list (set :inline t |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
387 (const mm-file-name-delete-control) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
388 (const mm-file-name-delete-gotchas) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
389 (const mm-file-name-delete-whitespace) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
390 (const mm-file-name-trim-whitespace) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
391 (const mm-file-name-collapse-whitespace) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
392 (const mm-file-name-replace-whitespace) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
393 (const capitalize) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
394 (const downcase) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
395 (const upcase) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
396 (const upcase-initials) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
397 (repeat :inline t |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
398 :tag "Function" |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
399 function))) |
92336
5f827896103e
Change defcustom :version from 23.0 to 23.1.
Glenn Morris <rgm@gnu.org>
parents:
87928
diff
changeset
|
400 :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:
78224
diff
changeset
|
401 :group 'mime-display) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
402 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
403 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
404 (defvar mm-path-name-rewrite-functions nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
405 "*List of functions for rewriting the full file names of MIME parts. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
406 This is used when viewing parts externally, and is meant for |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
407 transforming the absolute name so that non-compliant programs can find |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
408 the file where it's saved. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
409 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
410 Each function takes a file name as input and returns a file name.") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
411 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
412 (defvar mm-file-name-replace-whitespace nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
413 "String used for replacing whitespace characters; default is `\"_\"'.") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
414 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
415 (defcustom mm-default-directory nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
416 "The default directory where mm will save files. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
417 If not set, `default-directory' will be used." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
418 :type '(choice directory (const :tag "Default" nil)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
419 :group 'mime-display) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
420 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
421 (defcustom mm-attachment-file-modes 384 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
422 "Set the mode bits of saved attachments to this integer." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
59690
diff
changeset
|
423 :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
|
424 :type 'integer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
425 :group 'mime-display) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
426 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
427 (defcustom mm-external-terminal-program "xterm" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
428 "The program to start an external terminal." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
59690
diff
changeset
|
429 :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
|
430 :type 'string |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
431 :group 'mime-display) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
432 |
31717 | 433 ;;; Internal variables. |
434 | |
435 (defvar mm-last-shell-command "") | |
436 (defvar mm-content-id-alist nil) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
437 (defvar mm-postponed-undisplay-list nil) |
31717 | 438 |
439 ;; According to RFC2046, in particular, in a digest, the default | |
440 ;; Content-Type value for a body part is changed from "text/plain" to | |
441 ;; "message/rfc822". | |
442 (defvar mm-dissect-default-type "text/plain") | |
443 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
444 (autoload 'mml2015-verify "mml2015") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
445 (autoload 'mml2015-verify-test "mml2015") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
446 (autoload 'mml-smime-verify "mml-smime") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
447 (autoload 'mml-smime-verify-test "mml-smime") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
448 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
449 (defvar mm-verify-function-alist |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
450 '(("application/pgp-signature" mml2015-verify "PGP" mml2015-verify-test) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
451 ("application/x-gnus-pgp-signature" mm-uu-pgp-signed-extract-1 "PGP" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
452 mm-uu-pgp-signed-test) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
453 ("application/pkcs7-signature" mml-smime-verify "S/MIME" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
454 mml-smime-verify-test) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
455 ("application/x-pkcs7-signature" mml-smime-verify "S/MIME" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
456 mml-smime-verify-test))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
457 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
458 (defcustom mm-verify-option 'never |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
459 "Option of verifying signed parts. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
460 `never', not verify; `always', always verify; |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
461 `known', only verify known protocols. Otherwise, ask user. |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
462 |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
463 When set to `always' or `known', you should add |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
464 \"multipart/signed\" to `gnus-buttonized-mime-types' to see |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
465 result of the verification." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
59690
diff
changeset
|
466 :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
|
467 :type '(choice (item always) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
468 (item never) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
469 (item :tag "only known protocols" known) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
470 (item :tag "ask" nil)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
471 :group 'mime-security) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
472 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
473 (autoload 'mml2015-decrypt "mml2015") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
474 (autoload 'mml2015-decrypt-test "mml2015") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
475 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
476 (defvar mm-decrypt-function-alist |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
477 '(("application/pgp-encrypted" mml2015-decrypt "PGP" mml2015-decrypt-test) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
478 ("application/x-gnus-pgp-encrypted" mm-uu-pgp-encrypted-extract-1 "PGP" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
479 mm-uu-pgp-encrypted-test))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
480 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
481 (defcustom mm-decrypt-option nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
482 "Option of decrypting encrypted parts. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
483 `never', not decrypt; `always', always decrypt; |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
484 `known', only decrypt known protocols. Otherwise, ask user." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
59690
diff
changeset
|
485 :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
|
486 :type '(choice (item always) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
487 (item never) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
488 (item :tag "only known protocols" known) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
489 (item :tag "ask" nil)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
490 :group 'mime-security) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
491 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
492 (defvar mm-viewer-completion-map |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
493 (let ((map (make-sparse-keymap 'mm-viewer-completion-map))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
494 (set-keymap-parent map minibuffer-local-completion-map) |
65767
1b9137e0ecc1
(mm-inline-media-tests): Check presence of the diff-mode
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65719
diff
changeset
|
495 ;; Should we bind other key to minibuffer-complete-word? |
1b9137e0ecc1
(mm-inline-media-tests): Check presence of the diff-mode
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65719
diff
changeset
|
496 (define-key map " " 'self-insert-command) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
497 map) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
498 "Keymap for input viewer with completion.") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
499 |
32962 | 500 (defvar mm-viewer-completion-map |
501 (let ((map (make-sparse-keymap 'mm-viewer-completion-map))) | |
502 (set-keymap-parent map minibuffer-local-completion-map) | |
65767
1b9137e0ecc1
(mm-inline-media-tests): Check presence of the diff-mode
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65719
diff
changeset
|
503 ;; Should we bind other key to minibuffer-complete-word? |
1b9137e0ecc1
(mm-inline-media-tests): Check presence of the diff-mode
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65719
diff
changeset
|
504 (define-key map " " 'self-insert-command) |
32962 | 505 map) |
506 "Keymap for input viewer with completion.") | |
507 | |
31717 | 508 ;;; The functions. |
509 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
510 (defun mm-alist-to-plist (alist) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
511 "Convert association list ALIST into the equivalent property-list form. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
512 The plist is returned. This converts from |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
513 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
514 \((a . 1) (b . 2) (c . 3)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
515 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
516 into |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
517 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
518 \(a 1 b 2 c 3) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
519 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
520 The original alist is not modified. See also `destructive-alist-to-plist'." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
521 (let (plist) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
522 (while alist |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
523 (let ((el (car alist))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
524 (setq plist (cons (cdr el) (cons (car el) plist)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
525 (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
|
526 (nreverse plist))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
527 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
528 (defun mm-keep-viewer-alive-p (handle) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
529 "Say whether external viewer for HANDLE should stay alive." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
530 (let ((types mm-keep-viewer-alive-types) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
531 (type (mm-handle-media-type handle)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
532 ty) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
533 (catch 'found |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
534 (while (setq ty (pop types)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
535 (when (string-match ty type) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
536 (throw 'found t)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
537 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
538 (defun mm-handle-set-external-undisplayer (handle function) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
539 "Set the undisplayer for HANDLE to FUNCTION. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
540 Postpone undisplaying of viewers for types in |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
541 `mm-keep-viewer-alive-types'." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
542 (if (mm-keep-viewer-alive-p handle) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
543 (let ((new-handle (copy-sequence handle))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
544 (mm-handle-set-undisplayer new-handle function) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
545 (mm-handle-set-undisplayer handle nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
546 (push new-handle mm-postponed-undisplay-list)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
547 (mm-handle-set-undisplayer handle function))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
548 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
549 (defun mm-destroy-postponed-undisplay-list () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
550 (when mm-postponed-undisplay-list |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
551 (message "Destroying external MIME viewers") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
552 (mm-destroy-parts mm-postponed-undisplay-list))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
553 |
60302
f34a552e4a9f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-139
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
554 (defun mm-dissect-buffer (&optional no-strict-mime loose-mime from) |
31717 | 555 "Dissect the current buffer and return a list of MIME handles." |
556 (save-excursion | |
60302
f34a552e4a9f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-139
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
557 (let (ct ctl type subtype cte cd description id result) |
31717 | 558 (save-restriction |
559 (mail-narrow-to-head) | |
560 (when (or no-strict-mime | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
561 loose-mime |
31717 | 562 (mail-fetch-field "mime-version")) |
563 (setq ct (mail-fetch-field "content-type") | |
68720
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68287
diff
changeset
|
564 ctl (and ct (mail-header-parse-content-type ct)) |
31717 | 565 cte (mail-fetch-field "content-transfer-encoding") |
566 cd (mail-fetch-field "content-disposition") | |
567 description (mail-fetch-field "content-description") | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
568 id (mail-fetch-field "content-id")) |
60302
f34a552e4a9f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-139
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
569 (unless from |
68720
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68287
diff
changeset
|
570 (setq from (mail-fetch-field "from"))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
571 ;; FIXME: In some circumstances, this code is running within |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
572 ;; an unibyte macro. mail-extract-address-components |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
573 ;; creates unibyte buffers. This `if', though not a perfect |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
574 ;; solution, avoids most of them. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
575 (if from |
87928 | 576 (setq from (cadr (mail-extract-address-components from)))) |
577 (if description | |
578 (setq description (mail-decode-encoded-word-string | |
579 description))))) | |
31717 | 580 (if (or (not ctl) |
581 (not (string-match "/" (car ctl)))) | |
582 (mm-dissect-singlepart | |
583 (list mm-dissect-default-type) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
584 (and cte (intern (downcase (mail-header-strip cte)))) |
31717 | 585 no-strict-mime |
68720
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68287
diff
changeset
|
586 (and cd (mail-header-parse-content-disposition cd)) |
31717 | 587 description) |
588 (setq type (split-string (car ctl) "/")) | |
589 (setq subtype (cadr type) | |
70377
1b78f3a87f16
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-265
Miles Bader <miles@gnu.org>
parents:
70245
diff
changeset
|
590 type (car type)) |
31717 | 591 (setq |
592 result | |
593 (cond | |
594 ((equal type "multipart") | |
595 (let ((mm-dissect-default-type (if (equal subtype "digest") | |
596 "message/rfc822" | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
597 "text/plain")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
598 (start (cdr (assq 'start (cdr ctl))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
599 (add-text-properties 0 (length (car ctl)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
600 (mm-alist-to-plist (cdr ctl)) (car ctl)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
601 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
602 ;; what really needs to be done here is a way to link a |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
603 ;; MIME handle back to it's parent MIME handle (in a multilevel |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
604 ;; MIME article). That would probably require changing |
65767
1b9137e0ecc1
(mm-inline-media-tests): Check presence of the diff-mode
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65719
diff
changeset
|
605 ;; the mm-handle API so we simply store the multipart buffer |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
606 ;; name as a text property of the "multipart/whatever" string. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
607 (add-text-properties 0 (length (car ctl)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
608 (list 'buffer (mm-copy-to-buffer) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
609 'from from |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
610 'start start) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
611 (car ctl)) |
60302
f34a552e4a9f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-139
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
612 (cons (car ctl) (mm-dissect-multipart ctl from)))) |
31717 | 613 (t |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
614 (mm-possibly-verify-or-decrypt |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
615 (mm-dissect-singlepart |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
616 ctl |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
617 (and cte (intern (downcase (mail-header-strip cte)))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
618 no-strict-mime |
68720
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68287
diff
changeset
|
619 (and cd (mail-header-parse-content-disposition cd)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
620 description id) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
621 ctl)))) |
31717 | 622 (when id |
623 (when (string-match " *<\\(.*\\)> *" id) | |
624 (setq id (match-string 1 id))) | |
625 (push (cons id result) mm-content-id-alist)) | |
626 result)))) | |
627 | |
628 (defun mm-dissect-singlepart (ctl cte &optional force cdl description id) | |
629 (when (or force | |
630 (if (equal "text/plain" (car ctl)) | |
631 (assoc 'format ctl) | |
632 t)) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
633 (mm-make-handle |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
634 (mm-copy-to-buffer) ctl cte nil cdl description nil id))) |
31717 | 635 |
60302
f34a552e4a9f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-139
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
636 (defun mm-dissect-multipart (ctl from) |
31717 | 637 (goto-char (point-min)) |
638 (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary))) | |
639 (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$")) | |
640 start parts | |
641 (end (save-excursion | |
642 (goto-char (point-max)) | |
643 (if (re-search-backward close-delimiter nil t) | |
644 (match-beginning 0) | |
645 (point-max))))) | |
646 (setq boundary (concat (regexp-quote boundary) "[ \t]*$")) | |
34833
aaf69bc74739
* gnus-art.el (gnus-article-check-hidden-text): Return t.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
647 (while (and (< (point) end) (re-search-forward boundary end t)) |
31717 | 648 (goto-char (match-beginning 0)) |
649 (when start | |
650 (save-excursion | |
651 (save-restriction | |
652 (narrow-to-region start (point)) | |
60302
f34a552e4a9f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-139
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
653 (setq parts (nconc (list (mm-dissect-buffer t nil from)) parts))))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
654 (end-of-line 2) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
655 (or (looking-at boundary) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
656 (forward-line 1)) |
31717 | 657 (setq start (point))) |
34833
aaf69bc74739
* gnus-art.el (gnus-article-check-hidden-text): Return t.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
658 (when (and start (< start end)) |
31717 | 659 (save-excursion |
660 (save-restriction | |
661 (narrow-to-region start end) | |
60302
f34a552e4a9f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-139
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
662 (setq parts (nconc (list (mm-dissect-buffer t nil from)) parts))))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
663 (mm-possibly-verify-or-decrypt (nreverse parts) ctl))) |
31717 | 664 |
665 (defun mm-copy-to-buffer () | |
666 "Copy the contents of the current buffer to a fresh buffer." | |
92769
734bb318f69e
(mm-with-part): Set the buffer to unibyte before inserting
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92694
diff
changeset
|
667 (let ((obuf (current-buffer)) |
93107
3bf6293f3041
(mm-copy-to-buffer): Use mm-set-buffer-multibyte.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92769
diff
changeset
|
668 (mb (mm-multibyte-p)) |
92769
734bb318f69e
(mm-with-part): Set the buffer to unibyte before inserting
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92694
diff
changeset
|
669 beg) |
734bb318f69e
(mm-with-part): Set the buffer to unibyte before inserting
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92694
diff
changeset
|
670 (goto-char (point-min)) |
734bb318f69e
(mm-with-part): Set the buffer to unibyte before inserting
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92694
diff
changeset
|
671 (search-forward-regexp "^\n" nil t) |
734bb318f69e
(mm-with-part): Set the buffer to unibyte before inserting
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92694
diff
changeset
|
672 (setq beg (point)) |
70377
1b78f3a87f16
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-265
Miles Bader <miles@gnu.org>
parents:
70245
diff
changeset
|
673 (with-current-buffer |
93107
3bf6293f3041
(mm-copy-to-buffer): Use mm-set-buffer-multibyte.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92769
diff
changeset
|
674 (generate-new-buffer " *mm*") |
3bf6293f3041
(mm-copy-to-buffer): Use mm-set-buffer-multibyte.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92769
diff
changeset
|
675 ;; Preserve the data's unibyteness (for url-insert-file-contents). |
3bf6293f3041
(mm-copy-to-buffer): Use mm-set-buffer-multibyte.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92769
diff
changeset
|
676 (mm-set-buffer-multibyte mb) |
31717 | 677 (insert-buffer-substring obuf beg) |
678 (current-buffer)))) | |
679 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
680 (defun mm-display-parts (handle &optional no-default) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
681 (if (stringp (car handle)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
682 (mapcar 'mm-display-parts (cdr handle)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
683 (if (bufferp (car handle)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
684 (save-restriction |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
685 (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
|
686 (mm-display-part handle) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
687 (goto-char (point-max))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
688 (mapcar 'mm-display-parts handle)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
689 |
31717 | 690 (defun mm-display-part (handle &optional no-default) |
691 "Display the MIME part represented by HANDLE. | |
692 Returns nil if the part is removed; inline if displayed inline; | |
693 external if displayed external." | |
694 (save-excursion | |
695 (mailcap-parse-mailcaps) | |
696 (if (mm-handle-displayed-p handle) | |
697 (mm-remove-part handle) | |
69949
d0312c3f2374
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-214
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
698 (let* ((ehandle (if (equal (mm-handle-media-type handle) |
d0312c3f2374
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-214
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
699 "message/external-body") |
d0312c3f2374
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-214
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
700 (progn |
d0312c3f2374
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-214
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
701 (unless (mm-handle-cache handle) |
d0312c3f2374
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-214
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
702 (mm-extern-cache-contents handle)) |
d0312c3f2374
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-214
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
703 (mm-handle-cache handle)) |
d0312c3f2374
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-214
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
704 handle)) |
d0312c3f2374
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-214
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
705 (type (mm-handle-media-type ehandle)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
706 (method (mailcap-mime-info type)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
707 (filename (or (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
|
708 (mm-handle-disposition handle) 'filename) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
709 (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
|
710 (mm-handle-type handle) 'name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
711 "<file>")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
712 (external mm-enable-external)) |
69949
d0312c3f2374
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-214
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
713 (if (and (mm-inlinable-p ehandle) |
d0312c3f2374
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-214
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
714 (mm-inlined-p ehandle)) |
31717 | 715 (progn |
716 (forward-line 1) | |
717 (mm-display-inline handle) | |
718 'inline) | |
719 (when (or method | |
720 (not no-default)) | |
721 (if (and (not method) | |
69949
d0312c3f2374
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-214
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
722 (equal "text" (car (split-string type "/")))) |
31717 | 723 (progn |
724 (forward-line 1) | |
725 (mm-insert-inline handle (mm-get-part handle)) | |
726 'inline) | |
70377
1b78f3a87f16
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-265
Miles Bader <miles@gnu.org>
parents:
70245
diff
changeset
|
727 (setq external |
1b78f3a87f16
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-265
Miles Bader <miles@gnu.org>
parents:
70245
diff
changeset
|
728 (and method ;; If nil, we always use "save". |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
729 (stringp method) ;; 'mailcap-save-binary-file |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
730 (or (eq mm-enable-external t) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
731 (and (eq mm-enable-external 'ask) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
732 (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
|
733 (concat |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
734 "Display part (" type |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
735 ") using external program" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
736 ;; Can non-string method ever happen? |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
737 (if (stringp method) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
738 (concat |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
739 " \"" (format method filename) "\"") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
740 "") |
70377
1b78f3a87f16
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-265
Miles Bader <miles@gnu.org>
parents:
70245
diff
changeset
|
741 "? ")))))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
742 (if external |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
743 (mm-display-external |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
744 handle (or method 'mailcap-save-binary-file)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
745 (mm-display-external |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
746 handle 'mailcap-save-binary-file))))))))) |
31717 | 747 |
87243
23ea76295829
Add declare-function compatibility definition.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
748 (declare-function gnus-configure-windows "gnus-win" (setting &optional force)) |
23ea76295829
Add declare-function compatibility definition.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
749 |
31717 | 750 (defun mm-display-external (handle method) |
751 "Display HANDLE using METHOD." | |
752 (let ((outbuf (current-buffer))) | |
753 (mm-with-unibyte-buffer | |
754 (if (functionp method) | |
755 (let ((cur (current-buffer))) | |
756 (if (eq method 'mailcap-save-binary-file) | |
757 (progn | |
33174
702845b072b7
(mm-display-external): Space prefix temp buffer
Dave Love <fx@gnu.org>
parents:
32962
diff
changeset
|
758 (set-buffer (generate-new-buffer " *mm*")) |
31717 | 759 (setq method nil)) |
760 (mm-insert-part handle) | |
87454 | 761 (mm-add-meta-html-tag handle) |
31717 | 762 (let ((win (get-buffer-window cur t))) |
763 (when win | |
764 (select-window win))) | |
33174
702845b072b7
(mm-display-external): Space prefix temp buffer
Dave Love <fx@gnu.org>
parents:
32962
diff
changeset
|
765 (switch-to-buffer (generate-new-buffer " *mm*"))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
766 (buffer-disable-undo) |
31717 | 767 (mm-set-buffer-file-coding-system mm-binary-coding-system) |
768 (insert-buffer-substring cur) | |
769 (goto-char (point-min)) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
770 (when method |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
771 (message "Viewing with %s" method)) |
31717 | 772 (let ((mm (current-buffer)) |
773 (non-viewer (assq 'non-viewer | |
774 (mailcap-mime-info | |
775 (mm-handle-media-type handle) t)))) | |
776 (unwind-protect | |
777 (if method | |
778 (funcall method) | |
779 (mm-save-part handle)) | |
780 (when (and (not non-viewer) | |
781 method) | |
782 (mm-handle-set-undisplayer handle mm))))) | |
783 ;; The function is a string to be executed. | |
784 (mm-insert-part handle) | |
87454 | 785 (mm-add-meta-html-tag handle) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
786 (let* ((dir (mm-make-temp-file |
44075
7782e54757bb
* mail-source.el (make-source-make-complex-temp-name): Use
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38413
diff
changeset
|
787 (expand-file-name "emm." mm-tmp-directory) 'dir)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
788 (filename (or |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
789 (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
|
790 (mm-handle-disposition handle) 'filename) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
791 (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
|
792 (mm-handle-type handle) 'name))) |
31717 | 793 (mime-info (mailcap-mime-info |
794 (mm-handle-media-type handle) t)) | |
795 (needsterm (or (assoc "needsterm" mime-info) | |
796 (assoc "needsterminal" mime-info))) | |
797 (copiousoutput (assoc "copiousoutput" mime-info)) | |
798 file buffer) | |
799 ;; We create a private sub-directory where we store our files. | |
94209 | 800 (set-file-modes dir #o700) |
31717 | 801 (if filename |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
802 (setq file (expand-file-name |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
803 (gnus-map-function mm-file-name-rewrite-functions |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
804 (file-name-nondirectory filename)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
805 dir)) |
68940
808f636eb13e
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
806 ;; Use nametemplate (defined in RFC1524) if it is specified |
808f636eb13e
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
807 ;; in mailcap. |
808f636eb13e
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
808 (let ((suffix (cdr (assoc "nametemplate" mime-info)))) |
808f636eb13e
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
809 (if (and suffix |
808f636eb13e
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
810 (string-match "\\`%s\\(\\..+\\)\\'" suffix)) |
808f636eb13e
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
811 (setq suffix (match-string 1 suffix)) |
808f636eb13e
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
812 ;; Otherwise, use a suffix according to |
808f636eb13e
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
813 ;; `mailcap-mime-extensions'. |
808f636eb13e
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
814 (setq suffix (car (rassoc (mm-handle-media-type handle) |
808f636eb13e
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
815 mailcap-mime-extensions)))) |
808f636eb13e
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
816 (setq file (mm-make-temp-file (expand-file-name "mm." dir) |
808f636eb13e
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
817 nil suffix)))) |
31717 | 818 (let ((coding-system-for-write mm-binary-coding-system)) |
819 (write-region (point-min) (point-max) file nil 'nomesg)) | |
94209 | 820 ;; The file is deleted after the viewer exists. If the users edits |
821 ;; the file, changes will be lost. Set file to read-only to make it | |
822 ;; clear. | |
823 (set-file-modes file #o400) | |
31717 | 824 (message "Viewing with %s" method) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
825 (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
826 (needsterm |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
827 (let ((command (mm-mailcap-command |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
828 method file (mm-handle-type handle)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
829 (unwind-protect |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
830 (if window-system |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
831 (start-process "*display*" nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
832 mm-external-terminal-program |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
833 "-e" shell-file-name |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
834 shell-command-switch command) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
835 (require 'term) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
836 (require 'gnus-win) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
837 (set-buffer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
838 (setq buffer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
839 (make-term "display" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
840 shell-file-name |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
841 nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
842 shell-command-switch command))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
843 (term-mode) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
844 (term-char-mode) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
845 (set-process-sentinel |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
846 (get-buffer-process buffer) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
847 `(lambda (process state) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
848 (if (eq 'exit (process-status process)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
849 (gnus-configure-windows |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
850 ',gnus-current-window-configuration)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
851 (gnus-configure-windows 'display-term)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
852 (mm-handle-set-external-undisplayer handle (cons file buffer))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
853 (message "Displaying %s..." command)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
854 'external) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
855 (copiousoutput |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
856 (with-current-buffer outbuf |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
857 (forward-line 1) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
858 (mm-insert-inline |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
859 handle |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
860 (unwind-protect |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
861 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
862 (call-process shell-file-name nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
863 (setq buffer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
864 (generate-new-buffer " *mm*")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
865 nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
866 shell-command-switch |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
867 (mm-mailcap-command |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
868 method file (mm-handle-type handle))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
869 (if (buffer-live-p buffer) |
65767
1b9137e0ecc1
(mm-inline-media-tests): Check presence of the diff-mode
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65719
diff
changeset
|
870 (with-current-buffer buffer |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
871 (buffer-string)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
872 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
873 (ignore-errors (delete-file file)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
874 (ignore-errors (delete-directory |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
875 (file-name-directory file))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
876 (ignore-errors (kill-buffer buffer)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
877 'inline) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
878 (t |
67418
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
879 ;; Deleting the temp file should be postponed for some wrappers, |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
880 ;; shell scripts, and so on, which might exit right after having |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
881 ;; started a viewer command as a background job. |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
882 (let ((command (mm-mailcap-command |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
883 method file (mm-handle-type handle)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
884 (unwind-protect |
64693
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
885 (progn |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
886 (start-process "*display*" |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
887 (setq buffer |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
888 (generate-new-buffer " *mm*")) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
889 shell-file-name |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
890 shell-command-switch command) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
891 (set-process-sentinel |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
892 (get-buffer-process buffer) |
67418
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
893 (lexical-let ;; Don't use `let'. |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
894 ;; Function used to remove temp file and directory. |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
895 ((fn `(lambda nil |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
896 ;; Don't use `ignore-errors'. |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
897 (condition-case nil |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
898 (delete-file ,file) |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
899 (error)) |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
900 (condition-case nil |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
901 (delete-directory |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
902 ,(file-name-directory file)) |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
903 (error)))) |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
904 ;; Form uses to kill the process buffer and |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
905 ;; remove the undisplayer. |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
906 (fm `(progn |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
907 (kill-buffer ,buffer) |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
908 ,(macroexpand |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
909 (list 'mm-handle-set-undisplayer |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
910 (list 'quote handle) |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
911 nil)))) |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
912 ;; Message to be issued when the process exits. |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
913 (done (format "Displaying %s...done" command)) |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
914 ;; In particular, the timer object (which is |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
915 ;; a vector in Emacs but is a list in XEmacs) |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
916 ;; requires that it is lexically scoped. |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
917 (timer (run-at-time 2.0 nil 'ignore))) |
86154 | 918 (if (featurep 'xemacs) |
75149 | 919 (lambda (process state) |
920 (when (eq 'exit (process-status process)) | |
921 (if (memq timer itimer-list) | |
922 (set-itimer-function timer fn) | |
923 (funcall fn)) | |
924 (ignore-errors (eval fm)) | |
925 (message "%s" done))) | |
926 (lambda (process state) | |
927 (when (eq 'exit (process-status process)) | |
928 (if (memq timer timer-list) | |
929 (timer-set-function timer fn) | |
930 (funcall fn)) | |
931 (ignore-errors (eval fm)) | |
932 (message "%s" done))))))) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
933 (mm-handle-set-external-undisplayer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
934 handle (cons file buffer))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
935 (message "Displaying %s..." command)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
936 'external))))))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44075
diff
changeset
|
937 |
31717 | 938 (defun mm-mailcap-command (method file type-list) |
939 (let ((ctl (cdr type-list)) | |
940 (beg 0) | |
941 (uses-stdin t) | |
942 out sub total) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
943 (while (string-match "%{\\([^}]+\\)}\\|'%s'\\|\"%s\"\\|%s\\|%t\\|%%" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
944 method beg) |
31717 | 945 (push (substring method beg (match-beginning 0)) out) |
946 (setq beg (match-end 0) | |
947 total (match-string 0 method) | |
948 sub (match-string 1 method)) | |
949 (cond | |
950 ((string= total "%%") | |
951 (push "%" out)) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
952 ((or (string= total "%s") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
953 ;; We do our own quoting. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
954 (string= total "'%s'") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
955 (string= total "\"%s\"")) |
31717 | 956 (setq uses-stdin nil) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
957 (push (shell-quote-argument |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
958 (gnus-map-function mm-path-name-rewrite-functions file)) out)) |
31717 | 959 ((string= total "%t") |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
960 (push (shell-quote-argument (car type-list)) out)) |
31717 | 961 (t |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
962 (push (shell-quote-argument (or (cdr (assq (intern sub) ctl)) "")) out)))) |
31717 | 963 (push (substring method beg (length method)) out) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
964 (when uses-stdin |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
965 (push "<" out) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
966 (push (shell-quote-argument |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
967 (gnus-map-function mm-path-name-rewrite-functions file)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
968 out)) |
31717 | 969 (mapconcat 'identity (nreverse out) ""))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44075
diff
changeset
|
970 |
31717 | 971 (defun mm-remove-parts (handles) |
972 "Remove the displayed MIME parts represented by HANDLES." | |
973 (if (and (listp handles) | |
974 (bufferp (car handles))) | |
975 (mm-remove-part handles) | |
976 (let (handle) | |
977 (while (setq handle (pop handles)) | |
978 (cond | |
979 ((stringp handle) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
980 (when (buffer-live-p (get-text-property 0 'buffer handle)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
981 (kill-buffer (get-text-property 0 'buffer handle)))) |
31717 | 982 ((and (listp handle) |
983 (stringp (car handle))) | |
984 (mm-remove-parts (cdr handle))) | |
985 (t | |
986 (mm-remove-part handle))))))) | |
987 | |
988 (defun mm-destroy-parts (handles) | |
989 "Remove the displayed MIME parts represented by HANDLES." | |
990 (if (and (listp handles) | |
991 (bufferp (car handles))) | |
992 (mm-destroy-part handles) | |
993 (let (handle) | |
994 (while (setq handle (pop handles)) | |
995 (cond | |
996 ((stringp handle) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
997 (when (buffer-live-p (get-text-property 0 'buffer handle)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
998 (kill-buffer (get-text-property 0 'buffer handle)))) |
31717 | 999 ((and (listp handle) |
1000 (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
|
1001 (mm-destroy-parts handle)) |
31717 | 1002 (t |
1003 (mm-destroy-part handle))))))) | |
1004 | |
1005 (defun mm-remove-part (handle) | |
1006 "Remove the displayed MIME part represented by HANDLE." | |
1007 (when (listp handle) | |
1008 (let ((object (mm-handle-undisplayer handle))) | |
1009 (ignore-errors | |
1010 (cond | |
1011 ;; Internally displayed part. | |
1012 ((mm-annotationp object) | |
87243
23ea76295829
Add declare-function compatibility definition.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
1013 (if (featurep 'xemacs) |
23ea76295829
Add declare-function compatibility definition.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
1014 (delete-annotation object))) |
31717 | 1015 ((or (functionp object) |
1016 (and (listp object) | |
1017 (eq (car object) 'lambda))) | |
1018 (funcall object)) | |
1019 ;; Externally displayed part. | |
1020 ((consp object) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1021 (condition-case () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1022 (while (get-buffer-process (cdr object)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1023 (interrupt-process (get-buffer-process (cdr object))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1024 (message "Waiting for external displayer to die...") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1025 (sit-for 1)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1026 (quit) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1027 (error)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1028 (ignore-errors (and (cdr object) (kill-buffer (cdr object)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1029 (message "Waiting for external displayer to die...done") |
31717 | 1030 (ignore-errors (delete-file (car object))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1031 (ignore-errors (delete-directory (file-name-directory |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1032 (car object))))) |
31717 | 1033 ((bufferp object) |
1034 (when (buffer-live-p object) | |
1035 (kill-buffer object))))) | |
1036 (mm-handle-set-undisplayer handle nil)))) | |
1037 | |
1038 (defun mm-display-inline (handle) | |
1039 (let* ((type (mm-handle-media-type handle)) | |
1040 (function (cadr (mm-assoc-string-match mm-inline-media-tests type)))) | |
1041 (funcall function handle) | |
1042 (goto-char (point-min)))) | |
1043 | |
1044 (defun mm-assoc-string-match (alist type) | |
1045 (dolist (elem alist) | |
1046 (when (string-match (car elem) type) | |
1047 (return elem)))) | |
1048 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1049 (defun mm-automatic-display-p (handle) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1050 "Say whether the user wants HANDLE to be displayed automatically." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1051 (let ((methods mm-automatic-display) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1052 (type (mm-handle-media-type handle)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1053 method result) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1054 (while (setq method (pop methods)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1055 (when (and (not (mm-inline-override-p handle)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1056 (string-match method type)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1057 (setq result t |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1058 methods nil))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1059 result)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1060 |
70377
1b78f3a87f16
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-265
Miles Bader <miles@gnu.org>
parents:
70245
diff
changeset
|
1061 (defun mm-inlinable-p (handle &optional type) |
1b78f3a87f16
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-265
Miles Bader <miles@gnu.org>
parents:
70245
diff
changeset
|
1062 "Say whether HANDLE can be displayed inline. |
1b78f3a87f16
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-265
Miles Bader <miles@gnu.org>
parents:
70245
diff
changeset
|
1063 TYPE is the mime-type of the object; it defaults to the one given |
1b78f3a87f16
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-265
Miles Bader <miles@gnu.org>
parents:
70245
diff
changeset
|
1064 in HANDLE." |
1b78f3a87f16
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-265
Miles Bader <miles@gnu.org>
parents:
70245
diff
changeset
|
1065 (unless type (setq type (mm-handle-media-type handle))) |
31717 | 1066 (let ((alist mm-inline-media-tests) |
1067 test) | |
1068 (while alist | |
1069 (when (string-match (caar alist) type) | |
1070 (setq test (caddar alist) | |
1071 alist nil) | |
1072 (setq test (funcall test handle))) | |
1073 (pop alist)) | |
1074 test)) | |
1075 | |
1076 (defun mm-inlined-p (handle) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1077 "Say whether the user wants HANDLE to be displayed inline." |
31717 | 1078 (let ((methods mm-inlined-types) |
1079 (type (mm-handle-media-type handle)) | |
1080 method result) | |
1081 (while (setq method (pop methods)) | |
1082 (when (and (not (mm-inline-override-p handle)) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1083 (string-match method type)) |
31717 | 1084 (setq result t |
1085 methods nil))) | |
1086 result)) | |
1087 | |
1088 (defun mm-attachment-override-p (handle) | |
1089 "Say whether HANDLE should have attachment behavior overridden." | |
1090 (let ((types mm-attachment-override-types) | |
1091 (type (mm-handle-media-type handle)) | |
1092 ty) | |
1093 (catch 'found | |
1094 (while (setq ty (pop types)) | |
1095 (when (and (string-match ty type) | |
1096 (mm-inlinable-p handle)) | |
1097 (throw 'found t)))))) | |
1098 | |
1099 (defun mm-inline-override-p (handle) | |
1100 "Say whether HANDLE should have inline behavior overridden." | |
1101 (let ((types mm-inline-override-types) | |
1102 (type (mm-handle-media-type handle)) | |
1103 ty) | |
1104 (catch 'found | |
1105 (while (setq ty (pop types)) | |
1106 (when (string-match ty type) | |
1107 (throw 'found t)))))) | |
1108 | |
1109 (defun mm-automatic-external-display-p (type) | |
1110 "Return the user-defined method for TYPE." | |
1111 (let ((methods mm-automatic-external-display) | |
1112 method result) | |
1113 (while (setq method (pop methods)) | |
1114 (when (string-match method type) | |
1115 (setq result t | |
1116 methods nil))) | |
1117 result)) | |
1118 | |
1119 (defun mm-destroy-part (handle) | |
1120 "Destroy the data structures connected to HANDLE." | |
1121 (when (listp handle) | |
1122 (mm-remove-part handle) | |
1123 (when (buffer-live-p (mm-handle-buffer handle)) | |
1124 (kill-buffer (mm-handle-buffer handle))))) | |
1125 | |
1126 (defun mm-handle-displayed-p (handle) | |
1127 "Say whether HANDLE is displayed or not." | |
1128 (mm-handle-undisplayer handle)) | |
1129 | |
1130 ;;; | |
1131 ;;; Functions for outputting parts | |
1132 ;;; | |
1133 | |
69572
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1134 (defmacro mm-with-part (handle &rest forms) |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1135 "Run FORMS in the temp buffer containing the contents of HANDLE." |
92769
734bb318f69e
(mm-with-part): Set the buffer to unibyte before inserting
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92694
diff
changeset
|
1136 ;; The handle-buffer's content is a sequence of bytes, not a sequence of |
734bb318f69e
(mm-with-part): Set the buffer to unibyte before inserting
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92694
diff
changeset
|
1137 ;; chars, so the buffer should be unibyte. It may happen that the |
734bb318f69e
(mm-with-part): Set the buffer to unibyte before inserting
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92694
diff
changeset
|
1138 ;; handle-buffer is multibyte for some reason, in which case now is a good |
734bb318f69e
(mm-with-part): Set the buffer to unibyte before inserting
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92694
diff
changeset
|
1139 ;; time to adjust it, since we know at this point that it should |
734bb318f69e
(mm-with-part): Set the buffer to unibyte before inserting
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92694
diff
changeset
|
1140 ;; be unibyte. |
734bb318f69e
(mm-with-part): Set the buffer to unibyte before inserting
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92694
diff
changeset
|
1141 `(let* ((handle ,handle)) |
69572
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1142 (with-temp-buffer |
92769
734bb318f69e
(mm-with-part): Set the buffer to unibyte before inserting
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92694
diff
changeset
|
1143 (mm-disable-multibyte) |
69572
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1144 (insert-buffer-substring (mm-handle-buffer handle)) |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1145 (mm-decode-content-transfer-encoding |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1146 (mm-handle-encoding handle) |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1147 (mm-handle-media-type handle)) |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1148 ,@forms))) |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1149 (put 'mm-with-part 'lisp-indent-function 1) |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1150 (put 'mm-with-part 'edebug-form-spec '(body)) |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1151 |
69649
ab0b847baba4
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-176
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1152 (defun mm-get-part (handle &optional no-cache) |
ab0b847baba4
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-176
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1153 "Return the contents of HANDLE as a string. |
ab0b847baba4
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-176
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1154 If NO-CACHE is non-nil, cached contents of a message/external-body part |
ab0b847baba4
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-176
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1155 are ignored." |
ab0b847baba4
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-176
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1156 (if (and (not no-cache) |
ab0b847baba4
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-176
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1157 (equal (mm-handle-media-type handle) "message/external-body")) |
69572
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1158 (progn |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1159 (unless (mm-handle-cache handle) |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1160 (mm-extern-cache-contents handle)) |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1161 (with-current-buffer (mm-handle-buffer (mm-handle-cache handle)) |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1162 (buffer-string))) |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1163 (mm-with-part handle |
69247
6580c61aced7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-134
Miles Bader <miles@gnu.org>
parents:
68940
diff
changeset
|
1164 (buffer-string)))) |
31717 | 1165 |
69649
ab0b847baba4
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-176
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1166 (defun mm-insert-part (handle &optional no-cache) |
ab0b847baba4
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-176
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1167 "Insert the contents of HANDLE in the current buffer. |
ab0b847baba4
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-176
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1168 If NO-CACHE is non-nil, cached contents of a message/external-body part |
ab0b847baba4
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-176
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1169 are ignored." |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1170 (let ((text (cond ((eq (mail-content-type-get (mm-handle-type handle) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1171 'charset) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1172 'gnus-decoded) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1173 (with-current-buffer (mm-handle-buffer handle) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1174 (buffer-string))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1175 ((mm-multibyte-p) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1176 (mm-string-to-multibyte (mm-get-part handle no-cache))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1177 (t |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1178 (mm-get-part handle no-cache))))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1179 (save-restriction |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1180 (widen) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1181 (goto-char |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1182 (prog1 |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1183 (point) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1184 (if (and (eq (get-char-property (max (point-min) (1- (point))) 'face) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1185 'mm-uu-extract) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1186 (eq (get-char-property 0 'face text) 'mm-uu-extract)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1187 ;; Separate the extracted parts that have the same faces. |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1188 (insert "\n" text) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1189 (insert text))))))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1190 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1191 (defun mm-file-name-delete-whitespace (file-name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1192 "Remove all whitespace characters from FILE-NAME." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1193 (while (string-match "\\s-+" file-name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1194 (setq file-name (replace-match "" t t file-name))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1195 file-name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1196 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1197 (defun mm-file-name-trim-whitespace (file-name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1198 "Remove leading and trailing whitespace characters from FILE-NAME." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1199 (when (string-match "\\`\\s-+" file-name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1200 (setq file-name (substring file-name (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
|
1201 (when (string-match "\\s-+\\'" file-name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1202 (setq file-name (substring file-name 0 (match-beginning 0)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1203 file-name) |
31717 | 1204 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1205 (defun mm-file-name-collapse-whitespace (file-name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1206 "Collapse multiple whitespace characters in FILE-NAME." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1207 (while (string-match "\\s-\\s-+" file-name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1208 (setq file-name (replace-match " " t t file-name))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1209 file-name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1210 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1211 (defun mm-file-name-replace-whitespace (file-name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1212 "Replace whitespace characters in FILE-NAME with underscores. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1213 Set the option `mm-file-name-replace-whitespace' to any other |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1214 string if you do not like underscores." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1215 (let ((s (or mm-file-name-replace-whitespace "_"))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1216 (while (string-match "\\s-" file-name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1217 (setq file-name (replace-match s t t file-name)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1218 file-name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1219 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1220 (defun mm-file-name-delete-control (filename) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1221 "Delete control characters from FILENAME." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1222 (gnus-replace-in-string filename "[\x00-\x1f\x7f]" "")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1223 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1224 (defun mm-file-name-delete-gotchas (filename) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1225 "Delete shell gotchas from FILENAME." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1226 (setq filename (gnus-replace-in-string filename "[<>|]" "")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1227 (gnus-replace-in-string filename "^[.-]+" "")) |
31717 | 1228 |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1229 (defun mm-save-part (handle &optional prompt) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1230 "Write HANDLE to a file. |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1231 PROMPT overrides the default one used to ask user for a file name." |
69572
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1232 (let ((filename (or (mail-content-type-get |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1233 (mm-handle-disposition handle) 'filename) |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1234 (mail-content-type-get |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1235 (mm-handle-type handle) 'name))) |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1236 file) |
31717 | 1237 (when filename |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1238 (setq filename (gnus-map-function mm-file-name-rewrite-functions |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1239 (file-name-nondirectory filename)))) |
31717 | 1240 (setq file |
93723
2da1f95ea11c
(mm-inline-media-tests): Add entry for x-diff.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93107
diff
changeset
|
1241 (read-file-name (or prompt "Save MIME part to: ") |
2da1f95ea11c
(mm-inline-media-tests): Add entry for x-diff.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93107
diff
changeset
|
1242 (or mm-default-directory default-directory) |
2da1f95ea11c
(mm-inline-media-tests): Add entry for x-diff.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93107
diff
changeset
|
1243 nil nil (or filename ""))) |
31717 | 1244 (setq mm-default-directory (file-name-directory file)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1245 (and (or (not (file-exists-p file)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1246 (yes-or-no-p (format "File %s already exists; overwrite? " |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1247 file))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1248 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1249 (mm-save-part-to-file handle file) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1250 file)))) |
31717 | 1251 |
87300 | 1252 (defun mm-add-meta-html-tag (handle &optional charset) |
1253 "Add meta html tag to specify CHARSET of HANDLE in the current buffer. | |
1254 CHARSET defaults to the one HANDLE specifies. Existing meta tag that | |
1255 specifies charset will not be modified. Return t if meta tag is added | |
1256 or replaced." | |
1257 (when (equal (mm-handle-media-type handle) "text/html") | |
1258 (when (or charset | |
1259 (setq charset (mail-content-type-get (mm-handle-type handle) | |
1260 'charset))) | |
1261 (setq charset (format "\ | |
1262 <meta http-equiv=\"Content-Type\" content=\"text/html; charset=%s\">" charset)) | |
1263 (let ((case-fold-search t)) | |
1264 (goto-char (point-min)) | |
1265 (if (re-search-forward "\ | |
1266 <meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']\ | |
1267 text/\\(\\sw+\\)\\(?:\;\\s-*charset=\\(.+?\\)\\)?[\"'][^>]*>" nil t) | |
1268 (if (and (match-beginning 2) | |
1269 (string-match "\\`html\\'" (match-string 1))) | |
1270 ;; Don't modify existing meta tag. | |
1271 nil | |
1272 ;; Replace it with the one specifying charset. | |
1273 (replace-match charset) | |
1274 t) | |
1275 (if (re-search-forward "<head>\\s-*" nil t) | |
1276 (insert charset "\n") | |
1277 (re-search-forward "<html\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t) | |
1278 (insert "<head>\n" charset "\n</head>\n")) | |
1279 t))))) | |
1280 | |
31717 | 1281 (defun mm-save-part-to-file (handle file) |
1282 (mm-with-unibyte-buffer | |
1283 (mm-insert-part handle) | |
87300 | 1284 (mm-add-meta-html-tag handle) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1285 (let ((current-file-modes (default-file-modes))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1286 (set-default-file-modes mm-attachment-file-modes) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1287 (unwind-protect |
31717 | 1288 ;; Don't re-compress .gz & al. Arguably we should make |
1289 ;; `file-name-handler-alist' nil, but that would chop | |
1290 ;; ange-ftp, which is reasonable to use here. | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1291 (mm-write-region (point-min) (point-max) file nil nil nil 'binary t) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1292 (set-default-file-modes current-file-modes))))) |
31717 | 1293 |
1294 (defun mm-pipe-part (handle) | |
1295 "Pipe HANDLE to a process." | |
1296 (let* ((name (mail-content-type-get (mm-handle-type handle) 'name)) | |
1297 (command | |
1298 (read-string "Shell command on MIME part: " mm-last-shell-command))) | |
1299 (mm-with-unibyte-buffer | |
1300 (mm-insert-part handle) | |
87300 | 1301 (mm-add-meta-html-tag handle) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1302 (let ((coding-system-for-write 'binary)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1303 (shell-command-on-region (point-min) (point-max) command nil))))) |
31717 | 1304 |
1305 (defun mm-interactively-view-part (handle) | |
1306 "Display HANDLE using METHOD." | |
1307 (let* ((type (mm-handle-media-type handle)) | |
1308 (methods | |
1309 (mapcar (lambda (i) (list (cdr (assoc 'viewer i)))) | |
1310 (mailcap-mime-info type 'all))) | |
32962 | 1311 (method (let ((minibuffer-local-completion-map |
1312 mm-viewer-completion-map)) | |
1313 (completing-read "Viewer: " methods)))) | |
31717 | 1314 (when (string= method "") |
1315 (error "No method given")) | |
35048 | 1316 (if (string-match "^[^% \t]+$" method) |
31717 | 1317 (setq method (concat method " %s"))) |
35453
26726eff41ca
2001-01-21 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
35048
diff
changeset
|
1318 (mm-display-external handle method))) |
31717 | 1319 |
1320 (defun mm-preferred-alternative (handles &optional preferred) | |
1321 "Say which of HANDLES are preferred." | |
1322 (let ((prec (if preferred (list preferred) | |
1323 (mm-preferred-alternative-precedence handles))) | |
1324 p h result type handle) | |
1325 (while (setq p (pop prec)) | |
1326 (setq h handles) | |
1327 (while h | |
1328 (setq handle (car h)) | |
1329 (setq type (mm-handle-media-type handle)) | |
1330 (when (and (equal p type) | |
1331 (mm-automatic-display-p handle) | |
1332 (or (stringp (car handle)) | |
1333 (not (mm-handle-disposition handle)) | |
1334 (equal (car (mm-handle-disposition handle)) | |
1335 "inline"))) | |
1336 (setq result handle | |
1337 h nil | |
1338 prec nil)) | |
1339 (pop h))) | |
1340 result)) | |
1341 | |
1342 (defun mm-preferred-alternative-precedence (handles) | |
1343 "Return the precedence based on HANDLES and `mm-discouraged-alternatives'." | |
1344 (let ((seq (nreverse (mapcar #'mm-handle-media-type | |
1345 handles)))) | |
1346 (dolist (disc (reverse mm-discouraged-alternatives)) | |
1347 (dolist (elem (copy-sequence seq)) | |
1348 (when (string-match disc elem) | |
1349 (setq seq (nconc (delete elem seq) (list elem)))))) | |
1350 seq)) | |
1351 | |
1352 (defun mm-get-content-id (id) | |
1353 "Return the handle(s) referred to by ID." | |
1354 (cdr (assoc id mm-content-id-alist))) | |
1355 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1356 (defconst mm-image-type-regexps |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1357 '(("/\\*.*XPM.\\*/" . xpm) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1358 ("P[1-6]" . pbm) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1359 ("GIF8" . gif) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1360 ("\377\330" . jpeg) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1361 ("\211PNG\r\n" . png) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1362 ("#define" . xbm) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1363 ("\\(MM\0\\*\\)\\|\\(II\\*\0\\)" . tiff) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1364 ("%!PS" . postscript)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1365 "Alist of (REGEXP . IMAGE-TYPE) pairs used to auto-detect image types. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1366 When the first bytes of an image file match REGEXP, it is assumed to |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1367 be of image type IMAGE-TYPE.") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1368 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1369 ;; Steal from image.el. image-type-from-data suffers multi-line matching bug. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1370 (defun mm-image-type-from-buffer () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1371 "Determine the image type from data in the current buffer. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1372 Value is a symbol specifying the image type or nil if type cannot |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1373 be determined." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1374 (let ((types mm-image-type-regexps) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1375 type) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1376 (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
|
1377 (while (and types (null type)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1378 (let ((regexp (car (car types))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1379 (image-type (cdr (car types)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1380 (when (looking-at regexp) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1381 (setq type image-type)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1382 (setq types (cdr types)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1383 type)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1384 |
31717 | 1385 (defun mm-get-image (handle) |
1386 "Return an image instance based on HANDLE." | |
1387 (let ((type (mm-handle-media-subtype handle)) | |
1388 spec) | |
1389 ;; Allow some common translations. | |
1390 (setq type | |
1391 (cond | |
1392 ((equal type "x-pixmap") | |
1393 "xpm") | |
1394 ((equal type "x-xbitmap") | |
1395 "xbm") | |
35048 | 1396 ((equal type "x-portable-bitmap") |
1397 "pbm") | |
31717 | 1398 (t type))) |
1399 (or (mm-handle-cache handle) | |
1400 (mm-with-unibyte-buffer | |
1401 (mm-insert-part handle) | |
1402 (prog1 | |
1403 (setq spec | |
1404 (ignore-errors | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1405 ;; Avoid testing `make-glyph' since W3 may define |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1406 ;; a bogus version of it. |
31717 | 1407 (if (fboundp 'create-image) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1408 (create-image (buffer-string) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1409 (or (mm-image-type-from-buffer) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1410 (intern type)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1411 'data-p) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1412 (mm-create-image-xemacs type)))) |
31717 | 1413 (mm-handle-set-cache handle spec)))))) |
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 mm-create-image-xemacs (type) |
86154 | 1416 (when (featurep 'xemacs) |
1417 (cond | |
1418 ((equal type "xbm") | |
1419 ;; xbm images require special handling, since | |
1420 ;; the only way to create glyphs from these | |
1421 ;; (without a ton of work) is to write them | |
1422 ;; out to a file, and then create a file | |
1423 ;; specifier. | |
1424 (let ((file (mm-make-temp-file | |
1425 (expand-file-name "emm" mm-tmp-directory) | |
1426 nil ".xbm"))) | |
1427 (unwind-protect | |
1428 (progn | |
1429 (write-region (point-min) (point-max) file) | |
1430 (make-glyph (list (cons 'x file)))) | |
1431 (ignore-errors | |
1432 (delete-file file))))) | |
1433 (t | |
1434 (make-glyph | |
1435 (vector | |
1436 (or (mm-image-type-from-buffer) | |
1437 (intern type)) | |
1438 :data (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
|
1439 |
31717 | 1440 (defun mm-image-fit-p (handle) |
1441 "Say whether the image in HANDLE will fit the current window." | |
1442 (let ((image (mm-get-image handle))) | |
78006 | 1443 (or (not image) |
86154 | 1444 (if (featurep 'xemacs) |
78006 | 1445 ;; XEmacs' glyphs can actually tell us about their width, so |
1446 ;; lets be nice and smart about them. | |
1447 (or mm-inline-large-images | |
1448 (and (<= (glyph-width image) (window-pixel-width)) | |
1449 (<= (glyph-height image) (window-pixel-height)))) | |
1450 (let* ((size (image-size image)) | |
1451 (w (car size)) | |
1452 (h (cdr size))) | |
1453 (or mm-inline-large-images | |
1454 (and (<= h (1- (window-height))) ; Don't include mode line. | |
1455 (<= w (window-width))))))))) | |
31717 | 1456 |
1457 (defun mm-valid-image-format-p (format) | |
1458 "Say whether FORMAT can be displayed natively by Emacs." | |
1459 (cond | |
1460 ;; Handle XEmacs | |
1461 ((fboundp 'valid-image-instantiator-format-p) | |
1462 (valid-image-instantiator-format-p format)) | |
1463 ;; Handle Emacs 21 | |
1464 ((fboundp 'image-type-available-p) | |
1465 (and (display-graphic-p) | |
1466 (image-type-available-p format))) | |
1467 ;; Nobody else can do images yet. | |
1468 (t | |
1469 nil))) | |
1470 | |
1471 (defun mm-valid-and-fit-image-p (format handle) | |
1472 "Say whether FORMAT can be displayed natively and HANDLE fits the window." | |
32962 | 1473 (and (mm-valid-image-format-p format) |
31717 | 1474 (mm-image-fit-p handle))) |
1475 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1476 (defun mm-find-part-by-type (handles type &optional notp recursive) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1477 "Search in HANDLES for part with TYPE. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1478 If NOTP, returns first non-matching part. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1479 If RECURSIVE, search recursively." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1480 (let (handle) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1481 (while handles |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1482 (if (and recursive (stringp (caar handles))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1483 (if (setq handle (mm-find-part-by-type (cdar handles) type |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1484 notp recursive)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1485 (setq handles nil)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1486 (if (if notp |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1487 (not (equal (mm-handle-media-type (car handles)) type)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1488 (equal (mm-handle-media-type (car handles)) type)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1489 (setq handle (car handles) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1490 handles nil))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1491 (setq handles (cdr handles))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1492 handle)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1493 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1494 (defun mm-find-raw-part-by-type (ctl type &optional notp) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1495 (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
|
1496 (let* ((boundary (concat "--" (mm-handle-multipart-ctl-parameter ctl |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1497 'boundary))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1498 (close-delimiter (concat "^" (regexp-quote boundary) "--[ \t]*$")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1499 start |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1500 (end (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1501 (goto-char (point-max)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1502 (if (re-search-backward close-delimiter 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 (match-beginning 0) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1504 (point-max)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1505 result) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1506 (setq boundary (concat "^" (regexp-quote boundary) "[ \t]*$")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1507 (while (and (not result) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1508 (re-search-forward boundary end t)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1509 (goto-char (match-beginning 0)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1510 (when start |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1511 (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1512 (save-restriction |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1513 (narrow-to-region start (1- (point))) |
68720
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68287
diff
changeset
|
1514 (when (let* ((ct (mail-fetch-field "content-type")) |
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68287
diff
changeset
|
1515 (ctl (and ct (mail-header-parse-content-type ct)))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1516 (if notp |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1517 (not (equal (car ctl) type)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1518 (equal (car ctl) type))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1519 (setq result (buffer-string)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1520 (forward-line 1) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1521 (setq start (point))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1522 (when (and (not result) start) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1523 (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1524 (save-restriction |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1525 (narrow-to-region start end) |
68720
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68287
diff
changeset
|
1526 (when (let* ((ct (mail-fetch-field "content-type")) |
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68287
diff
changeset
|
1527 (ctl (and ct (mail-header-parse-content-type ct)))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1528 (if notp |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1529 (not (equal (car ctl) type)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1530 (equal (car ctl) type))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1531 (setq result (buffer-string)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1532 result)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1533 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1534 (defvar mm-security-handle nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1535 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1536 (defsubst mm-set-handle-multipart-parameter (handle parameter value) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1537 ;; HANDLE could be a CTL. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1538 (when handle |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1539 (put-text-property 0 (length (car handle)) parameter value |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1540 (car handle)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1541 |
87243
23ea76295829
Add declare-function compatibility definition.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
1542 (autoload 'mm-view-pkcs7 "mm-view") |
23ea76295829
Add declare-function compatibility definition.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
1543 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1544 (defun mm-possibly-verify-or-decrypt (parts ctl) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1545 (let ((type (car ctl)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1546 (subtype (cadr (split-string (car ctl) "/"))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1547 (mm-security-handle ctl) ;; (car CTL) is the type. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1548 protocol func functest) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1549 (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1550 ((or (equal type "application/x-pkcs7-mime") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1551 (equal type "application/pkcs7-mime")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1552 (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
|
1553 (when (and (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1554 ((eq mm-decrypt-option 'never) nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1555 ((eq mm-decrypt-option 'always) t) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1556 ((eq mm-decrypt-option 'known) t) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1557 (t (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
|
1558 (format "Decrypt (S/MIME) part? ")))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1559 (mm-view-pkcs7 parts)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1560 (setq parts (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
|
1561 ((equal subtype "signed") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1562 (unless (and (setq protocol |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1563 (mm-handle-multipart-ctl-parameter ctl 'protocol)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1564 (not (equal protocol "multipart/mixed"))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1565 ;; The message is broken or draft-ietf-openpgp-multsig-01. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1566 (let ((protocols mm-verify-function-alist)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1567 (while protocols |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1568 (if (and (or (not (setq functest (nth 3 (car protocols)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1569 (funcall functest parts ctl)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1570 (mm-find-part-by-type parts (caar protocols) nil t)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1571 (setq protocol (caar protocols) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1572 protocols nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1573 (setq protocols (cdr protocols)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1574 (setq func (nth 1 (assoc protocol mm-verify-function-alist))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1575 (when (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1576 ((eq mm-verify-option 'never) nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1577 ((eq mm-verify-option 'always) t) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1578 ((eq mm-verify-option 'known) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1579 (and func |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1580 (or (not (setq functest |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1581 (nth 3 (assoc protocol |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1582 mm-verify-function-alist)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1583 (funcall functest parts ctl)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1584 (t |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1585 (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
|
1586 (format "Verify signed (%s) part? " |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1587 (or (nth 2 (assoc protocol mm-verify-function-alist)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1588 (format "protocol=%s" protocol)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1589 (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1590 (if func |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1591 (setq parts (funcall func parts ctl)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1592 (mm-set-handle-multipart-parameter |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1593 mm-security-handle 'gnus-details |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1594 (format "Unknown sign protocol (%s)" protocol)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1595 ((equal subtype "encrypted") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1596 (unless (setq protocol |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1597 (mm-handle-multipart-ctl-parameter ctl 'protocol)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1598 ;; The message is broken. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1599 (let ((parts parts)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1600 (while parts |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1601 (if (assoc (mm-handle-media-type (car parts)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1602 mm-decrypt-function-alist) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1603 (setq protocol (mm-handle-media-type (car parts)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1604 parts nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1605 (setq parts (cdr parts)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1606 (setq func (nth 1 (assoc protocol mm-decrypt-function-alist))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1607 (when (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1608 ((eq mm-decrypt-option 'never) nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1609 ((eq mm-decrypt-option 'always) t) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1610 ((eq mm-decrypt-option 'known) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1611 (and func |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1612 (or (not (setq functest |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1613 (nth 3 (assoc protocol |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1614 mm-decrypt-function-alist)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1615 (funcall functest parts ctl)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1616 (t |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1617 (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
|
1618 (format "Decrypt (%s) part? " |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1619 (or (nth 2 (assoc protocol mm-decrypt-function-alist)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1620 (format "protocol=%s" protocol)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1621 (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1622 (if func |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1623 (setq parts (funcall func parts ctl)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1624 (mm-set-handle-multipart-parameter |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1625 mm-security-handle 'gnus-details |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1626 (format "Unknown encrypt protocol (%s)" protocol)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1627 (t nil)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1628 parts)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1629 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1630 (defun mm-multiple-handles (handles) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1631 (and (listp handles) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1632 (> (length handles) 1) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1633 (or (listp (car handles)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1634 (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
|
1635 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1636 (defun mm-complicated-handles (handles) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1637 (and (listp (car handles)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1638 (> (length handles) 1))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1639 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1640 (defun mm-merge-handles (handles1 handles2) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1641 (append |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1642 (if (listp (car handles1)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1643 handles1 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1644 (list handles1)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1645 (if (listp (car handles2)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1646 handles2 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1647 (list handles2)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1648 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1649 (defun mm-readable-p (handle) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1650 "Say whether the content of HANDLE is readable." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1651 (and (< (with-current-buffer (mm-handle-buffer handle) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1652 (buffer-size)) 10000) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1653 (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
|
1654 (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
|
1655 (and (eq (mm-body-7-or-8) '7bit) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1656 (not (mm-long-lines-p 76)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1657 |
31717 | 1658 (provide 'mm-decode) |
1659 | |
57173
353df9943a65
(mm-copy-to-buffer): Preserve the data's unibyteness.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57153
diff
changeset
|
1660 ;; arch-tag: 4f35d360-56b8-4030-9388-3ed82d359b9b |
31717 | 1661 ;;; mm-decode.el ends here |