Mercurial > emacs
annotate lisp/gnus/mm-decode.el @ 65719:5265a4059126
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-564
Merge from gnus--rel--5.10
Patches applied:
* gnus--rel--5.10 (patch 125-127)
- Merge from emacs--cvs-trunk--0
- Update from CVS
2005-09-27 Reiner Steib <Reiner.Steib@gmx.de>
* lisp/gnus/mm-uu.el (mm-uu-emacs-sources-regexp): Make variable
customizable. Change default value.
(mm-uu-diff-groups-regexp): Change default value.
(mm-uu-type-alist): Added doc string.
(mm-uu-configure): Added doc string. Make it interactive.
(mm-uu-diff-groups-regexp): Fix missing quotes from previous
commit.
2005-09-27 Simon Josefsson <jas@extundo.com>
* lisp/gnus/message.el (message-idna-to-ascii-rhs-1): Reformat.
2005-09-27 Arne J,Ax(Brgensen <arne@arnested.dk>
* lisp/gnus/message.el (message-remove-duplicates): New function.
Implementation borrowed from `gnus-remove-duplicates'.
(message-idna-to-ascii-rhs): Also encode idna addresses in
Reply-To:, Mail-Reply-To: and Mail-Followup-To:.
(message-idna-to-ascii-rhs-1): When `message-use-idna' is 'ask
only ask about the same idna domain once per header and also tell
in what header to replace the idna domain.
* lisp/gnus/gnus-art.el (article-decode-idna-rhs): Also decode idna
addresses in Reply-To:, Mail-Reply-To: and Mail-Followup-To:.
(article-decode-idna-rhs): Fix regexp so that all idna-address in
a header is decoded and not just the last one.
2005-09-27 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/gnus-art.el (gnus-mime-display-single): Don't modify text if it
has been decoded.
* lisp/gnus/mm-decode.el (mm-insert-part): Don't modify text if it has been
decoded.
* lisp/gnus/mm-view.el (mm-inline-text): Don't strip text props unless
decoding enriched or richtext parts.
2005-09-26 Katsumi Yamaoka <yamaoka@jpl.org>
* man/gnus.texi (Server Buffer Format): Document the %a format spec.
author | Miles Bader <miles@gnu.org> |
---|---|
date | Wed, 28 Sep 2005 05:26:02 +0000 |
parents | 285f667dc098 |
children | 1b9137e0ecc1 b1c1fc853d2f |
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, |
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64693
diff
changeset
|
4 ;; 2005 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 | |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
12 ;; the Free Software Foundation; either version 2, or (at your option) | |
13 ;; any later version. | |
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 | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
64085 | 22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
23 ;; Boston, MA 02110-1301, USA. | |
31717 | 24 |
25 ;;; Commentary: | |
26 | |
27 ;;; Code: | |
28 | |
29 (require 'mail-parse) | |
30 (require 'mailcap) | |
31 (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
|
32 (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
|
33 (require 'term)) |
31717 | 34 |
35 (eval-and-compile | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
36 (autoload 'executable-find "executable") |
33296 | 37 (autoload 'mm-inline-partial "mm-partial") |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
38 (autoload 'mm-inline-external-body "mm-extern") |
33296 | 39 (autoload 'mm-insert-inline "mm-view")) |
31717 | 40 |
65275
285f667dc098
(gnus-current-window-configuration): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents:
64754
diff
changeset
|
41 (defvar gnus-current-window-configuration) |
285f667dc098
(gnus-current-window-configuration): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents:
64754
diff
changeset
|
42 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
43 (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
|
44 |
31717 | 45 (defgroup mime-display () |
46 "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
|
47 :link '(custom-manual "(emacs-mime)Display Customization") |
31717 | 48 :version "21.1" |
49 :group 'mail | |
50 :group 'news | |
51 :group 'multimedia) | |
52 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
53 (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
|
54 "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
|
55 :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
|
56 :group 'mail |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
57 :group 'news |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
58 :group 'multimedia) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
59 |
31717 | 60 ;;; Convenience macros. |
61 | |
62 (defmacro mm-handle-buffer (handle) | |
63 `(nth 0 ,handle)) | |
64 (defmacro mm-handle-type (handle) | |
65 `(nth 1 ,handle)) | |
66 (defsubst mm-handle-media-type (handle) | |
67 (if (stringp (car handle)) | |
68 (car handle) | |
69 (car (mm-handle-type handle)))) | |
70 (defsubst mm-handle-media-supertype (handle) | |
71 (car (split-string (mm-handle-media-type handle) "/"))) | |
72 (defsubst mm-handle-media-subtype (handle) | |
73 (cadr (split-string (mm-handle-media-type handle) "/"))) | |
74 (defmacro mm-handle-encoding (handle) | |
75 `(nth 2 ,handle)) | |
76 (defmacro mm-handle-undisplayer (handle) | |
77 `(nth 3 ,handle)) | |
78 (defmacro mm-handle-set-undisplayer (handle function) | |
79 `(setcar (nthcdr 3 ,handle) ,function)) | |
80 (defmacro mm-handle-disposition (handle) | |
81 `(nth 4 ,handle)) | |
82 (defmacro mm-handle-description (handle) | |
83 `(nth 5 ,handle)) | |
84 (defmacro mm-handle-cache (handle) | |
85 `(nth 6 ,handle)) | |
86 (defmacro mm-handle-set-cache (handle contents) | |
87 `(setcar (nthcdr 6 ,handle) ,contents)) | |
88 (defmacro mm-handle-id (handle) | |
89 `(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
|
90 (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
|
91 `(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
|
92 (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
|
93 `(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
|
94 (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
|
95 `(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
|
96 |
31717 | 97 (defmacro mm-make-handle (&optional buffer type encoding undisplayer |
98 disposition description cache | |
99 id) | |
100 `(list ,buffer ,type ,encoding ,undisplayer | |
101 ,disposition ,description ,cache ,id)) | |
102 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
103 (defcustom mm-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
|
104 (cond ((locate-library "w3") 'w3) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
105 ((executable-find "w3m") (if (locate-library "w3m") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
106 'w3m |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
107 'w3m-standalone)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
108 ((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
|
109 ((executable-find "lynx") 'lynx) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
110 (t 'html2text)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
111 "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
|
112 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
|
113 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
|
114 `w3' : use Emacs/W3; |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
115 `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
|
116 `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
|
117 `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
|
118 `lynx' : use lynx; |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
119 `html2text' : use html2text; |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
120 nil : use external viewer." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
59690
diff
changeset
|
121 :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
|
122 :type '(choice (const w3) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
123 (const w3m) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
124 (const w3m-standalone) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
125 (const links) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
126 (const lynx) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
127 (const html2text) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
128 (const nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
129 (function)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
130 :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
|
131 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
132 (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
|
133 "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
|
134 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
|
135 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
136 (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
|
137 "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
|
138 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
|
139 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
|
140 :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
|
141 :type 'boolean |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
142 :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
|
143 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
144 (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
|
145 "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
|
146 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
|
147 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
|
148 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
|
149 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
|
150 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
|
151 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
|
152 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
|
153 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
|
154 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
|
155 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
|
156 :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
|
157 :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
|
158 (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
|
159 :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
|
160 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
161 (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
|
162 "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
|
163 :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
|
164 :type 'boolean |
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-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
|
168 "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
|
169 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
170 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
|
171 `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
|
172 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
|
173 :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
|
174 :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
|
175 (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
|
176 (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
|
177 :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
|
178 |
31717 | 179 (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
|
180 '(("image/p?jpeg" |
31717 | 181 mm-inline-image |
182 (lambda (handle) | |
183 (mm-valid-and-fit-image-p 'jpeg handle))) | |
184 ("image/png" | |
185 mm-inline-image | |
186 (lambda (handle) | |
187 (mm-valid-and-fit-image-p 'png handle))) | |
188 ("image/gif" | |
189 mm-inline-image | |
190 (lambda (handle) | |
191 (mm-valid-and-fit-image-p 'gif handle))) | |
192 ("image/tiff" | |
193 mm-inline-image | |
194 (lambda (handle) | |
195 (mm-valid-and-fit-image-p 'tiff handle)) ) | |
196 ("image/xbm" | |
197 mm-inline-image | |
198 (lambda (handle) | |
199 (mm-valid-and-fit-image-p 'xbm handle))) | |
200 ("image/x-xbitmap" | |
201 mm-inline-image | |
202 (lambda (handle) | |
203 (mm-valid-and-fit-image-p 'xbm handle))) | |
204 ("image/xpm" | |
205 mm-inline-image | |
206 (lambda (handle) | |
207 (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
|
208 ("image/x-xpixmap" |
31717 | 209 mm-inline-image |
210 (lambda (handle) | |
211 (mm-valid-and-fit-image-p 'xpm handle))) | |
212 ("image/bmp" | |
213 mm-inline-image | |
214 (lambda (handle) | |
215 (mm-valid-and-fit-image-p 'bmp handle))) | |
35048 | 216 ("image/x-portable-bitmap" |
217 mm-inline-image | |
218 (lambda (handle) | |
219 (mm-valid-and-fit-image-p 'pbm handle))) | |
31717 | 220 ("text/plain" mm-inline-text identity) |
221 ("text/enriched" mm-inline-text identity) | |
222 ("text/richtext" mm-inline-text identity) | |
223 ("text/x-patch" mm-display-patch-inline | |
224 (lambda (handle) | |
225 (locate-library "diff-mode"))) | |
31764 | 226 ("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
|
227 ("application/x-emacs-lisp" mm-display-elisp-inline identity) |
31717 | 228 ("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
|
229 mm-inline-text-html |
31717 | 230 (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
|
231 (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
|
232 mm-text-html-renderer))) |
31717 | 233 ("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
|
234 mm-inline-text-vcard |
31717 | 235 (lambda (handle) |
236 (or (featurep 'vcard) | |
237 (locate-library "vcard")))) | |
238 ("message/delivery-status" mm-inline-text identity) | |
239 ("message/rfc822" mm-inline-message identity) | |
240 ("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
|
241 ("message/external-body" mm-inline-external-body identity) |
31717 | 242 ("text/.*" mm-inline-text identity) |
243 ("audio/wav" mm-inline-audio | |
244 (lambda (handle) | |
245 (and (or (featurep 'nas-sound) (featurep 'native-sound)) | |
246 (device-sound-enabled-p)))) | |
247 ("audio/au" | |
248 mm-inline-audio | |
249 (lambda (handle) | |
250 (and (or (featurep 'nas-sound) (featurep 'native-sound)) | |
251 (device-sound-enabled-p)))) | |
252 ("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
|
253 ("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
|
254 ("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
|
255 ("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
|
256 ("application/pkcs7-mime" ignore identity) |
31717 | 257 ("multipart/alternative" ignore identity) |
258 ("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
|
259 ("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
|
260 ;; 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
|
261 ("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
|
262 ("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
|
263 ;; 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
|
264 (".*" mm-inline-text mm-readable-p)) |
31717 | 265 "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
|
266 :type '(repeat (list (regexp :tag "MIME type") |
31717 | 267 (function :tag "Display function") |
268 (function :tag "Display test"))) | |
269 :group 'mime-display) | |
270 | |
271 (defcustom mm-inlined-types | |
272 '("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
|
273 "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
|
274 "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
|
275 "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
|
276 "application/pkcs7-signature" "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
|
277 "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
|
278 "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
|
279 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
|
280 type inline." |
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 string) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
282 :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
|
283 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
284 (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
|
285 '("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
|
286 "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
|
287 "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
|
288 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
|
289 :version "22.1" |
31717 | 290 :type '(repeat string) |
291 :group 'mime-display) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44075
diff
changeset
|
292 |
31717 | 293 (defcustom mm-automatic-display |
294 '("text/plain" "text/enriched" "text/richtext" "text/html" | |
295 "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*" | |
35048 | 296 "message/rfc822" "text/x-patch" "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
|
297 "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
|
298 "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
|
299 "application/pkcs7-signature" "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
|
300 "application/pkcs7-mime") |
31717 | 301 "A list of MIME types to be displayed automatically." |
302 :type '(repeat string) | |
303 :group 'mime-display) | |
304 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
305 (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
|
306 "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
|
307 "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
|
308 "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
|
309 "application/x-pkcs7-signature") |
31717 | 310 "Types to have \"attachment\" ignored if they can be displayed inline." |
311 :type '(repeat string) | |
312 :group 'mime-display) | |
313 | |
314 (defcustom mm-inline-override-types nil | |
315 "Types to be treated as attachments even if they can be displayed inline." | |
316 :type '(repeat string) | |
317 :group 'mime-display) | |
318 | |
319 (defcustom mm-automatic-external-display nil | |
320 "List of MIME type regexps that will be displayed externally automatically." | |
321 :type '(repeat string) | |
322 :group 'mime-display) | |
323 | |
324 (defcustom mm-discouraged-alternatives nil | |
325 "List of MIME types that are discouraged when viewing multipart/alternative. | |
326 Viewing agents are supposed to view the last possible part of a message, | |
327 as that is supposed to be the richest. However, users may prefer other | |
328 types instead, and this list says what types are most unwanted. If, | |
329 for instance, text/html parts are very unwanted, and text/richtext are | |
330 somewhat unwanted, then the value of this variable should be set | |
331 to: | |
332 | |
333 (\"text/html\" \"text/richtext\")" | |
334 :type '(repeat string) | |
335 :group 'mime-display) | |
336 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
337 (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
|
338 (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
|
339 (temp-directory) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
340 (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
|
341 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
|
342 "/tmp/")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
343 "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
|
344 :type 'directory |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
345 :group 'mime-display) |
31717 | 346 |
347 (defcustom mm-inline-large-images nil | |
348 "If non-nil, then all images fit in the buffer." | |
349 :type 'boolean | |
350 :group 'mime-display) | |
351 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
352 (defvar 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
|
353 '(mm-file-name-delete-control mm-file-name-delete-gotchas) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
354 "*List of functions used for rewriting 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
|
355 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
|
356 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
357 Ready-made functions include |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
358 `mm-file-name-delete-control' |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
359 `mm-file-name-delete-gotchas' |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
360 `mm-file-name-delete-whitespace', |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
361 `mm-file-name-trim-whitespace', |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
362 `mm-file-name-collapse-whitespace', |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
363 `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
|
364 `capitalize', `downcase', `upcase', and |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
365 `upcase-initials'.") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
366 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
367 (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
|
368 "*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
|
369 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
|
370 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
|
371 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
|
372 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
373 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
|
374 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
375 (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
|
376 "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
|
377 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
378 (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
|
379 "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
|
380 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
|
381 :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
|
382 :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
|
383 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
384 (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
|
385 "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
|
386 :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
|
387 :type 'integer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
388 :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
|
389 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
390 (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
|
391 "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
|
392 :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
|
393 :type 'string |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
394 :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
|
395 |
31717 | 396 ;;; Internal variables. |
397 | |
398 (defvar mm-last-shell-command "") | |
399 (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
|
400 (defvar mm-postponed-undisplay-list nil) |
31717 | 401 |
402 ;; According to RFC2046, in particular, in a digest, the default | |
403 ;; Content-Type value for a body part is changed from "text/plain" to | |
404 ;; "message/rfc822". | |
405 (defvar mm-dissect-default-type "text/plain") | |
406 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
407 (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
|
408 (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
|
409 (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
|
410 (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
|
411 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
412 (defvar mm-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
|
413 '(("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
|
414 ("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
|
415 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
|
416 ("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
|
417 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
|
418 ("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
|
419 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
|
420 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
421 (defcustom mm-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
|
422 "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
|
423 `never', not verify; `always', always verify; |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
424 `known', only verify 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
|
425 :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
|
426 :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
|
427 (item never) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
428 (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
|
429 (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
|
430 :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
|
431 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
432 (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
|
433 (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
|
434 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
435 (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
|
436 '(("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
|
437 ("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
|
438 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
|
439 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
440 (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
|
441 "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
|
442 `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
|
443 `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
|
444 :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
|
445 :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
|
446 (item never) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
447 (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
|
448 (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
|
449 :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
|
450 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
451 (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
|
452 (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
|
453 (set-keymap-parent map minibuffer-local-completion-map) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
454 map) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
455 "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
|
456 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
457 ;; Should we bind other key to minibuffer-complete-word? |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
458 (define-key mm-viewer-completion-map " " 'self-insert-command) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
459 |
32962 | 460 (defvar mm-viewer-completion-map |
461 (let ((map (make-sparse-keymap 'mm-viewer-completion-map))) | |
462 (set-keymap-parent map minibuffer-local-completion-map) | |
463 map) | |
464 "Keymap for input viewer with completion.") | |
465 | |
466 ;; Should we bind other key to minibuffer-complete-word? | |
35048 | 467 (define-key mm-viewer-completion-map " " 'self-insert-command) |
32962 | 468 |
31717 | 469 ;;; The functions. |
470 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
471 (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
|
472 "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
|
473 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
|
474 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
475 \((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
|
476 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
477 into |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
478 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
479 \(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
|
480 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
481 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
|
482 (let (plist) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
483 (while alist |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
484 (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
|
485 (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
|
486 (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
|
487 (nreverse plist))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
488 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
489 (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
|
490 "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
|
491 (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
|
492 (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
|
493 ty) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
494 (catch 'found |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
495 (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
|
496 (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
|
497 (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
|
498 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
499 (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
|
500 "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
|
501 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
|
502 `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
|
503 (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
|
504 (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
|
505 (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
|
506 (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
|
507 (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
|
508 (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
|
509 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
510 (defun mm-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
|
511 (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
|
512 (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
|
513 (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
|
514 |
60302
f34a552e4a9f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-139
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
515 (defun mm-dissect-buffer (&optional no-strict-mime loose-mime from) |
31717 | 516 "Dissect the current buffer and return a list of MIME handles." |
517 (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
|
518 (let (ct ctl type subtype cte cd description id result) |
31717 | 519 (save-restriction |
520 (mail-narrow-to-head) | |
521 (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
|
522 loose-mime |
31717 | 523 (mail-fetch-field "mime-version")) |
524 (setq ct (mail-fetch-field "content-type") | |
525 ctl (ignore-errors (mail-header-parse-content-type ct)) | |
526 cte (mail-fetch-field "content-transfer-encoding") | |
527 cd (mail-fetch-field "content-disposition") | |
528 description (mail-fetch-field "content-description") | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
529 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
|
530 (unless from |
f34a552e4a9f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-139
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
531 (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
|
532 ;; 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
|
533 ;; 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
|
534 ;; 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
|
535 ;; 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
|
536 (if from |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
537 (setq from (cadr (mail-extract-address-components from)))))) |
31717 | 538 (when cte |
539 (setq cte (mail-header-strip cte))) | |
540 (if (or (not ctl) | |
541 (not (string-match "/" (car ctl)))) | |
542 (mm-dissect-singlepart | |
543 (list mm-dissect-default-type) | |
544 (and cte (intern (downcase (mail-header-remove-whitespace | |
545 (mail-header-remove-comments | |
546 cte))))) | |
547 no-strict-mime | |
548 (and cd (ignore-errors (mail-header-parse-content-disposition cd))) | |
549 description) | |
550 (setq type (split-string (car ctl) "/")) | |
551 (setq subtype (cadr type) | |
552 type (pop type)) | |
553 (setq | |
554 result | |
555 (cond | |
556 ((equal type "multipart") | |
557 (let ((mm-dissect-default-type (if (equal subtype "digest") | |
558 "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
|
559 "text/plain")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
560 (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
|
561 (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
|
562 (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
|
563 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
564 ;; 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
|
565 ;; 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
|
566 ;; MIME article). That would probably require changing |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
567 ;; the mm-handle API so we simply store the multipart buffert |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
568 ;; 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
|
569 (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
|
570 (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
|
571 'from from |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
572 'start start) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
573 (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
|
574 (cons (car ctl) (mm-dissect-multipart ctl from)))) |
31717 | 575 (t |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
576 (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
|
577 (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
|
578 ctl |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
579 (and cte (intern (downcase (mail-header-remove-whitespace |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
580 (mail-header-remove-comments |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
581 cte))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
582 no-strict-mime |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
583 (and cd (ignore-errors |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
584 (mail-header-parse-content-disposition cd))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
585 description id) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
586 ctl)))) |
31717 | 587 (when id |
588 (when (string-match " *<\\(.*\\)> *" id) | |
589 (setq id (match-string 1 id))) | |
590 (push (cons id result) mm-content-id-alist)) | |
591 result)))) | |
592 | |
593 (defun mm-dissect-singlepart (ctl cte &optional force cdl description id) | |
594 (when (or force | |
595 (if (equal "text/plain" (car ctl)) | |
596 (assoc 'format ctl) | |
597 t)) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
598 (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
|
599 (mm-copy-to-buffer) ctl cte nil cdl description nil id))) |
31717 | 600 |
60302
f34a552e4a9f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-139
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
601 (defun mm-dissect-multipart (ctl from) |
31717 | 602 (goto-char (point-min)) |
603 (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary))) | |
604 (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$")) | |
605 start parts | |
606 (end (save-excursion | |
607 (goto-char (point-max)) | |
608 (if (re-search-backward close-delimiter nil t) | |
609 (match-beginning 0) | |
610 (point-max))))) | |
611 (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
|
612 (while (and (< (point) end) (re-search-forward boundary end t)) |
31717 | 613 (goto-char (match-beginning 0)) |
614 (when start | |
615 (save-excursion | |
616 (save-restriction | |
617 (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
|
618 (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
|
619 (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
|
620 (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
|
621 (forward-line 1)) |
31717 | 622 (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
|
623 (when (and start (< start end)) |
31717 | 624 (save-excursion |
625 (save-restriction | |
626 (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
|
627 (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
|
628 (mm-possibly-verify-or-decrypt (nreverse parts) ctl))) |
31717 | 629 |
630 (defun mm-copy-to-buffer () | |
631 "Copy the contents of the current buffer to a fresh buffer." | |
632 (save-excursion | |
633 (let ((obuf (current-buffer)) | |
634 beg) | |
635 (goto-char (point-min)) | |
636 (search-forward-regexp "^\n" nil t) | |
637 (setq beg (point)) | |
57243
c5e16264557d
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-575
Miles Bader <miles@gnu.org>
parents:
57173
diff
changeset
|
638 (set-buffer |
c5e16264557d
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-575
Miles Bader <miles@gnu.org>
parents:
57173
diff
changeset
|
639 ;; Preserve the data's unibyteness (for url-insert-file-contents). |
c5e16264557d
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-575
Miles Bader <miles@gnu.org>
parents:
57173
diff
changeset
|
640 (let ((default-enable-multibyte-characters (mm-multibyte-p))) |
c5e16264557d
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-575
Miles Bader <miles@gnu.org>
parents:
57173
diff
changeset
|
641 (generate-new-buffer " *mm*"))) |
31717 | 642 (insert-buffer-substring obuf beg) |
643 (current-buffer)))) | |
644 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
645 (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
|
646 (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
|
647 (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
|
648 (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
|
649 (save-restriction |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
650 (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
|
651 (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
|
652 (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
|
653 (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
|
654 |
31717 | 655 (defun mm-display-part (handle &optional no-default) |
656 "Display the MIME part represented by HANDLE. | |
657 Returns nil if the part is removed; inline if displayed inline; | |
658 external if displayed external." | |
659 (save-excursion | |
660 (mailcap-parse-mailcaps) | |
661 (if (mm-handle-displayed-p handle) | |
662 (mm-remove-part handle) | |
663 (let* ((type (mm-handle-media-type handle)) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
664 (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
|
665 (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
|
666 (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
|
667 (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
|
668 (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
|
669 "<file>")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
670 (external mm-enable-external)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
671 (if (and (mm-inlinable-p handle) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
672 (mm-inlined-p handle)) |
31717 | 673 (progn |
674 (forward-line 1) | |
675 (mm-display-inline handle) | |
676 'inline) | |
677 (when (or method | |
678 (not no-default)) | |
679 (if (and (not method) | |
680 (equal "text" (car (split-string type)))) | |
681 (progn | |
682 (forward-line 1) | |
683 (mm-insert-inline handle (mm-get-part handle)) | |
684 'inline) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
685 (if (and method ;; If nil, we always use "save". |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
686 (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
|
687 (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
|
688 (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
|
689 (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
|
690 (concat |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
691 "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
|
692 ") 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
|
693 ;; 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
|
694 (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
|
695 (concat |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
696 " \"" (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
|
697 "") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
698 "? "))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
699 (setq external t) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
700 (setq external nil)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
701 (if external |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
702 (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
|
703 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
|
704 (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
|
705 handle 'mailcap-save-binary-file))))))))) |
31717 | 706 |
707 (defun mm-display-external (handle method) | |
708 "Display HANDLE using METHOD." | |
709 (let ((outbuf (current-buffer))) | |
710 (mm-with-unibyte-buffer | |
711 (if (functionp method) | |
712 (let ((cur (current-buffer))) | |
713 (if (eq method 'mailcap-save-binary-file) | |
714 (progn | |
33174
702845b072b7
(mm-display-external): Space prefix temp buffer
Dave Love <fx@gnu.org>
parents:
32962
diff
changeset
|
715 (set-buffer (generate-new-buffer " *mm*")) |
31717 | 716 (setq method nil)) |
717 (mm-insert-part handle) | |
718 (let ((win (get-buffer-window cur t))) | |
719 (when win | |
720 (select-window win))) | |
33174
702845b072b7
(mm-display-external): Space prefix temp buffer
Dave Love <fx@gnu.org>
parents:
32962
diff
changeset
|
721 (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
|
722 (buffer-disable-undo) |
31717 | 723 (mm-set-buffer-file-coding-system mm-binary-coding-system) |
724 (insert-buffer-substring cur) | |
725 (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
|
726 (when method |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
727 (message "Viewing with %s" method)) |
31717 | 728 (let ((mm (current-buffer)) |
729 (non-viewer (assq 'non-viewer | |
730 (mailcap-mime-info | |
731 (mm-handle-media-type handle) t)))) | |
732 (unwind-protect | |
733 (if method | |
734 (funcall method) | |
735 (mm-save-part handle)) | |
736 (when (and (not non-viewer) | |
737 method) | |
738 (mm-handle-set-undisplayer handle mm))))) | |
739 ;; The function is a string to be executed. | |
740 (mm-insert-part handle) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
741 (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
|
742 (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
|
743 (filename (or |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
744 (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
|
745 (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
|
746 (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
|
747 (mm-handle-type handle) 'name))) |
31717 | 748 (mime-info (mailcap-mime-info |
749 (mm-handle-media-type handle) t)) | |
750 (needsterm (or (assoc "needsterm" mime-info) | |
751 (assoc "needsterminal" mime-info))) | |
752 (copiousoutput (assoc "copiousoutput" mime-info)) | |
753 file buffer) | |
754 ;; We create a private sub-directory where we store our files. | |
755 (set-file-modes dir 448) | |
756 (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
|
757 (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
|
758 (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
|
759 (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
|
760 dir)) |
44075
7782e54757bb
* mail-source.el (make-source-make-complex-temp-name): Use
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38413
diff
changeset
|
761 (setq file (mm-make-temp-file (expand-file-name "mm." dir)))) |
31717 | 762 (let ((coding-system-for-write mm-binary-coding-system)) |
763 (write-region (point-min) (point-max) file nil 'nomesg)) | |
764 (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
|
765 (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
766 (needsterm |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
767 (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
|
768 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
|
769 (unwind-protect |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
770 (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
|
771 (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
|
772 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
|
773 "-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
|
774 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
|
775 (require 'term) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
776 (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
|
777 (set-buffer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
778 (setq buffer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
779 (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
|
780 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
|
781 nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
782 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
|
783 (term-mode) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
784 (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
|
785 (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
|
786 (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
|
787 `(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
|
788 (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
|
789 (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
|
790 ',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
|
791 (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
|
792 (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
|
793 (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
|
794 'external) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
795 (copiousoutput |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
796 (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
|
797 (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
|
798 (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
|
799 handle |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
800 (unwind-protect |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
801 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
802 (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
|
803 (setq buffer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
804 (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
|
805 nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
806 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
|
807 (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
|
808 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
|
809 (if (buffer-live-p buffer) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
810 (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
811 (set-buffer buffer) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
812 (buffer-string)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
813 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
814 (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
|
815 (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
|
816 (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
|
817 (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
|
818 'inline) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
819 (t |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
820 (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
|
821 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
|
822 (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
|
823 (progn |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
824 (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
|
825 (setq buffer |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
826 (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
|
827 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
|
828 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
|
829 (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
|
830 (get-buffer-process buffer) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
831 `(lambda (process state) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
832 (when (eq 'exit (process-status process)) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
833 ;; Don't use `ignore-errors'. |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
834 (condition-case nil |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
835 (delete-file ,file) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
836 (error)) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
837 (condition-case nil |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
838 (delete-directory ,(file-name-directory file)) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
839 (error)) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
840 (condition-case nil |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
841 (kill-buffer ,buffer) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
842 (error)) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
843 (condition-case nil |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
844 ,(macroexpand (list 'mm-handle-set-undisplayer |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
845 (list 'quote handle) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
846 nil)) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
847 (error)) |
6bf3cc5c6ab3
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-505
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
848 (message "Displaying %s...done" ,command))))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
849 (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
|
850 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
|
851 (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
|
852 'external))))))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44075
diff
changeset
|
853 |
31717 | 854 (defun mm-mailcap-command (method file type-list) |
855 (let ((ctl (cdr type-list)) | |
856 (beg 0) | |
857 (uses-stdin t) | |
858 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
|
859 (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
|
860 method beg) |
31717 | 861 (push (substring method beg (match-beginning 0)) out) |
862 (setq beg (match-end 0) | |
863 total (match-string 0 method) | |
864 sub (match-string 1 method)) | |
865 (cond | |
866 ((string= total "%%") | |
867 (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
|
868 ((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
|
869 ;; 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
|
870 (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
|
871 (string= total "\"%s\"")) |
31717 | 872 (setq uses-stdin nil) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
873 (push (mm-quote-arg |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
874 (gnus-map-function mm-path-name-rewrite-functions file)) out)) |
31717 | 875 ((string= total "%t") |
876 (push (mm-quote-arg (car type-list)) out)) | |
877 (t | |
878 (push (mm-quote-arg (or (cdr (assq (intern sub) ctl)) "")) out)))) | |
879 (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
|
880 (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
|
881 (push "<" out) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
882 (push (mm-quote-arg |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
883 (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
|
884 out)) |
31717 | 885 (mapconcat 'identity (nreverse out) ""))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44075
diff
changeset
|
886 |
31717 | 887 (defun mm-remove-parts (handles) |
888 "Remove the displayed MIME parts represented by HANDLES." | |
889 (if (and (listp handles) | |
890 (bufferp (car handles))) | |
891 (mm-remove-part handles) | |
892 (let (handle) | |
893 (while (setq handle (pop handles)) | |
894 (cond | |
895 ((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
|
896 (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
|
897 (kill-buffer (get-text-property 0 'buffer handle)))) |
31717 | 898 ((and (listp handle) |
899 (stringp (car handle))) | |
900 (mm-remove-parts (cdr handle))) | |
901 (t | |
902 (mm-remove-part handle))))))) | |
903 | |
904 (defun mm-destroy-parts (handles) | |
905 "Remove the displayed MIME parts represented by HANDLES." | |
906 (if (and (listp handles) | |
907 (bufferp (car handles))) | |
908 (mm-destroy-part handles) | |
909 (let (handle) | |
910 (while (setq handle (pop handles)) | |
911 (cond | |
912 ((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
|
913 (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
|
914 (kill-buffer (get-text-property 0 'buffer handle)))) |
31717 | 915 ((and (listp handle) |
916 (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
|
917 (mm-destroy-parts handle)) |
31717 | 918 (t |
919 (mm-destroy-part handle))))))) | |
920 | |
921 (defun mm-remove-part (handle) | |
922 "Remove the displayed MIME part represented by HANDLE." | |
923 (when (listp handle) | |
924 (let ((object (mm-handle-undisplayer handle))) | |
925 (ignore-errors | |
926 (cond | |
927 ;; Internally displayed part. | |
928 ((mm-annotationp object) | |
929 (delete-annotation object)) | |
930 ((or (functionp object) | |
931 (and (listp object) | |
932 (eq (car object) 'lambda))) | |
933 (funcall object)) | |
934 ;; Externally displayed part. | |
935 ((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
|
936 (condition-case () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
937 (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
|
938 (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
|
939 (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
|
940 (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
|
941 (quit) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
942 (error)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
943 (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
|
944 (message "Waiting for external displayer to die...done") |
31717 | 945 (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
|
946 (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
|
947 (car object))))) |
31717 | 948 ((bufferp object) |
949 (when (buffer-live-p object) | |
950 (kill-buffer object))))) | |
951 (mm-handle-set-undisplayer handle nil)))) | |
952 | |
953 (defun mm-display-inline (handle) | |
954 (let* ((type (mm-handle-media-type handle)) | |
955 (function (cadr (mm-assoc-string-match mm-inline-media-tests type)))) | |
956 (funcall function handle) | |
957 (goto-char (point-min)))) | |
958 | |
959 (defun mm-assoc-string-match (alist type) | |
960 (dolist (elem alist) | |
961 (when (string-match (car elem) type) | |
962 (return elem)))) | |
963 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
964 (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
|
965 "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
|
966 (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
|
967 (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
|
968 method result) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
969 (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
|
970 (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
|
971 (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
|
972 (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
|
973 methods nil))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
974 result)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
975 |
31717 | 976 (defun mm-inlinable-p (handle) |
977 "Say whether HANDLE can be displayed inline." | |
978 (let ((alist mm-inline-media-tests) | |
979 (type (mm-handle-media-type handle)) | |
980 test) | |
981 (while alist | |
982 (when (string-match (caar alist) type) | |
983 (setq test (caddar alist) | |
984 alist nil) | |
985 (setq test (funcall test handle))) | |
986 (pop alist)) | |
987 test)) | |
988 | |
989 (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
|
990 "Say whether the user wants HANDLE to be displayed inline." |
31717 | 991 (let ((methods mm-inlined-types) |
992 (type (mm-handle-media-type handle)) | |
993 method result) | |
994 (while (setq method (pop methods)) | |
995 (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
|
996 (string-match method type)) |
31717 | 997 (setq result t |
998 methods nil))) | |
999 result)) | |
1000 | |
1001 (defun mm-attachment-override-p (handle) | |
1002 "Say whether HANDLE should have attachment behavior overridden." | |
1003 (let ((types mm-attachment-override-types) | |
1004 (type (mm-handle-media-type handle)) | |
1005 ty) | |
1006 (catch 'found | |
1007 (while (setq ty (pop types)) | |
1008 (when (and (string-match ty type) | |
1009 (mm-inlinable-p handle)) | |
1010 (throw 'found t)))))) | |
1011 | |
1012 (defun mm-inline-override-p (handle) | |
1013 "Say whether HANDLE should have inline behavior overridden." | |
1014 (let ((types mm-inline-override-types) | |
1015 (type (mm-handle-media-type handle)) | |
1016 ty) | |
1017 (catch 'found | |
1018 (while (setq ty (pop types)) | |
1019 (when (string-match ty type) | |
1020 (throw 'found t)))))) | |
1021 | |
1022 (defun mm-automatic-external-display-p (type) | |
1023 "Return the user-defined method for TYPE." | |
1024 (let ((methods mm-automatic-external-display) | |
1025 method result) | |
1026 (while (setq method (pop methods)) | |
1027 (when (string-match method type) | |
1028 (setq result t | |
1029 methods nil))) | |
1030 result)) | |
1031 | |
1032 (defun mm-destroy-part (handle) | |
1033 "Destroy the data structures connected to HANDLE." | |
1034 (when (listp handle) | |
1035 (mm-remove-part handle) | |
1036 (when (buffer-live-p (mm-handle-buffer handle)) | |
1037 (kill-buffer (mm-handle-buffer handle))))) | |
1038 | |
1039 (defun mm-handle-displayed-p (handle) | |
1040 "Say whether HANDLE is displayed or not." | |
1041 (mm-handle-undisplayer handle)) | |
1042 | |
1043 ;;; | |
1044 ;;; Functions for outputting parts | |
1045 ;;; | |
1046 | |
1047 (defun mm-get-part (handle) | |
1048 "Return the contents of HANDLE as a string." | |
1049 (mm-with-unibyte-buffer | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1050 (insert (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
|
1051 (mm-with-unibyte-current-buffer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1052 (buffer-string)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1053 (mm-decode-content-transfer-encoding |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1054 (mm-handle-encoding handle) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1055 (mm-handle-media-type handle)) |
31717 | 1056 (buffer-string))) |
1057 | |
1058 (defun mm-insert-part (handle) | |
1059 "Insert the contents of HANDLE in the current buffer." | |
59690
0017dfb224ef
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-47
Miles Bader <miles@gnu.org>
parents:
57856
diff
changeset
|
1060 (save-excursion |
65719
5265a4059126
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-564
Miles Bader <miles@gnu.org>
parents:
65275
diff
changeset
|
1061 (insert |
5265a4059126
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-564
Miles Bader <miles@gnu.org>
parents:
65275
diff
changeset
|
1062 (cond ((eq (mail-content-type-get (mm-handle-type handle) 'charset) |
5265a4059126
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-564
Miles Bader <miles@gnu.org>
parents:
65275
diff
changeset
|
1063 'gnus-decoded) |
5265a4059126
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-564
Miles Bader <miles@gnu.org>
parents:
65275
diff
changeset
|
1064 (with-current-buffer (mm-handle-buffer handle) |
5265a4059126
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-564
Miles Bader <miles@gnu.org>
parents:
65275
diff
changeset
|
1065 (buffer-string))) |
5265a4059126
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-564
Miles Bader <miles@gnu.org>
parents:
65275
diff
changeset
|
1066 ((mm-multibyte-p) |
5265a4059126
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-564
Miles Bader <miles@gnu.org>
parents:
65275
diff
changeset
|
1067 (mm-string-as-multibyte (mm-get-part handle))) |
5265a4059126
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-564
Miles Bader <miles@gnu.org>
parents:
65275
diff
changeset
|
1068 (t |
5265a4059126
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-564
Miles Bader <miles@gnu.org>
parents:
65275
diff
changeset
|
1069 (mm-get-part handle)))))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1070 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1071 (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
|
1072 "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
|
1073 (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
|
1074 (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
|
1075 file-name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1076 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1077 (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
|
1078 "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
|
1079 (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
|
1080 (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
|
1081 (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
|
1082 (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
|
1083 file-name) |
31717 | 1084 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1085 (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
|
1086 "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
|
1087 (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
|
1088 (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
|
1089 file-name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1090 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1091 (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
|
1092 "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
|
1093 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
|
1094 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
|
1095 (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
|
1096 (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
|
1097 (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
|
1098 file-name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1099 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1100 (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
|
1101 "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
|
1102 (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
|
1103 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1104 (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
|
1105 "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
|
1106 (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
|
1107 (gnus-replace-in-string filename "^[.-]+" "")) |
31717 | 1108 |
1109 (defun mm-save-part (handle) | |
1110 "Write HANDLE to a file." | |
1111 (let* ((name (mail-content-type-get (mm-handle-type handle) 'name)) | |
1112 (filename (mail-content-type-get | |
1113 (mm-handle-disposition handle) 'filename)) | |
1114 file) | |
1115 (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
|
1116 (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
|
1117 (file-name-nondirectory filename)))) |
31717 | 1118 (setq file |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1119 (mm-with-multibyte |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1120 (read-file-name "Save MIME part to: " |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1121 (or mm-default-directory default-directory) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1122 nil nil (or filename name "")))) |
31717 | 1123 (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
|
1124 (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
|
1125 (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
|
1126 file))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1127 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1128 (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
|
1129 file)))) |
31717 | 1130 |
1131 (defun mm-save-part-to-file (handle file) | |
1132 (mm-with-unibyte-buffer | |
1133 (mm-insert-part handle) | |
1134 (let ((coding-system-for-write 'binary) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1135 (current-file-modes (default-file-modes)) |
31717 | 1136 ;; Don't re-compress .gz & al. Arguably we should make |
1137 ;; `file-name-handler-alist' nil, but that would chop | |
1138 ;; ange-ftp, which is reasonable to use here. | |
1139 (inhibit-file-name-operation 'write-region) | |
1140 (inhibit-file-name-handlers | |
1141 (cons 'jka-compr-handler inhibit-file-name-handlers))) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1142 (set-default-file-modes mm-attachment-file-modes) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1143 (unwind-protect |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1144 (write-region (point-min) (point-max) file) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1145 (set-default-file-modes current-file-modes))))) |
31717 | 1146 |
1147 (defun mm-pipe-part (handle) | |
1148 "Pipe HANDLE to a process." | |
1149 (let* ((name (mail-content-type-get (mm-handle-type handle) 'name)) | |
1150 (command | |
1151 (read-string "Shell command on MIME part: " mm-last-shell-command))) | |
1152 (mm-with-unibyte-buffer | |
1153 (mm-insert-part handle) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1154 (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
|
1155 (shell-command-on-region (point-min) (point-max) command nil))))) |
31717 | 1156 |
1157 (defun mm-interactively-view-part (handle) | |
1158 "Display HANDLE using METHOD." | |
1159 (let* ((type (mm-handle-media-type handle)) | |
1160 (methods | |
1161 (mapcar (lambda (i) (list (cdr (assoc 'viewer i)))) | |
1162 (mailcap-mime-info type 'all))) | |
32962 | 1163 (method (let ((minibuffer-local-completion-map |
1164 mm-viewer-completion-map)) | |
1165 (completing-read "Viewer: " methods)))) | |
31717 | 1166 (when (string= method "") |
1167 (error "No method given")) | |
35048 | 1168 (if (string-match "^[^% \t]+$" method) |
31717 | 1169 (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
|
1170 (mm-display-external handle method))) |
31717 | 1171 |
1172 (defun mm-preferred-alternative (handles &optional preferred) | |
1173 "Say which of HANDLES are preferred." | |
1174 (let ((prec (if preferred (list preferred) | |
1175 (mm-preferred-alternative-precedence handles))) | |
1176 p h result type handle) | |
1177 (while (setq p (pop prec)) | |
1178 (setq h handles) | |
1179 (while h | |
1180 (setq handle (car h)) | |
1181 (setq type (mm-handle-media-type handle)) | |
1182 (when (and (equal p type) | |
1183 (mm-automatic-display-p handle) | |
1184 (or (stringp (car handle)) | |
1185 (not (mm-handle-disposition handle)) | |
1186 (equal (car (mm-handle-disposition handle)) | |
1187 "inline"))) | |
1188 (setq result handle | |
1189 h nil | |
1190 prec nil)) | |
1191 (pop h))) | |
1192 result)) | |
1193 | |
1194 (defun mm-preferred-alternative-precedence (handles) | |
1195 "Return the precedence based on HANDLES and `mm-discouraged-alternatives'." | |
1196 (let ((seq (nreverse (mapcar #'mm-handle-media-type | |
1197 handles)))) | |
1198 (dolist (disc (reverse mm-discouraged-alternatives)) | |
1199 (dolist (elem (copy-sequence seq)) | |
1200 (when (string-match disc elem) | |
1201 (setq seq (nconc (delete elem seq) (list elem)))))) | |
1202 seq)) | |
1203 | |
1204 (defun mm-get-content-id (id) | |
1205 "Return the handle(s) referred to by ID." | |
1206 (cdr (assoc id mm-content-id-alist))) | |
1207 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1208 (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
|
1209 '(("/\\*.*XPM.\\*/" . xpm) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1210 ("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
|
1211 ("GIF8" . gif) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1212 ("\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
|
1213 ("\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
|
1214 ("#define" . xbm) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1215 ("\\(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
|
1216 ("%!PS" . postscript)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1217 "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
|
1218 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
|
1219 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
|
1220 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1221 ;; 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
|
1222 (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
|
1223 "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
|
1224 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
|
1225 be determined." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1226 (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
|
1227 type) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1228 (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
|
1229 (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
|
1230 (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
|
1231 (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
|
1232 (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
|
1233 (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
|
1234 (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
|
1235 type)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1236 |
31717 | 1237 (defun mm-get-image (handle) |
1238 "Return an image instance based on HANDLE." | |
1239 (let ((type (mm-handle-media-subtype handle)) | |
1240 spec) | |
1241 ;; Allow some common translations. | |
1242 (setq type | |
1243 (cond | |
1244 ((equal type "x-pixmap") | |
1245 "xpm") | |
1246 ((equal type "x-xbitmap") | |
1247 "xbm") | |
35048 | 1248 ((equal type "x-portable-bitmap") |
1249 "pbm") | |
31717 | 1250 (t type))) |
1251 (or (mm-handle-cache handle) | |
1252 (mm-with-unibyte-buffer | |
1253 (mm-insert-part handle) | |
1254 (prog1 | |
1255 (setq spec | |
1256 (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
|
1257 ;; 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
|
1258 ;; a bogus version of it. |
31717 | 1259 (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
|
1260 (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
|
1261 (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
|
1262 (intern type)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1263 'data-p) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1264 (mm-create-image-xemacs type)))) |
31717 | 1265 (mm-handle-set-cache handle spec)))))) |
1266 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1267 (defun mm-create-image-xemacs (type) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1268 (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1269 ((equal type "xbm") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1270 ;; xbm images require special handling, since |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1271 ;; the only way to create glyphs from these |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1272 ;; (without a ton of work) is to write them |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1273 ;; out to a file, and then create a file |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1274 ;; specifier. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1275 (let ((file (mm-make-temp-file |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1276 (expand-file-name "emm.xbm" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1277 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
|
1278 (unwind-protect |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1279 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1280 (write-region (point-min) (point-max) file) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1281 (make-glyph (list (cons 'x file)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1282 (ignore-errors |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1283 (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
|
1284 (t |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1285 (make-glyph |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1286 (vector |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1287 (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
|
1288 (intern type)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1289 :data (buffer-string)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1290 |
31717 | 1291 (defun mm-image-fit-p (handle) |
1292 "Say whether the image in HANDLE will fit the current window." | |
1293 (let ((image (mm-get-image handle))) | |
1294 (if (fboundp 'glyph-width) | |
1295 ;; XEmacs' glyphs can actually tell us about their width, so | |
1296 ;; lets be nice and smart about them. | |
1297 (or mm-inline-large-images | |
1298 (and (< (glyph-width image) (window-pixel-width)) | |
1299 (< (glyph-height image) (window-pixel-height)))) | |
1300 (let* ((size (image-size image)) | |
1301 (w (car size)) | |
1302 (h (cdr size))) | |
1303 (or mm-inline-large-images | |
1304 (and (< h (1- (window-height))) ; Don't include mode line. | |
1305 (< w (window-width)))))))) | |
1306 | |
1307 (defun mm-valid-image-format-p (format) | |
1308 "Say whether FORMAT can be displayed natively by Emacs." | |
1309 (cond | |
1310 ;; Handle XEmacs | |
1311 ((fboundp 'valid-image-instantiator-format-p) | |
1312 (valid-image-instantiator-format-p format)) | |
1313 ;; Handle Emacs 21 | |
1314 ((fboundp 'image-type-available-p) | |
1315 (and (display-graphic-p) | |
1316 (image-type-available-p format))) | |
1317 ;; Nobody else can do images yet. | |
1318 (t | |
1319 nil))) | |
1320 | |
1321 (defun mm-valid-and-fit-image-p (format handle) | |
1322 "Say whether FORMAT can be displayed natively and HANDLE fits the window." | |
32962 | 1323 (and (mm-valid-image-format-p format) |
31717 | 1324 (mm-image-fit-p handle))) |
1325 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1326 (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
|
1327 "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
|
1328 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
|
1329 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
|
1330 (let (handle) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1331 (while handles |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1332 (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
|
1333 (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
|
1334 notp recursive)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1335 (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
|
1336 (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
|
1337 (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
|
1338 (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
|
1339 (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
|
1340 handles nil))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1341 (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
|
1342 handle)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1343 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1344 (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
|
1345 (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
|
1346 (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
|
1347 'boundary))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1348 (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
|
1349 start |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1350 (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
|
1351 (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
|
1352 (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
|
1353 (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
|
1354 (point-max)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1355 result) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1356 (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
|
1357 (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
|
1358 (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
|
1359 (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
|
1360 (when start |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1361 (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1362 (save-restriction |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1363 (narrow-to-region start (1- (point))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1364 (when (let ((ctl (ignore-errors |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1365 (mail-header-parse-content-type |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1366 (mail-fetch-field "content-type"))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1367 (if notp |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1368 (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
|
1369 (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
|
1370 (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
|
1371 (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
|
1372 (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
|
1373 (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
|
1374 (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1375 (save-restriction |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1376 (narrow-to-region start end) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1377 (when (let ((ctl (ignore-errors |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1378 (mail-header-parse-content-type |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1379 (mail-fetch-field "content-type"))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1380 (if notp |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1381 (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
|
1382 (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
|
1383 (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
|
1384 result)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1385 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1386 (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
|
1387 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1388 (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
|
1389 ;; 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
|
1390 (when handle |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1391 (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
|
1392 (car handle)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1393 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1394 (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
|
1395 (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
|
1396 (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
|
1397 (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
|
1398 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
|
1399 (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1400 ((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
|
1401 (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
|
1402 (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
|
1403 (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
|
1404 ((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
|
1405 ((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
|
1406 ((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
|
1407 (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
|
1408 (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
|
1409 (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
|
1410 (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
|
1411 ((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
|
1412 (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
|
1413 (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
|
1414 (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
|
1415 ;; 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
|
1416 (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
|
1417 (while protocols |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1418 (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
|
1419 (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
|
1420 (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
|
1421 (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
|
1422 protocols nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1423 (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
|
1424 (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
|
1425 (when (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1426 ((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
|
1427 ((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
|
1428 ((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
|
1429 (and func |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1430 (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
|
1431 (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
|
1432 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
|
1433 (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
|
1434 (t |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1435 (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
|
1436 (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
|
1437 (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
|
1438 (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
|
1439 (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1440 (if func |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1441 (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
|
1442 (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
|
1443 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
|
1444 (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
|
1445 ((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
|
1446 (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
|
1447 (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
|
1448 ;; 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
|
1449 (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
|
1450 (while parts |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1451 (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
|
1452 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
|
1453 (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
|
1454 parts nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1455 (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
|
1456 (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
|
1457 (when (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1458 ((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
|
1459 ((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
|
1460 ((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
|
1461 (and func |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1462 (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
|
1463 (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
|
1464 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
|
1465 (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
|
1466 (t |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1467 (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
|
1468 (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
|
1469 (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
|
1470 (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
|
1471 (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1472 (if func |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1473 (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
|
1474 (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
|
1475 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
|
1476 (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
|
1477 (t nil)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1478 parts)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1479 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1480 (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
|
1481 (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
|
1482 (> (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
|
1483 (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
|
1484 (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
|
1485 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1486 (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
|
1487 (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
|
1488 (> (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
|
1489 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1490 (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
|
1491 (append |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1492 (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
|
1493 handles1 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1494 (list handles1)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1495 (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
|
1496 handles2 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1497 (list handles2)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1498 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1499 (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
|
1500 "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
|
1501 (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
|
1502 (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
|
1503 (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
|
1504 (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
|
1505 (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
|
1506 (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
|
1507 |
31717 | 1508 (provide 'mm-decode) |
1509 | |
57173
353df9943a65
(mm-copy-to-buffer): Preserve the data's unibyteness.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57153
diff
changeset
|
1510 ;; arch-tag: 4f35d360-56b8-4030-9388-3ed82d359b9b |
31717 | 1511 ;;; mm-decode.el ends here |