1 ;;; mm-decode.el --- Functions for decoding MIME things
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
4 ;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
8 ;; This file is part of GNU Emacs.
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 3 of the License, or
13 ;; (at your option) any later version.
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.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 ;; For Emacs <22.2 and XEmacs.
29 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
33 (eval-when-compile (require 'cl)
36 (autoload 'gnus-map-function "gnus-util")
37 (autoload 'gnus-replace-in-string "gnus-util")
38 (autoload 'gnus-read-shell-command "gnus-util")
40 (autoload 'mm-inline-partial "mm-partial")
41 (autoload 'mm-inline-external-body "mm-extern")
42 (autoload 'mm-extern-cache-contents "mm-extern")
43 (autoload 'mm-insert-inline "mm-view")
45 (defvar gnus-current-window-configuration)
47 (add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list)
49 (defgroup mime-display ()
50 "Display of MIME in mail and news articles."
51 :link '(custom-manual "(emacs-mime)Display Customization")
57 (defgroup mime-security ()
58 "MIME security in mail and news articles."
59 :link '(custom-manual "(emacs-mime)Display Customization")
64 ;;; Convenience macros.
66 (defmacro mm-handle-buffer (handle)
68 (defmacro mm-handle-type (handle)
70 (defsubst mm-handle-media-type (handle)
71 (if (stringp (car handle))
73 (car (mm-handle-type handle))))
74 (defsubst mm-handle-media-supertype (handle)
75 (car (split-string (mm-handle-media-type handle) "/")))
76 (defsubst mm-handle-media-subtype (handle)
77 (cadr (split-string (mm-handle-media-type handle) "/")))
78 (defmacro mm-handle-encoding (handle)
80 (defmacro mm-handle-undisplayer (handle)
82 (defmacro mm-handle-set-undisplayer (handle function)
83 `(setcar (nthcdr 3 ,handle) ,function))
84 (defmacro mm-handle-disposition (handle)
86 (defmacro mm-handle-description (handle)
88 (defmacro mm-handle-cache (handle)
90 (defmacro mm-handle-set-cache (handle contents)
91 `(setcar (nthcdr 6 ,handle) ,contents))
92 (defmacro mm-handle-id (handle)
94 (defmacro mm-handle-multipart-original-buffer (handle)
95 `(get-text-property 0 'buffer (car ,handle)))
96 (defmacro mm-handle-multipart-from (handle)
97 `(get-text-property 0 'from (car ,handle)))
98 (defmacro mm-handle-multipart-ctl-parameter (handle parameter)
99 `(get-text-property 0 ,parameter (car ,handle)))
101 (defmacro mm-make-handle (&optional buffer type encoding undisplayer
102 disposition description cache
104 `(list ,buffer ,type ,encoding ,undisplayer
105 ,disposition ,description ,cache ,id))
107 (defcustom mm-text-html-renderer
108 (cond ((fboundp 'libxml-parse-html-region) 'shr)
109 ((executable-find "w3m") 'gnus-w3m)
110 ((executable-find "links") 'links)
111 ((executable-find "lynx") 'lynx)
112 ((locate-library "w3") 'w3)
113 ((locate-library "html2text") 'html2text)
115 "Render of HTML contents.
116 It is one of defined renderer types, or a rendering function.
117 The defined renderer types are:
118 `shr': use Gnus simple HTML renderer;
119 `gnus-w3m' : use Gnus renderer based on w3m;
120 `w3m' : use emacs-w3m;
121 `w3m-standalone': use w3m;
125 `html2text' : use html2text;
126 nil : use external viewer (default web browser)."
128 :type '(choice (const shr)
131 (const w3m :tag "emacs-w3m")
132 (const w3m-standalone :tag "standalone w3m" )
136 (const nil :tag "External viewer")
138 :group 'mime-display)
140 (defcustom mm-inline-text-html-with-images nil
141 "If non-nil, Gnus will allow retrieving images in HTML contents with
142 the <img> tags. It has no effect on Emacs/w3. See also the
143 documentation for the `mm-w3m-safe-url-regexp' variable."
146 :group 'mime-display)
148 (defcustom mm-w3m-safe-url-regexp "\\`cid:"
149 "Regexp matching URLs which are considered to be safe.
150 Some HTML mails might contain a nasty trick used by spammers, using
151 the <img> tag which is far more evil than the [Click Here!] button.
152 It is most likely intended to check whether the ominous spam mail has
153 reached your eyes or not, in which case the spammer knows for sure
154 that your email address is valid. It is done by embedding an
155 identifier string into a URL that you might automatically retrieve
156 when displaying the image. The default value is \"\\\\`cid:\" which only
157 matches parts embedded to the Multipart/Related type MIME contents and
158 Gnus will never connect to the spammer's site arbitrarily. You may
159 set this variable to nil if you consider all urls to be safe."
161 :type '(choice (regexp :tag "Regexp")
162 (const :tag "All URLs are safe" nil))
163 :group 'mime-display)
165 (defcustom mm-inline-text-html-with-w3m-keymap t
166 "If non-nil, use emacs-w3m command keys in the article buffer."
169 :group 'mime-display)
171 (defcustom mm-enable-external t
172 "Indicate whether external MIME handlers should be used.
174 If t, all defined external MIME handlers are used. If nil, files are saved by
175 `mailcap-save-binary-file'. If it is the symbol `ask', you are prompted
176 before the external MIME handler is invoked."
178 :type '(choice (const :tag "Always" t)
179 (const :tag "Never" nil)
180 (const :tag "Ask" ask))
181 :group 'mime-display)
183 (defcustom mm-inline-media-tests
187 (mm-valid-and-fit-image-p 'jpeg handle)))
191 (mm-valid-and-fit-image-p 'png handle)))
195 (mm-valid-and-fit-image-p 'gif handle)))
199 (mm-valid-and-fit-image-p 'tiff handle)) )
203 (mm-valid-and-fit-image-p 'xbm handle)))
207 (mm-valid-and-fit-image-p 'xbm handle)))
211 (mm-valid-and-fit-image-p 'xpm handle)))
215 (mm-valid-and-fit-image-p 'xpm handle)))
219 (mm-valid-and-fit-image-p 'bmp handle)))
220 ("image/x-portable-bitmap"
223 (mm-valid-and-fit-image-p 'pbm handle)))
224 ("text/plain" mm-inline-text identity)
225 ("text/enriched" mm-inline-text identity)
226 ("text/richtext" mm-inline-text identity)
227 ("text/x-patch" mm-display-patch-inline
229 ;; If the diff-mode.el package is installed, the function is
230 ;; autoloaded. Checking (locate-library "diff-mode") would be trying
231 ;; to cater to broken installations. OTOH checking the function
232 ;; makes it possible to install another package which provides an
233 ;; alternative implementation of diff-mode. --Stef
234 (fboundp 'diff-mode)))
235 ;; In case mime.types uses x-diff (as does Debian's mime-support-3.40).
236 ("text/x-diff" mm-display-patch-inline
237 (lambda (handle) (fboundp 'diff-mode)))
238 ("application/emacs-lisp" mm-display-elisp-inline identity)
239 ("application/x-emacs-lisp" mm-display-elisp-inline identity)
240 ("text/dns" mm-display-dns-inline identity)
244 mm-text-html-renderer))
248 (or (featurep 'vcard)
249 (locate-library "vcard"))))
250 ("message/delivery-status" mm-inline-text identity)
251 ("message/rfc822" mm-inline-message identity)
252 ("message/partial" mm-inline-partial identity)
253 ("message/external-body" mm-inline-external-body identity)
254 ("text/.*" mm-inline-text identity)
255 ("audio/wav" mm-inline-audio
257 (and (or (featurep 'nas-sound) (featurep 'native-sound))
258 (device-sound-enabled-p))))
262 (and (or (featurep 'nas-sound) (featurep 'native-sound))
263 (device-sound-enabled-p))))
264 ("application/pgp-signature" ignore identity)
265 ("application/x-pkcs7-signature" ignore identity)
266 ("application/pkcs7-signature" ignore identity)
267 ("application/x-pkcs7-mime" ignore identity)
268 ("application/pkcs7-mime" ignore identity)
269 ("multipart/alternative" ignore identity)
270 ("multipart/mixed" ignore identity)
271 ("multipart/related" ignore identity)
272 ;; Disable audio and image
273 ("audio/.*" ignore ignore)
274 ("image/.*" ignore ignore)
275 ;; Default to displaying as text
276 (".*" mm-inline-text mm-readable-p))
277 "Alist of media types/tests saying whether types can be displayed inline."
278 :type '(repeat (list (regexp :tag "MIME type")
279 (function :tag "Display function")
280 (function :tag "Display test")))
281 :group 'mime-display)
283 (defcustom mm-inlined-types
284 '("image/.*" "text/.*" "message/delivery-status" "message/rfc822"
285 "message/partial" "message/external-body" "application/emacs-lisp"
286 "application/x-emacs-lisp"
287 "application/pgp-signature" "application/x-pkcs7-signature"
288 "application/pkcs7-signature" "application/x-pkcs7-mime"
289 "application/pkcs7-mime"
290 ;; Mutt still uses this even though it has already been withdrawn.
292 "List of media types that are to be displayed inline.
293 See also `mm-inline-media-tests', which says how to display a media
295 :type '(repeat regexp)
296 :group 'mime-display)
298 (defcustom mm-keep-viewer-alive-types
299 '("application/postscript" "application/msword" "application/vnd.ms-excel"
300 "application/pdf" "application/x-dvi")