Mercurial > emacs
annotate lisp/gnus/mm-decode.el @ 107427:ecbe0edc4f69
Stop message.el from loading about 40 libraries it doesn't always need.
The general approach is to autoload rather than require, and to
require in the specific functions rather than the file. (Bug#5642)
* url/url.el: Move mailcap require earlier in the file.
* gnus/gmm-utils.el: Don't require wid-edit.
(widget-create-child-value, widget-convert, widget-default-get):
Autoload.
* gnus/gnus-util.el: Don't require time-date, netrc.
(message-fetch-field, gnus-group-name-decode): Declare rather than
autoloading.
(gnus-fetch-field): Require message.
(gnus-decode-newsgroups): Require gnus-group.
* gnus/ietf-drums.el: Don't require time-date.
* gnus/message.el: Don't require hashcash, canlock, ecomplete.
Do require mail-utils. Require nnheader only when compiling.
(smtpmail-default-smtp-server): Remove declaration.
(message-send-mail-function): Check smtpmail-default-smtp-server
is bound rather than requiring smtpmail.
(message-auto-save-directory, message-insert-signature): Use
expand-file-name rather than nnheader-concat.
(nnheader-insert-file-contents): Autoload.
(hashcash-wait-async): Declare.
(message-send-mail): Only call gnus-setup-posting-charset if
gnus-group-posting-charset-alist is bound. Require hashcash if needed.
(message-send-mail-with-sendmail): Require sendmail.
(canlock-password, canlock-password-for-verify): Declare.
(message-canlock-password): Require canlock.
(nnheader-get-report): Autoload.
(gnus-setup-posting-charset): Declare.
(message-send-news): Require gnus-msg.
(message-make-references, message-make-in-reply-to): Use mail-header-id
rather than the alias mail-header-message-id.
(ecomplete-add-item, ecomplete-save): Declare.
(message-put-addresses-in-ecomplete): Require ecomplete.
(ecomplete-display-matches): Autoload.
* gnus/mm-decode.el: Don't require mailcap, gnus-util.
(gnus-map-function, gnus-replace-in-string, gnus-read-shell-command)
(message-fetch-field, mailcap-parse-mailcaps, mailcap-mime-info):
Autoload.
(mailcap-mime-extensions): Declare.
* gnus/mm-encode.el: Don't require mailcap.
(mailcap-extension-to-mime): Autoload.
* gnus/mml-sec.el: Don't require password-cache.
* gnus/mml.el (gnus-setup-posting-charset): Declare rather than autoload.
(mailcap-parse-mimetypes, mailcap-mime-types): Declare.
(mml-minibuffer-read-type): Require mailcap.
(mml-preview): Require gnus-msg.
* gnus/mml1991.el: Require password-cache.
(password-cache-expiry): Remove declaration.
* gnus/mml2015.el: Require password-cache.
(password-cache-expiry): Remove declaration.
* gnus/nneething.el (mailcap): Require mailcap.
* gnus/nnheader.el: (declare-function): Add compatibility stub.
(message-remove-header): Declare rather than autoload.
(nnheader-replace-header): Require message.
* gnus/nnimap.el (declare-function): Add compatibility stub.
(netrc-parse, netrc-machine-user-or-password): Declare.
(nnimap-open-connection): Require netrc.
* gnus/nntp.el (declare-function): Add compatibility stub.
(netrc-parse, netrc-machine, netrc-get): Declare.
(nntp-send-authinfo): Require netrc.
* gnus/rfc2047.el: Don't require qp.
(quoted-printable-encode-region, quoted-printable-decode-string):
Autoload.
* gnus/sieve-mode.el: Don't require easymenu.
(easy-menu-add-item): Autoload it.
* gnus/spam-stat.el (time-to-number-of-days): Autoload it.
* password-cache.el (password-cache, password-cache-expiry):
Autoload.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Thu, 18 Mar 2010 19:55:37 -0700 |
parents | 1d1d5d9bd884 |
children | 2bfe0d4c1bc7 |
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, |
106815 | 4 ;; 2005, 2006, 2007, 2008, 2009, 2010 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 'mm-bodies) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
33 (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
|
34 (require 'term)) |
31717 | 35 |
107427
ecbe0edc4f69
Stop message.el from loading about 40 libraries it doesn't always need.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
36 (autoload 'gnus-map-function "gnus-util") |
ecbe0edc4f69
Stop message.el from loading about 40 libraries it doesn't always need.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
37 (autoload 'gnus-replace-in-string "gnus-util") |
ecbe0edc4f69
Stop message.el from loading about 40 libraries it doesn't always need.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
38 (autoload 'gnus-read-shell-command "gnus-util") |
ecbe0edc4f69
Stop message.el from loading about 40 libraries it doesn't always need.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
39 |
95814 | 40 (autoload 'mm-inline-partial "mm-partial") |
41 (autoload 'mm-inline-external-body "mm-extern") | |
42 (autoload 'mm-extern-cache-contents "mm-extern") | |
43 (autoload 'mm-insert-inline "mm-view") | |
31717 | 44 |
65275
285f667dc098
(gnus-current-window-configuration): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents:
64754
diff
changeset
|
45 (defvar gnus-current-window-configuration) |
285f667dc098
(gnus-current-window-configuration): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents:
64754
diff
changeset
|
46 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
47 (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
|
48 |
31717 | 49 (defgroup mime-display () |
50 "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
|
51 :link '(custom-manual "(emacs-mime)Display Customization") |
31717 | 52 :version "21.1" |
53 :group 'mail | |
54 :group 'news | |
55 :group 'multimedia) | |
56 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
57 (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
|
58 "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
|
59 :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
|
60 :group 'mail |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
61 :group 'news |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
62 :group 'multimedia) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
63 |
31717 | 64 ;;; Convenience macros. |
65 | |
66 (defmacro mm-handle-buffer (handle) | |
67 `(nth 0 ,handle)) | |
68 (defmacro mm-handle-type (handle) | |
69 `(nth 1 ,handle)) | |
70 (defsubst mm-handle-media-type (handle) | |
71 (if (stringp (car handle)) | |
72 (car handle) | |
73 (car (mm-handle-type handle)))) | |
74 (defsubst mm-handle-media-supertype (handle) | |
75 (car (split-string (mm-handle-media-type handle) "/"))) | |
76 (defsubst mm-handle-media-subtype (handle) | |
77 (cadr (split-string (mm-handle-media-type handle) "/"))) | |
78 (defmacro mm-handle-encoding (handle) | |
79 `(nth 2 ,handle)) | |
80 (defmacro mm-handle-undisplayer (handle) | |
81 `(nth 3 ,handle)) | |
82 (defmacro mm-handle-set-undisplayer (handle function) | |
83 `(setcar (nthcdr 3 ,handle) ,function)) | |
84 (defmacro mm-handle-disposition (handle) | |
85 `(nth 4 ,handle)) | |
86 (defmacro mm-handle-description (handle) | |
87 `(nth 5 ,handle)) | |
88 (defmacro mm-handle-cache (handle) | |
89 `(nth 6 ,handle)) | |
90 (defmacro mm-handle-set-cache (handle contents) | |
91 `(setcar (nthcdr 6 ,handle) ,contents)) | |
92 (defmacro mm-handle-id (handle) | |
93 `(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
|
94 (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
|
95 `(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
|
96 (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
|
97 `(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
|
98 (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
|
99 `(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
|
100 |
31717 | 101 (defmacro mm-make-handle (&optional buffer type encoding undisplayer |
102 disposition description cache | |
103 id) | |
104 `(list ,buffer ,type ,encoding ,undisplayer | |
105 ,disposition ,description ,cache ,id)) | |
106 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
107 (defcustom mm-text-html-renderer |
92694 | 108 (cond ((executable-find "w3m") |
109 (if (locate-library "w3m") | |
110 'w3m | |
111 '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
|
112 ((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
|
113 ((executable-find "lynx") 'lynx) |
92694 | 114 ((locate-library "w3") 'w3) |
115 ((locate-library "html2text") 'html2text) | |
116 (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
|
117 "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
|
118 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
|
119 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
|
120 `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
|
121 `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
|
122 `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
|
123 `lynx' : use lynx; |
92694 | 124 `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
|
125 `html2text' : use html2text; |
92694 | 126 nil : use external viewer (default web browser)." |
127 :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
|
128 :type '(choice (const w3) |
92694 | 129 (const w3m :tag "emacs-w3m") |
130 (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
|
131 (const links) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
132 (const lynx) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
133 (const html2text) |
92694 | 134 (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
|
135 (function)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
136 :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
|
137 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
138 (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
|
139 "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
|
140 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
|
141 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
142 (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
|
143 "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
|
144 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
|
145 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
|
146 :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
|
147 :type 'boolean |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
148 :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
|
149 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
150 (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
|
151 "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
|
152 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
|
153 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
|
154 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
|
155 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
|
156 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
|
157 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
|
158 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
|
159 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
|
160 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
|
161 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
|
162 :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
|
163 :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
|
164 (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
|
165 :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
|
166 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
167 (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
|
168 "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
|
169 :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
|
170 :type 'boolean |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
171 :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
|
172 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
173 (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
|
174 "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
|
175 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
176 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
|
177 `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
|
178 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
|
179 :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
|
180 :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
|
181 (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
|
182 (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
|
183 :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
|
184 |
31717 | 185 (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
|
186 '(("image/p?jpeg" |
31717 | 187 mm-inline-image |
188 (lambda (handle) | |
189 (mm-valid-and-fit-image-p 'jpeg handle))) | |
190 ("image/png" | |
191 mm-inline-image | |
192 (lambda (handle) | |
193 (mm-valid-and-fit-image-p 'png handle))) | |
194 ("image/gif" | |
195 mm-inline-image | |
196 (lambda (handle) | |
197 (mm-valid-and-fit-image-p 'gif handle))) | |
198 ("image/tiff" | |
199 mm-inline-image | |
200 (lambda (handle) | |
201 (mm-valid-and-fit-image-p 'tiff handle)) ) | |
202 ("image/xbm" | |
203 mm-inline-image | |
204 (lambda (handle) | |
205 (mm-valid-and-fit-image-p 'xbm handle))) | |
206 ("image/x-xbitmap" | |
207 mm-inline-image | |
208 (lambda (handle) | |
209 (mm-valid-and-fit-image-p 'xbm handle))) | |
210 ("image/xpm" | |
211 mm-inline-image | |
212 (lambda (handle) | |
213 (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
|
214 ("image/x-xpixmap" |
31717 | 215 mm-inline-image |
216 (lambda (handle) | |
217 (mm-valid-and-fit-image-p 'xpm handle))) | |
218 ("image/bmp" | |
219 mm-inline-image | |
220 (lambda (handle) | |
221 (mm-valid-and-fit-image-p 'bmp handle))) | |
35048 | 222 ("image/x-portable-bitmap" |
223 mm-inline-image | |
224 (lambda (handle) | |
225 (mm-valid-and-fit-image-p 'pbm handle))) | |
31717 | 226 ("text/plain" mm-inline-text identity) |
227 ("text/enriched" mm-inline-text identity) | |
228 ("text/richtext" mm-inline-text identity) | |
229 ("text/x-patch" mm-display-patch-inline | |
230 (lambda (handle) | |
65767
1b9137e0ecc1
(mm-inline-media-tests): Check presence of the diff-mode
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65719
diff
changeset
|
231 ;; 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
|
232 ;; 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
|
233 ;; 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
|
234 ;; 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
|
235 ;; 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
|
236 (fboundp 'diff-mode))) |
93723
2da1f95ea11c
(mm-inline-media-tests): Add entry for x-diff.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93107
diff
changeset
|
237 ;; 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
|
238 ("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
|
239 (lambda (handle) (fboundp 'diff-mode))) |
31764 | 240 ("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
|
241 ("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
|
242 ("text/dns" mm-display-dns-inline identity) |
31717 | 243 ("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
|
244 mm-inline-text-html |
31717 | 245 (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
|
246 (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
|
247 mm-text-html-renderer))) |
31717 | 248 ("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
|
249 mm-inline-text-vcard |
31717 | 250 (lambda (handle) |
251 (or (featurep 'vcard) | |
252 (locate-library "vcard")))) | |
253 ("message/delivery-status" mm-inline-text identity) | |
254 ("message/rfc822" mm-inline-message identity) | |
255 ("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
|
256 ("message/external-body" mm-inline-external-body identity) |
31717 | 257 ("text/.*" mm-inline-text identity) |
258 ("audio/wav" mm-inline-audio | |
259 (lambda (handle) | |
260 (and (or (featurep 'nas-sound) (featurep 'native-sound)) | |
261 (device-sound-enabled-p)))) | |
262 ("audio/au" | |
263 mm-inline-audio | |
264 (lambda (handle) | |
265 (and (or (featurep 'nas-sound) (featurep 'native-sound)) | |
266 (device-sound-enabled-p)))) | |
267 ("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
|
268 ("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
|
269 ("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
|
270 ("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
|
271 ("application/pkcs7-mime" ignore identity) |
31717 | 272 ("multipart/alternative" ignore identity) |
273 ("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
|
274 ("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
|
275 ;; 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
|
276 ("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
|
277 ("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
|
278 ;; 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
|
279 (".*" mm-inline-text mm-readable-p)) |
31717 | 280 "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
|
281 :type '(repeat (list (regexp :tag "MIME type") |
31717 | 282 (function :tag "Display function") |
283 (function :tag "Display test"))) | |
284 :group 'mime-display) | |
285 | |
286 (defcustom mm-inlined-types | |
287 '("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
|
288 "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
|
289 "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
|
290 "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
|
291 "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
|
292 "application/pkcs7-mime" |
dbc43cabc13b
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-5
Miles Bader <miles@gnu.org>
parents:
67643
diff
changeset
|
293 ;; 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
|
294 "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
|
295 "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
|
296 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
|
297 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
|
298 :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
|
299 :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
|
300 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
301 (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
|
302 '("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
|
303 "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
|
304 "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
|
305 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
|
306 :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
|
307 :type '(repeat regexp) |
31717 | 308 :group 'mime-display) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44075
diff
changeset
|
309 |
31717 | 310 (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
|
311 '("text/plain" "text/enriched" "text/richtext" "text/html" "text/x-verbatim" |
31717 | 312 "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
|
313 "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
|
314 "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
|
315 "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
|
316 "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
|
317 "application/pkcs7-mime" |
dbc43cabc13b
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-5
Miles Bader <miles@gnu.org>
parents:
67643
diff
changeset
|
318 ;; 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
|
319 "application/pgp\\'") |
31717 | 320 "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
|
321 :type '(repeat regexp) |
31717 | 322 :group 'mime-display) |
323 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
324 (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
|
325 "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
|
326 "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
|
327 "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
|
328 "application/x-pkcs7-signature") |
31717 | 329 "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
|
330 :type '(repeat regexp) |
31717 | 331 :group 'mime-display) |
332 | |
333 (defcustom mm-inline-override-types nil | |
334 "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
|
335 :type '(repeat regexp) |
31717 | 336 :group 'mime-display) |
337 | |
338 (defcustom mm-automatic-external-display nil | |
339 "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
|
340 :type '(repeat regexp) |
31717 | 341 :group 'mime-display) |
342 | |
343 (defcustom mm-discouraged-alternatives nil | |
344 "List of MIME types that are discouraged when viewing multipart/alternative. | |
345 Viewing agents are supposed to view the last possible part of a message, | |
346 as that is supposed to be the richest. However, users may prefer other | |
347 types instead, and this list says what types are most unwanted. If, | |
348 for instance, text/html parts are very unwanted, and text/richtext are | |
349 somewhat unwanted, then the value of this variable should be set | |
350 to: | |
351 | |
67418
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
352 (\"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
|
353 |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
354 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
|
355 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
|
356 `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
|
357 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
|
358 :type '(repeat regexp) ;; See `mm-preferred-alternative-precedence'. |
31717 | 359 :group 'mime-display) |
360 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
361 (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
|
362 (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
|
363 (temp-directory) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
364 (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
|
365 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
|
366 "/tmp/")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
367 "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
|
368 :type 'directory |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
369 :group 'mime-display) |
31717 | 370 |
371 (defcustom mm-inline-large-images nil | |
372 "If non-nil, then all images fit in the buffer." | |
373 :type 'boolean | |
374 :group 'mime-display) | |
375 | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
376 (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
|
377 '(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
|
378 "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
|
379 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
|
380 |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
381 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
|
382 `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
|
383 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
|
384 `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
|
385 `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
|
386 `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
|
387 :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
|
388 (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
|
389 (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
|
390 (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
|
391 (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
|
392 (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
|
393 (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
|
394 (const capitalize) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
395 (const downcase) |
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) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
397 (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
|
398 (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
|
399 :tag "Function" |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
400 function))) |
92336
5f827896103e
Change defcustom :version from 23.0 to 23.1.
Glenn Morris <rgm@gnu.org>
parents:
87928
diff
changeset
|
401 :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
|
402 :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
|
403 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
404 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
405 (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
|
406 "*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
|
407 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
|
408 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
|
409 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
|
410 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
411 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
|
412 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
413 (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
|
414 "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
|
415 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
416 (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
|
417 "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
|
418 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
|
419 :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
|
420 :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
|
421 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
422 (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
|
423 "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
|
424 :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
|
425 :type 'integer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
426 :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
|
427 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
428 (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
|
429 "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
|
430 :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
|
431 :type 'string |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
432 :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
|
433 |
31717 | 434 ;;; Internal variables. |
435 | |
436 (defvar mm-last-shell-command "") | |
437 (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
|
438 (defvar mm-postponed-undisplay-list nil) |
31717 | 439 |
440 ;; According to RFC2046, in particular, in a digest, the default | |
441 ;; Content-Type value for a body part is changed from "text/plain" to | |
442 ;; "message/rfc822". | |
443 (defvar mm-dissect-default-type "text/plain") | |
444 | |
56927
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 "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 '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
|
447 (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
|
448 (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
|
449 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
450 (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
|
451 '(("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
|
452 ("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
|
453 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
|
454 ("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
|
455 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
|
456 ("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
|
457 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
|
458 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
459 (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
|
460 "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
|
461 `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
|
462 `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
|
463 |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
464 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
|
465 \"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
|
466 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
|
467 :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
|
468 :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
|
469 (item never) |
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 "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
|
471 (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
|
472 :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
|
473 |
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 "mml2015") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
475 (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
|
476 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
477 (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
|
478 '(("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
|
479 ("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
|
480 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
|
481 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
482 (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
|
483 "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
|
484 `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
|
485 `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
|
486 :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
|
487 :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
|
488 (item never) |
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 "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
|
490 (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
|
491 :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
|
492 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
493 (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
|
494 (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
|
495 (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
|
496 ;; 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
|
497 (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
|
498 map) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
499 "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
|
500 |
32962 | 501 (defvar mm-viewer-completion-map |
502 (let ((map (make-sparse-keymap 'mm-viewer-completion-map))) | |
503 (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
|
504 ;; 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
|
505 (define-key map " " 'self-insert-command) |
32962 | 506 map) |
507 "Keymap for input viewer with completion.") | |
508 | |
31717 | 509 ;;; The functions. |
510 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
511 (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
|
512 "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
|
513 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
|
514 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
515 \((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
|
516 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
517 into |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
518 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
519 \(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
|
520 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
521 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
|
522 (let (plist) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
523 (while alist |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
524 (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
|
525 (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
|
526 (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
|
527 (nreverse plist))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
528 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
529 (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
|
530 "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
|
531 (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
|
532 (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
|
533 ty) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
534 (catch 'found |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
535 (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
|
536 (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
|
537 (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
|
538 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
539 (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
|
540 "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
|
541 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
|
542 `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
|
543 (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
|
544 (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
|
545 (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
|
546 (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
|
547 (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
|
548 (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
|
549 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
550 (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
|
551 (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
|
552 (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
|
553 (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
|
554 |
107427
ecbe0edc4f69
Stop message.el from loading about 40 libraries it doesn't always need.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
555 (autoload 'message-fetch-field "message") |
ecbe0edc4f69
Stop message.el from loading about 40 libraries it doesn't always need.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
556 |
60302
f34a552e4a9f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-139
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
557 (defun mm-dissect-buffer (&optional no-strict-mime loose-mime from) |
31717 | 558 "Dissect the current buffer and return a list of MIME handles." |
559 (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
|
560 (let (ct ctl type subtype cte cd description id result) |
31717 | 561 (save-restriction |
562 (mail-narrow-to-head) | |
563 (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
|
564 loose-mime |
31717 | 565 (mail-fetch-field "mime-version")) |
566 (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
|
567 ctl (and ct (mail-header-parse-content-type ct)) |
31717 | 568 cte (mail-fetch-field "content-transfer-encoding") |
569 cd (mail-fetch-field "content-disposition") | |
103570
21ddc18f8c1b
(mm-dissect-buffer): Use message-fetch-field instead of mail-fetch-field to
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
100908
diff
changeset
|
570 ;; Newlines in description should be stripped so as |
21ddc18f8c1b
(mm-dissect-buffer): Use message-fetch-field instead of mail-fetch-field to
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
100908
diff
changeset
|
571 ;; not to break the MIME tag into two or more lines. |
21ddc18f8c1b
(mm-dissect-buffer): Use message-fetch-field instead of mail-fetch-field to
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
100908
diff
changeset
|
572 description (message-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
|
573 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
|
574 (unless from |
68720
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68287
diff
changeset
|
575 (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
|
576 ;; 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
|
577 ;; 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
|
578 ;; 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
|
579 ;; 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
|
580 (if from |
87928 | 581 (setq from (cadr (mail-extract-address-components from)))) |
582 (if description | |
583 (setq description (mail-decode-encoded-word-string | |
584 description))))) | |
31717 | 585 (if (or (not ctl) |
586 (not (string-match "/" (car ctl)))) | |
587 (mm-dissect-singlepart | |
588 (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
|
589 (and cte (intern (downcase (mail-header-strip cte)))) |
31717 | 590 no-strict-mime |
68720
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68287
diff
changeset
|
591 (and cd (mail-header-parse-content-disposition cd)) |
31717 | 592 description) |
593 (setq type (split-string (car ctl) "/")) | |
594 (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
|
595 type (car type)) |
31717 | 596 (setq |
597 result | |
598 (cond | |
599 ((equal type "multipart") | |
600 (let ((mm-dissect-default-type (if (equal subtype "digest") | |
601 "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
|
602 "text/plain")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
603 (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
|
604 (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
|
605 (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
|
606 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
607 ;; 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
|
608 ;; 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
|
609 ;; 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
|
610 ;; 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
|
611 ;; 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
|
612 (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
|
613 (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
|
614 'from from |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
615 'start start) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
616 (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
|
617 (cons (car ctl) (mm-dissect-multipart ctl from)))) |
31717 | 618 (t |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
619 (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
|
620 (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
|
621 ctl |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
622 (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
|
623 no-strict-mime |
68720
d9dde5b81e71
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57
Miles Bader <miles@gnu.org>
parents:
68287
diff
changeset
|
624 (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
|
625 description id) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
626 ctl)))) |
31717 | 627 (when id |
628 (when (string-match " *<\\(.*\\)> *" id) | |
629 (setq id (match-string 1 id))) | |
630 (push (cons id result) mm-content-id-alist)) | |
631 result)))) | |
632 | |
633 (defun mm-dissect-singlepart (ctl cte &optional force cdl description id) | |
634 (when (or force | |
635 (if (equal "text/plain" (car ctl)) | |
636 (assoc 'format ctl) | |
637 t)) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
638 (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
|
639 (mm-copy-to-buffer) ctl cte nil cdl description nil id))) |
31717 | 640 |
60302
f34a552e4a9f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-139
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
641 (defun mm-dissect-multipart (ctl from) |
31717 | 642 (goto-char (point-min)) |
643 (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary))) | |
644 (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$")) | |
645 start parts | |
646 (end (save-excursion | |
647 (goto-char (point-max)) | |
648 (if (re-search-backward close-delimiter nil t) | |
649 (match-beginning 0) | |
650 (point-max))))) | |
651 (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
|
652 (while (and (< (point) end) (re-search-forward boundary end t)) |
31717 | 653 (goto-char (match-beginning 0)) |
654 (when start | |
655 (save-excursion | |
656 (save-restriction | |
657 (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
|
658 (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
|
659 (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
|
660 (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
|
661 (forward-line 1)) |
31717 | 662 (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
|
663 (when (and start (< start end)) |
31717 | 664 (save-excursion |
665 (save-restriction | |
666 (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
|
667 (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
|
668 (mm-possibly-verify-or-decrypt (nreverse parts) ctl))) |
31717 | 669 |
670 (defun mm-copy-to-buffer () | |
671 "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
|
672 (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
|
673 (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
|
674 beg) |
734bb318f69e
(mm-with-part): Set the buffer to unibyte before inserting
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92694
diff
changeset
|
675 (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
|
676 (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
|
677 (setq beg (point)) |
70377
1b78f3a87f16
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-265
Miles Bader <miles@gnu.org>
parents:
70245
diff
changeset
|
678 (with-current-buffer |
93107
3bf6293f3041
(mm-copy-to-buffer): Use mm-set-buffer-multibyte.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92769
diff
changeset
|
679 (generate-new-buffer " *mm*") |
3bf6293f3041
(mm-copy-to-buffer): Use mm-set-buffer-multibyte.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92769
diff
changeset
|
680 ;; 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
|
681 (mm-set-buffer-multibyte mb) |
31717 | 682 (insert-buffer-substring obuf beg) |
683 (current-buffer)))) | |
684 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
685 (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
|
686 (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
|
687 (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
|
688 (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
|
689 (save-restriction |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
690 (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
|
691 (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
|
692 (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
|
693 (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
|
694 |
107427
ecbe0edc4f69
Stop message.el from loading about 40 libraries it doesn't always need.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
695 (autoload 'mailcap-parse-mailcaps "mailcap") |
ecbe0edc4f69
Stop message.el from loading about 40 libraries it doesn't always need.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
696 (autoload 'mailcap-mime-info "mailcap") |
ecbe0edc4f69
Stop message.el from loading about 40 libraries it doesn't always need.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
697 |
31717 | 698 (defun mm-display-part (handle &optional no-default) |
699 "Display the MIME part represented by HANDLE. | |
700 Returns nil if the part is removed; inline if displayed inline; | |
701 external if displayed external." | |
702 (save-excursion | |
703 (mailcap-parse-mailcaps) | |
704 (if (mm-handle-displayed-p handle) | |
705 (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
|
706 (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
|
707 "message/external-body") |
d0312c3f2374
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-214
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
708 (progn |
d0312c3f2374
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-214
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
709 (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
|
710 (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
|
711 (mm-handle-cache handle)) |
d0312c3f2374
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-214
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
712 handle)) |
d0312c3f2374
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-214
Miles Bader <miles@gnu.org>
parents:
69649
diff
changeset
|
713 (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
|
714 (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
|
715 (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
|
716 (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
|
717 (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
|
718 (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
|
719 "<file>")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
720 (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
|
721 (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
|
722 (mm-inlined-p ehandle)) |
31717 | 723 (progn |
724 (forward-line 1) | |
725 (mm-display-inline handle) | |
726 'inline) | |
727 (when (or method | |
728 (not no-default)) | |
729 (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
|
730 (equal "text" (car (split-string type "/")))) |
31717 | 731 (progn |
732 (forward-line 1) | |
733 (mm-insert-inline handle (mm-get-part handle)) | |
734 'inline) | |
70377
1b78f3a87f16
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-265
Miles Bader <miles@gnu.org>
parents:
70245
diff
changeset
|
735 (setq external |
1b78f3a87f16
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-265
Miles Bader <miles@gnu.org>
parents:
70245
diff
changeset
|
736 (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
|
737 (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
|
738 (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
|
739 (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
|
740 (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
|
741 (concat |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
742 "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
|
743 ") 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
|
744 ;; 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
|
745 (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
|
746 (concat |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
747 " \"" (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
|
748 "") |
70377
1b78f3a87f16
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-265
Miles Bader <miles@gnu.org>
parents:
70245
diff
changeset
|
749 "? ")))))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
750 (if external |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
751 (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
|
752 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
|
753 (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
|
754 handle 'mailcap-save-binary-file))))))))) |
31717 | 755 |
87243
23ea76295829
Add declare-function compatibility definition.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
756 (declare-function gnus-configure-windows "gnus-win" (setting &optional force)) |
107427
ecbe0edc4f69
Stop message.el from loading about 40 libraries it doesn't always need.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
757 (defvar mailcap-mime-extensions) ; mailcap-mime-info autoloads |
87243
23ea76295829
Add declare-function compatibility definition.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
758 |
31717 | 759 (defun mm-display-external (handle method) |
760 "Display HANDLE using METHOD." | |
761 (let ((outbuf (current-buffer))) | |
762 (mm-with-unibyte-buffer | |
763 (if (functionp method) | |
764 (let ((cur (current-buffer))) | |
765 (if (eq method 'mailcap-save-binary-file) | |
766 (progn | |
33174
702845b072b7
(mm-display-external): Space prefix temp buffer
Dave Love <fx@gnu.org>
parents:
32962
diff
changeset
|
767 (set-buffer (generate-new-buffer " *mm*")) |
31717 | 768 (setq method nil)) |
769 (mm-insert-part handle) | |
87454 | 770 (mm-add-meta-html-tag handle) |
31717 | 771 (let ((win (get-buffer-window cur t))) |
772 (when win | |
773 (select-window win))) | |
33174
702845b072b7
(mm-display-external): Space prefix temp buffer
Dave Love <fx@gnu.org>
parents:
32962
diff
changeset
|
774 (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
|
775 (buffer-disable-undo) |
31717 | 776 (mm-set-buffer-file-coding-system mm-binary-coding-system) |
777 (insert-buffer-substring cur) | |
778 (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
|
779 (when method |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
780 (message "Viewing with %s" method)) |
31717 | 781 (let ((mm (current-buffer)) |
782 (non-viewer (assq 'non-viewer | |
783 (mailcap-mime-info | |
784 (mm-handle-media-type handle) t)))) | |
785 (unwind-protect | |
786 (if method | |
787 (funcall method) | |
788 (mm-save-part handle)) | |
789 (when (and (not non-viewer) | |
790 method) | |
791 (mm-handle-set-undisplayer handle mm))))) | |
792 ;; The function is a string to be executed. | |
793 (mm-insert-part handle) | |
87454 | 794 (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
|
795 (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
|
796 (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
|
797 (filename (or |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
798 (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
|
799 (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
|
800 (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
|
801 (mm-handle-type handle) 'name))) |
31717 | 802 (mime-info (mailcap-mime-info |
803 (mm-handle-media-type handle) t)) | |
804 (needsterm (or (assoc "needsterm" mime-info) | |
805 (assoc "needsterminal" mime-info))) | |
806 (copiousoutput (assoc "copiousoutput" mime-info)) | |
807 file buffer) | |
808 ;; We create a private sub-directory where we store our files. | |
94209 | 809 (set-file-modes dir #o700) |
31717 | 810 (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
|
811 (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
|
812 (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
|
813 (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
|
814 dir)) |
68940
808f636eb13e
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
815 ;; 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
|
816 ;; in mailcap. |
808f636eb13e
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
817 (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
|
818 (if (and suffix |
808f636eb13e
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
819 (string-match "\\`%s\\(\\..+\\)\\'" suffix)) |
808f636eb13e
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
820 (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
|
821 ;; 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
|
822 ;; `mailcap-mime-extensions'. |
808f636eb13e
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
823 (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
|
824 mailcap-mime-extensions)))) |
808f636eb13e
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Miles Bader <miles@gnu.org>
parents:
68720
diff
changeset
|
825 (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
|
826 nil suffix)))) |
31717 | 827 (let ((coding-system-for-write mm-binary-coding-system)) |
828 (write-region (point-min) (point-max) file nil 'nomesg)) | |
94209 | 829 ;; The file is deleted after the viewer exists. If the users edits |
830 ;; the file, changes will be lost. Set file to read-only to make it | |
831 ;; clear. | |
832 (set-file-modes file #o400) | |
31717 | 833 (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
|
834 (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
835 (needsterm |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
836 (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
|
837 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
|
838 (unwind-protect |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
839 (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
|
840 (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
|
841 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
|
842 "-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
|
843 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
|
844 (require 'term) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
845 (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
|
846 (set-buffer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
847 (setq buffer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
848 (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
|
849 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
|
850 nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
851 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
|
852 (term-mode) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
853 (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
|
854 (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
|
855 (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
|
856 `(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
|
857 (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
|
858 (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
|
859 ',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
|
860 (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
|
861 (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
|
862 (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
|
863 'external) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
864 (copiousoutput |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
865 (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
|
866 (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
|
867 (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
|
868 handle |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
869 (unwind-protect |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
870 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
871 (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
|
872 (setq buffer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
873 (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
|
874 nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
875 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
|
876 (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
|
877 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
|
878 (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
|
879 (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
|
880 (buffer-string)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
881 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
882 (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
|
883 (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
|
884 (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
|
885 (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
|
886 'inline) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
887 (t |
67418
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
888 ;; 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
|
889 ;; 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
|
890 ;; 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
|
891 (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
|
892 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
|
893 (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
|
894 (progn |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
895 (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
|
896 (setq buffer |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
897 (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
|
898 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
|
899 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
|
900 (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
|
901 (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
|
902 (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
|
903 ;; 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
|
904 ((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
|
905 ;; 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
|
906 (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
|
907 (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
|
908 (error)) |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
909 (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
|
910 (delete-directory |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
911 ,(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
|
912 (error)))) |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
913 ;; 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
|
914 ;; 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
|
915 (fm `(progn |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
916 (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
|
917 ,(macroexpand |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
918 (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
|
919 (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
|
920 nil)))) |
28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Miles Bader <miles@gnu.org>
parents:
65767
diff
changeset
|
921 ;; 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
|
922 (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
|
923 ;; 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
|
924 ;; 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
|
925 ;; 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
|
926 (timer (run-at-time 2.0 nil 'ignore))) |
86154 | 927 (if (featurep 'xemacs) |
75149 | 928 (lambda (process state) |
929 (when (eq 'exit (process-status process)) | |
930 (if (memq timer itimer-list) | |
931 (set-itimer-function timer fn) | |
932 (funcall fn)) | |
933 (ignore-errors (eval fm)) | |
934 (message "%s" done))) | |
935 (lambda (process state) | |
936 (when (eq 'exit (process-status process)) | |
937 (if (memq timer timer-list) | |
938 (timer-set-function timer fn) | |
939 (funcall fn)) | |
940 (ignore-errors (eval fm)) | |
941 (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
|
942 (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
|
943 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
|
944 (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
|
945 'external))))))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44075
diff
changeset
|
946 |
31717 | 947 (defun mm-mailcap-command (method file type-list) |
948 (let ((ctl (cdr type-list)) | |
949 (beg 0) | |
950 (uses-stdin t) | |
951 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
|
952 (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
|
953 method beg) |
31717 | 954 (push (substring method beg (match-beginning 0)) out) |
955 (setq beg (match-end 0) | |
956 total (match-string 0 method) | |
957 sub (match-string 1 method)) | |
958 (cond | |
959 ((string= total "%%") | |
960 (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
|
961 ((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
|
962 ;; 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
|
963 (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
|
964 (string= total "\"%s\"")) |
31717 | 965 (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
|
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)) out)) |
31717 | 968 ((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
|
969 (push (shell-quote-argument (car type-list)) out)) |
31717 | 970 (t |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
971 (push (shell-quote-argument (or (cdr (assq (intern sub) ctl)) "")) out)))) |
31717 | 972 (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
|
973 (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
|
974 (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
|
975 (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
|
976 (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
|
977 out)) |
31717 | 978 (mapconcat 'identity (nreverse out) ""))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44075
diff
changeset
|
979 |
31717 | 980 (defun mm-remove-parts (handles) |
981 "Remove the displayed MIME parts represented by HANDLES." | |
982 (if (and (listp handles) | |
983 (bufferp (car handles))) | |
984 (mm-remove-part handles) | |
985 (let (handle) | |
986 (while (setq handle (pop handles)) | |
987 (cond | |
988 ((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
|
989 (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
|
990 (kill-buffer (get-text-property 0 'buffer handle)))) |
31717 | 991 ((and (listp handle) |
992 (stringp (car handle))) | |
993 (mm-remove-parts (cdr handle))) | |
994 (t | |
995 (mm-remove-part handle))))))) | |
996 | |
997 (defun mm-destroy-parts (handles) | |
998 "Remove the displayed MIME parts represented by HANDLES." | |
999 (if (and (listp handles) | |
1000 (bufferp (car handles))) | |
1001 (mm-destroy-part handles) | |
1002 (let (handle) | |
1003 (while (setq handle (pop handles)) | |
1004 (cond | |
1005 ((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
|
1006 (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
|
1007 (kill-buffer (get-text-property 0 'buffer handle)))) |
31717 | 1008 ((and (listp handle) |
1009 (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
|
1010 (mm-destroy-parts handle)) |
31717 | 1011 (t |
1012 (mm-destroy-part handle))))))) | |
1013 | |
1014 (defun mm-remove-part (handle) | |
1015 "Remove the displayed MIME part represented by HANDLE." | |
1016 (when (listp handle) | |
1017 (let ((object (mm-handle-undisplayer handle))) | |
1018 (ignore-errors | |
1019 (cond | |
1020 ;; Internally displayed part. | |
1021 ((mm-annotationp object) | |
87243
23ea76295829
Add declare-function compatibility definition.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
1022 (if (featurep 'xemacs) |
23ea76295829
Add declare-function compatibility definition.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
1023 (delete-annotation object))) |
31717 | 1024 ((or (functionp object) |
1025 (and (listp object) | |
1026 (eq (car object) 'lambda))) | |
1027 (funcall object)) | |
1028 ;; Externally displayed part. | |
1029 ((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
|
1030 (condition-case () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1031 (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
|
1032 (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
|
1033 (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
|
1034 (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
|
1035 (quit) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1036 (error)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1037 (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
|
1038 (message "Waiting for external displayer to die...done") |
31717 | 1039 (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
|
1040 (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
|
1041 (car object))))) |
31717 | 1042 ((bufferp object) |
1043 (when (buffer-live-p object) | |
1044 (kill-buffer object))))) | |
1045 (mm-handle-set-undisplayer handle nil)))) | |
1046 | |
1047 (defun mm-display-inline (handle) | |
1048 (let* ((type (mm-handle-media-type handle)) | |
1049 (function (cadr (mm-assoc-string-match mm-inline-media-tests type)))) | |
1050 (funcall function handle) | |
1051 (goto-char (point-min)))) | |
1052 | |
1053 (defun mm-assoc-string-match (alist type) | |
1054 (dolist (elem alist) | |
1055 (when (string-match (car elem) type) | |
1056 (return elem)))) | |
1057 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1058 (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
|
1059 "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
|
1060 (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
|
1061 (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
|
1062 method result) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1063 (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
|
1064 (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
|
1065 (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
|
1066 (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
|
1067 methods nil))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1068 result)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1069 |
70377
1b78f3a87f16
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-265
Miles Bader <miles@gnu.org>
parents:
70245
diff
changeset
|
1070 (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
|
1071 "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
|
1072 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
|
1073 in HANDLE." |
1b78f3a87f16
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-265
Miles Bader <miles@gnu.org>
parents:
70245
diff
changeset
|
1074 (unless type (setq type (mm-handle-media-type handle))) |
31717 | 1075 (let ((alist mm-inline-media-tests) |
1076 test) | |
1077 (while alist | |
1078 (when (string-match (caar alist) type) | |
1079 (setq test (caddar alist) | |
1080 alist nil) | |
1081 (setq test (funcall test handle))) | |
1082 (pop alist)) | |
1083 test)) | |
1084 | |
1085 (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
|
1086 "Say whether the user wants HANDLE to be displayed inline." |
31717 | 1087 (let ((methods mm-inlined-types) |
1088 (type (mm-handle-media-type handle)) | |
1089 method result) | |
1090 (while (setq method (pop methods)) | |
1091 (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
|
1092 (string-match method type)) |
31717 | 1093 (setq result t |
1094 methods nil))) | |
1095 result)) | |
1096 | |
1097 (defun mm-attachment-override-p (handle) | |
1098 "Say whether HANDLE should have attachment behavior overridden." | |
1099 (let ((types mm-attachment-override-types) | |
1100 (type (mm-handle-media-type handle)) | |
1101 ty) | |
1102 (catch 'found | |
1103 (while (setq ty (pop types)) | |
1104 (when (and (string-match ty type) | |
1105 (mm-inlinable-p handle)) | |
1106 (throw 'found t)))))) | |
1107 | |
1108 (defun mm-inline-override-p (handle) | |
1109 "Say whether HANDLE should have inline behavior overridden." | |
1110 (let ((types mm-inline-override-types) | |
1111 (type (mm-handle-media-type handle)) | |
1112 ty) | |
1113 (catch 'found | |
1114 (while (setq ty (pop types)) | |
1115 (when (string-match ty type) | |
1116 (throw 'found t)))))) | |
1117 | |
1118 (defun mm-automatic-external-display-p (type) | |
1119 "Return the user-defined method for TYPE." | |
1120 (let ((methods mm-automatic-external-display) | |
1121 method result) | |
1122 (while (setq method (pop methods)) | |
1123 (when (string-match method type) | |
1124 (setq result t | |
1125 methods nil))) | |
1126 result)) | |
1127 | |
1128 (defun mm-destroy-part (handle) | |
1129 "Destroy the data structures connected to HANDLE." | |
1130 (when (listp handle) | |
1131 (mm-remove-part handle) | |
1132 (when (buffer-live-p (mm-handle-buffer handle)) | |
1133 (kill-buffer (mm-handle-buffer handle))))) | |
1134 | |
1135 (defun mm-handle-displayed-p (handle) | |
1136 "Say whether HANDLE is displayed or not." | |
1137 (mm-handle-undisplayer handle)) | |
1138 | |
1139 ;;; | |
1140 ;;; Functions for outputting parts | |
1141 ;;; | |
1142 | |
69572
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1143 (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
|
1144 "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
|
1145 ;; 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
|
1146 ;; 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
|
1147 ;; 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
|
1148 ;; 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
|
1149 ;; be unibyte. |
734bb318f69e
(mm-with-part): Set the buffer to unibyte before inserting
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92694
diff
changeset
|
1150 `(let* ((handle ,handle)) |
69572
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1151 (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
|
1152 (mm-disable-multibyte) |
69572
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1153 (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
|
1154 (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
|
1155 (mm-handle-encoding handle) |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1156 (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
|
1157 ,@forms))) |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1158 (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
|
1159 (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
|
1160 |
69649
ab0b847baba4
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-176
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1161 (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
|
1162 "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
|
1163 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
|
1164 are ignored." |
ab0b847baba4
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-176
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1165 (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
|
1166 (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
|
1167 (progn |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1168 (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
|
1169 (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
|
1170 (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
|
1171 (buffer-string))) |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1172 (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
|
1173 (buffer-string)))) |
31717 | 1174 |
69649
ab0b847baba4
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-176
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1175 (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
|
1176 "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
|
1177 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
|
1178 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
|
1179 (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
|
1180 'charset) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1181 'gnus-decoded) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1182 (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
|
1183 (buffer-string))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1184 ((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
|
1185 (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
|
1186 (t |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1187 (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
|
1188 (save-restriction |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1189 (widen) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1190 (goto-char |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1191 (prog1 |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1192 (point) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1193 (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
|
1194 '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
|
1195 (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
|
1196 ;; 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
|
1197 (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
|
1198 (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
|
1199 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1200 (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
|
1201 "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
|
1202 (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
|
1203 (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
|
1204 file-name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1205 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1206 (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
|
1207 "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
|
1208 (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
|
1209 (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
|
1210 (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
|
1211 (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
|
1212 file-name) |
31717 | 1213 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1214 (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
|
1215 "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
|
1216 (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
|
1217 (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
|
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-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
|
1221 "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
|
1222 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
|
1223 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
|
1224 (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
|
1225 (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
|
1226 (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
|
1227 file-name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1228 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1229 (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
|
1230 "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
|
1231 (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
|
1232 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1233 (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
|
1234 "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
|
1235 (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
|
1236 (gnus-replace-in-string filename "^[.-]+" "")) |
31717 | 1237 |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1238 (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
|
1239 "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
|
1240 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
|
1241 (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
|
1242 (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
|
1243 (mail-content-type-get |
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69247
diff
changeset
|
1244 (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
|
1245 file) |
31717 | 1246 (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
|
1247 (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
|
1248 (file-name-nondirectory filename)))) |
31717 | 1249 (setq file |
93723
2da1f95ea11c
(mm-inline-media-tests): Add entry for x-diff.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93107
diff
changeset
|
1250 (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
|
1251 (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
|
1252 nil nil (or filename ""))) |
31717 | 1253 (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
|
1254 (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
|
1255 (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
|
1256 file))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1257 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1258 (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
|
1259 file)))) |
31717 | 1260 |
87300 | 1261 (defun mm-add-meta-html-tag (handle &optional charset) |
1262 "Add meta html tag to specify CHARSET of HANDLE in the current buffer. | |
1263 CHARSET defaults to the one HANDLE specifies. Existing meta tag that | |
1264 specifies charset will not be modified. Return t if meta tag is added | |
1265 or replaced." | |
1266 (when (equal (mm-handle-media-type handle) "text/html") | |
1267 (when (or charset | |
1268 (setq charset (mail-content-type-get (mm-handle-type handle) | |
1269 'charset))) | |
1270 (setq charset (format "\ | |
1271 <meta http-equiv=\"Content-Type\" content=\"text/html; charset=%s\">" charset)) | |
1272 (let ((case-fold-search t)) | |
1273 (goto-char (point-min)) | |
1274 (if (re-search-forward "\ | |
1275 <meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']\ | |
1276 text/\\(\\sw+\\)\\(?:\;\\s-*charset=\\(.+?\\)\\)?[\"'][^>]*>" nil t) | |
1277 (if (and (match-beginning 2) | |
1278 (string-match "\\`html\\'" (match-string 1))) | |
1279 ;; Don't modify existing meta tag. | |
1280 nil | |
1281 ;; Replace it with the one specifying charset. | |
1282 (replace-match charset) | |
1283 t) | |
1284 (if (re-search-forward "<head>\\s-*" nil t) | |
1285 (insert charset "\n") | |
1286 (re-search-forward "<html\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t) | |
1287 (insert "<head>\n" charset "\n</head>\n")) | |
1288 t))))) | |
1289 | |
31717 | 1290 (defun mm-save-part-to-file (handle file) |
1291 (mm-with-unibyte-buffer | |
1292 (mm-insert-part handle) | |
87300 | 1293 (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
|
1294 (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
|
1295 (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
|
1296 (unwind-protect |
31717 | 1297 ;; Don't re-compress .gz & al. Arguably we should make |
1298 ;; `file-name-handler-alist' nil, but that would chop | |
1299 ;; 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
|
1300 (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
|
1301 (set-default-file-modes current-file-modes))))) |
31717 | 1302 |
1303 (defun mm-pipe-part (handle) | |
1304 "Pipe HANDLE to a process." | |
1305 (let* ((name (mail-content-type-get (mm-handle-type handle) 'name)) | |
1306 (command | |
95586
64da3838a9aa
* gnus-util.el (gnus-read-shell-command): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
1307 (gnus-read-shell-command |
64da3838a9aa
* gnus-util.el (gnus-read-shell-command): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
1308 "Shell command on MIME part: " mm-last-shell-command))) |
31717 | 1309 (mm-with-unibyte-buffer |
1310 (mm-insert-part handle) | |
87300 | 1311 (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
|
1312 (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
|
1313 (shell-command-on-region (point-min) (point-max) command nil))))) |
31717 | 1314 |
1315 (defun mm-interactively-view-part (handle) | |
1316 "Display HANDLE using METHOD." | |
1317 (let* ((type (mm-handle-media-type handle)) | |
1318 (methods | |
1319 (mapcar (lambda (i) (list (cdr (assoc 'viewer i)))) | |
1320 (mailcap-mime-info type 'all))) | |
32962 | 1321 (method (let ((minibuffer-local-completion-map |
1322 mm-viewer-completion-map)) | |
1323 (completing-read "Viewer: " methods)))) | |
31717 | 1324 (when (string= method "") |
1325 (error "No method given")) | |
35048 | 1326 (if (string-match "^[^% \t]+$" method) |
31717 | 1327 (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
|
1328 (mm-display-external handle method))) |
31717 | 1329 |
1330 (defun mm-preferred-alternative (handles &optional preferred) | |
1331 "Say which of HANDLES are preferred." | |
1332 (let ((prec (if preferred (list preferred) | |
1333 (mm-preferred-alternative-precedence handles))) | |
1334 p h result type handle) | |
1335 (while (setq p (pop prec)) | |
1336 (setq h handles) | |
1337 (while h | |
1338 (setq handle (car h)) | |
1339 (setq type (mm-handle-media-type handle)) | |
1340 (when (and (equal p type) | |
1341 (mm-automatic-display-p handle) | |
1342 (or (stringp (car handle)) | |
1343 (not (mm-handle-disposition handle)) | |
1344 (equal (car (mm-handle-disposition handle)) | |
1345 "inline"))) | |
1346 (setq result handle | |
1347 h nil | |
1348 prec nil)) | |
1349 (pop h))) | |
1350 result)) | |
1351 | |
1352 (defun mm-preferred-alternative-precedence (handles) | |
1353 "Return the precedence based on HANDLES and `mm-discouraged-alternatives'." | |
1354 (let ((seq (nreverse (mapcar #'mm-handle-media-type | |
1355 handles)))) | |
1356 (dolist (disc (reverse mm-discouraged-alternatives)) | |
1357 (dolist (elem (copy-sequence seq)) | |
1358 (when (string-match disc elem) | |
1359 (setq seq (nconc (delete elem seq) (list elem)))))) | |
1360 seq)) | |
1361 | |
1362 (defun mm-get-content-id (id) | |
1363 "Return the handle(s) referred to by ID." | |
1364 (cdr (assoc id mm-content-id-alist))) | |
1365 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1366 (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
|
1367 '(("/\\*.*XPM.\\*/" . xpm) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1368 ("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
|
1369 ("GIF8" . gif) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1370 ("\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
|
1371 ("\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
|
1372 ("#define" . xbm) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1373 ("\\(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
|
1374 ("%!PS" . postscript)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1375 "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
|
1376 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
|
1377 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
|
1378 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1379 ;; 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
|
1380 (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
|
1381 "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
|
1382 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
|
1383 be determined." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1384 (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
|
1385 type) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1386 (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
|
1387 (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
|
1388 (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
|
1389 (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
|
1390 (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
|
1391 (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
|
1392 (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
|
1393 type)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1394 |
31717 | 1395 (defun mm-get-image (handle) |
1396 "Return an image instance based on HANDLE." | |
1397 (let ((type (mm-handle-media-subtype handle)) | |
1398 spec) | |
1399 ;; Allow some common translations. | |
1400 (setq type | |
1401 (cond | |
1402 ((equal type "x-pixmap") | |
1403 "xpm") | |
1404 ((equal type "x-xbitmap") | |
1405 "xbm") | |
35048 | 1406 ((equal type "x-portable-bitmap") |
1407 "pbm") | |
31717 | 1408 (t type))) |
1409 (or (mm-handle-cache handle) | |
1410 (mm-with-unibyte-buffer | |
1411 (mm-insert-part handle) | |
1412 (prog1 | |
1413 (setq spec | |
1414 (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
|
1415 ;; 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
|
1416 ;; a bogus version of it. |
31717 | 1417 (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
|
1418 (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
|
1419 (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
|
1420 (intern type)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1421 'data-p) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1422 (mm-create-image-xemacs type)))) |
31717 | 1423 (mm-handle-set-cache handle spec)))))) |
1424 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1425 (defun mm-create-image-xemacs (type) |
86154 | 1426 (when (featurep 'xemacs) |
1427 (cond | |
1428 ((equal type "xbm") | |
1429 ;; xbm images require special handling, since | |
1430 ;; the only way to create glyphs from these | |
1431 ;; (without a ton of work) is to write them | |
1432 ;; out to a file, and then create a file | |
1433 ;; specifier. | |
1434 (let ((file (mm-make-temp-file | |
1435 (expand-file-name "emm" mm-tmp-directory) | |
1436 nil ".xbm"))) | |
1437 (unwind-protect | |
1438 (progn | |
1439 (write-region (point-min) (point-max) file) | |
1440 (make-glyph (list (cons 'x file)))) | |
1441 (ignore-errors | |
1442 (delete-file file))))) | |
1443 (t | |
1444 (make-glyph | |
1445 (vector | |
1446 (or (mm-image-type-from-buffer) | |
1447 (intern type)) | |
1448 :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
|
1449 |
95814 | 1450 (declare-function image-size "image.c" (spec &optional pixels frame)) |
1451 | |
31717 | 1452 (defun mm-image-fit-p (handle) |
1453 "Say whether the image in HANDLE will fit the current window." | |
1454 (let ((image (mm-get-image handle))) | |
78006 | 1455 (or (not image) |
86154 | 1456 (if (featurep 'xemacs) |
78006 | 1457 ;; XEmacs' glyphs can actually tell us about their width, so |
1458 ;; lets be nice and smart about them. | |
1459 (or mm-inline-large-images | |
1460 (and (<= (glyph-width image) (window-pixel-width)) | |
1461 (<= (glyph-height image) (window-pixel-height)))) | |
1462 (let* ((size (image-size image)) | |
1463 (w (car size)) | |
1464 (h (cdr size))) | |
1465 (or mm-inline-large-images | |
1466 (and (<= h (1- (window-height))) ; Don't include mode line. | |
1467 (<= w (window-width))))))))) | |
31717 | 1468 |
1469 (defun mm-valid-image-format-p (format) | |
1470 "Say whether FORMAT can be displayed natively by Emacs." | |
1471 (cond | |
1472 ;; Handle XEmacs | |
1473 ((fboundp 'valid-image-instantiator-format-p) | |
1474 (valid-image-instantiator-format-p format)) | |
1475 ;; Handle Emacs 21 | |
1476 ((fboundp 'image-type-available-p) | |
1477 (and (display-graphic-p) | |
1478 (image-type-available-p format))) | |
1479 ;; Nobody else can do images yet. | |
1480 (t | |
1481 nil))) | |
1482 | |
1483 (defun mm-valid-and-fit-image-p (format handle) | |
1484 "Say whether FORMAT can be displayed natively and HANDLE fits the window." | |
32962 | 1485 (and (mm-valid-image-format-p format) |
31717 | 1486 (mm-image-fit-p handle))) |
1487 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1488 (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
|
1489 "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
|
1490 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
|
1491 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
|
1492 (let (handle) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1493 (while handles |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1494 (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
|
1495 (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
|
1496 notp recursive)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1497 (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
|
1498 (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
|
1499 (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
|
1500 (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
|
1501 (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
|
1502 handles nil))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1503 (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
|
1504 handle)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1505 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1506 (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
|
1507 (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
|
1508 (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
|
1509 'boundary))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1510 (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
|
1511 start |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1512 (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
|
1513 (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
|
1514 (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
|
1515 (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
|
1516 (point-max)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1517 result) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1518 (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
|
1519 (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
|
1520 (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
|
1521 (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
|
1522 (when 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 (1- (point))) |
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 (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
|
1533 (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
|
1534 (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
|
1535 (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1536 (save-restriction |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1537 (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
|
1538 (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
|
1539 (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
|
1540 (if notp |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1541 (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
|
1542 (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
|
1543 (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
|
1544 result)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1545 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1546 (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
|
1547 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1548 (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
|
1549 ;; 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
|
1550 (when handle |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1551 (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
|
1552 (car handle)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1553 |
87243
23ea76295829
Add declare-function compatibility definition.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
1554 (autoload 'mm-view-pkcs7 "mm-view") |
23ea76295829
Add declare-function compatibility definition.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
1555 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1556 (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
|
1557 (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
|
1558 (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
|
1559 (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
|
1560 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
|
1561 (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1562 ((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
|
1563 (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
|
1564 (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
|
1565 (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
|
1566 ((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
|
1567 ((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
|
1568 ((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
|
1569 (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
|
1570 (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
|
1571 (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
|
1572 (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
|
1573 ((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
|
1574 (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
|
1575 (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
|
1576 (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
|
1577 ;; 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
|
1578 (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
|
1579 (while protocols |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1580 (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
|
1581 (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
|
1582 (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
|
1583 (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
|
1584 protocols nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1585 (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
|
1586 (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
|
1587 (when (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1588 ((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
|
1589 ((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
|
1590 ((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
|
1591 (and func |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1592 (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
|
1593 (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
|
1594 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
|
1595 (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
|
1596 (t |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1597 (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
|
1598 (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
|
1599 (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
|
1600 (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
|
1601 (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1602 (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
|
1603 (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
|
1604 (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
|
1605 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
|
1606 (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
|
1607 ((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
|
1608 (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
|
1609 (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
|
1610 ;; 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
|
1611 (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
|
1612 (while parts |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1613 (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
|
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 (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
|
1616 parts nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1617 (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
|
1618 (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
|
1619 (when (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1620 ((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
|
1621 ((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
|
1622 ((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
|
1623 (and func |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1624 (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
|
1625 (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
|
1626 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
|
1627 (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
|
1628 (t |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1629 (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
|
1630 (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
|
1631 (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
|
1632 (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
|
1633 (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1634 (if func |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1635 (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
|
1636 (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
|
1637 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
|
1638 (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
|
1639 (t nil)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1640 parts)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1641 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1642 (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
|
1643 (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
|
1644 (> (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
|
1645 (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
|
1646 (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
|
1647 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1648 (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
|
1649 (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
|
1650 (> (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
|
1651 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1652 (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
|
1653 (append |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1654 (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
|
1655 handles1 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1656 (list handles1)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1657 (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
|
1658 handles2 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1659 (list handles2)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1660 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1661 (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
|
1662 "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
|
1663 (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
|
1664 (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
|
1665 (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
|
1666 (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
|
1667 (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
|
1668 (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
|
1669 |
31717 | 1670 (provide 'mm-decode) |
1671 | |
57173
353df9943a65
(mm-copy-to-buffer): Preserve the data's unibyteness.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57153
diff
changeset
|
1672 ;; arch-tag: 4f35d360-56b8-4030-9388-3ed82d359b9b |
31717 | 1673 ;;; mm-decode.el ends here |