projects
/
gnus
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
* mm-decode.el (mm-dissect-singlepart): Check that the decoder exists.
[gnus]
/
lisp
/
mm-decode.el
diff --git
a/lisp/mm-decode.el
b/lisp/mm-decode.el
index
40cfa9b
..
e6407cf
100644
(file)
--- a/
lisp/mm-decode.el
+++ b/
lisp/mm-decode.el
@@
-1,7
+1,6
@@
;;; mm-decode.el --- Functions for decoding MIME things
;;; mm-decode.el --- Functions for decoding MIME things
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;; 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@
-30,6
+29,7
@@
(require 'mail-parse)
(require 'mm-bodies)
(require 'mail-parse)
(require 'mm-bodies)
+(require 'mm-archive)
(eval-when-compile (require 'cl)
(require 'term))
(eval-when-compile (require 'cl)
(require 'term))
@@
-115,14
+115,14
@@
"Render of HTML contents.
It is one of defined renderer types, or a rendering function.
The defined renderer types are:
"Render of HTML contents.
It is one of defined renderer types, or a rendering function.
The defined renderer types are:
-`shr': use
Gnus simple
HTML renderer;
-`gnus-w3m'
: use Gnus renderer based on w3m;
-`w3m'
: use emacs-w3m;
-`w3m-standalone': use w3m;
+`shr': use
the built-in Gnus
HTML renderer;
+`gnus-w3m': use Gnus renderer based on w3m;
+`w3m': use emacs-w3m;
+`w3m-standalone': use
plain
w3m;
`links': use links;
`links': use links;
-`lynx'
: use lynx;
-`w3'
: use Emacs/W3;
-`html2text'
: use html2text;
+`lynx': use lynx;
+`w3': use Emacs/W3;
+`html2text': use html2text;
nil : use external viewer (default web browser)."
:version "24.1"
:type '(choice (const shr)
nil : use external viewer (default web browser)."
:version "24.1"
:type '(choice (const shr)
@@
-196,7
+196,7
@@
before the external MIME handler is invoked."
("image/tiff"
mm-inline-image
(lambda (handle)
("image/tiff"
mm-inline-image
(lambda (handle)
- (mm-valid-and-fit-image-p 'tiff handle))
)
+ (mm-valid-and-fit-image-p 'tiff handle)))
("image/xbm"
mm-inline-image
(lambda (handle)
("image/xbm"
mm-inline-image
(lambda (handle)
@@
-224,24
+224,17
@@
before the external MIME handler is invoked."
("text/plain" mm-inline-text identity)
("text/enriched" mm-inline-text identity)
("text/richtext" mm-inline-text identity)
("text/plain" mm-inline-text identity)
("text/enriched" mm-inline-text identity)
("text/richtext" mm-inline-text identity)
- ("text/x-patch" mm-display-patch-inline
- (lambda (handle)
- ;; If the diff-mode.el package is installed, the function is
- ;; autoloaded. Checking (locate-library "diff-mode") would be trying
- ;; to cater to broken installations. OTOH checking the function
- ;; makes it possible to install another package which provides an
- ;; alternative implementation of diff-mode. --Stef
- (fboundp 'diff-mode)))
+ ("text/x-patch" mm-display-patch-inline identity)
;; In case mime.types uses x-diff (as does Debian's mime-support-3.40).
;; In case mime.types uses x-diff (as does Debian's mime-support-3.40).
- ("text/x-diff" mm-display-patch-inline
- (lambda (handle) (fboundp 'diff-mode)))
+ ("text/x-diff" mm-display-patch-inline identity)
("application/emacs-lisp" mm-display-elisp-inline identity)
("application/x-emacs-lisp" mm-display-elisp-inline identity)
("application/x-shellscript" mm-display-shell-script-inline identity)
("application/x-sh" mm-display-shell-script-inline identity)
("text/x-sh" mm-display-shell-script-inline identity)
("application/emacs-lisp" mm-display-elisp-inline identity)
("application/x-emacs-lisp" mm-display-elisp-inline identity)
("application/x-shellscript" mm-display-shell-script-inline identity)
("application/x-sh" mm-display-shell-script-inline identity)
("text/x-sh" mm-display-shell-script-inline identity)
+ ("application/javascript" mm-display-javascript-inline identity)
("text/dns" mm-display-dns-inline identity)
("text/dns" mm-display-dns-inline identity)
- ("text/org" mm-display-org-inline identity)
+ ("text/
x-
org" mm-display-org-inline identity)
("text/html"
mm-inline-text-html
(lambda (handle)
("text/html"
mm-inline-text-html
(lambda (handle)
@@
-273,6
+266,20
@@
before the external MIME handler is invoked."
("multipart/alternative" ignore identity)
("multipart/mixed" ignore identity)
("multipart/related" ignore identity)
("multipart/alternative" ignore identity)
("multipart/mixed" ignore identity)
("multipart/related" ignore identity)
+ ("image/.*"
+ mm-inline-image
+ (lambda (handle)
+ (and (mm-valid-image-format-p 'imagemagick)
+ (mm-with-unibyte-buffer
+ (mm-insert-part handle)
+ (let ((image
+ (ignore-errors
+ (if (fboundp 'create-image)
+ (create-image (buffer-string) 'imagemagick 'data-p)
+ (mm-create-image-xemacs (mm-handle-media-subtype handle))))))
+ (when image
+ (setcar (cdr handle) (list "image/imagemagick"))
+ (mm-image-fit-p handle)))))))
;; Disable audio and image
("audio/.*" ignore ignore)
("image/.*" ignore ignore)
;; Disable audio and image
("audio/.*" ignore ignore)
("image/.*" ignore ignore)
@@
-318,7
+325,7
@@
when selecting a different article."
"application/pkcs7-mime"
;; Mutt still uses this even though it has already been withdrawn.
"application/pgp\\'"
"application/pkcs7-mime"
;; Mutt still uses this even though it has already been withdrawn.
"application/pgp\\'"
- "text/org")
+ "text/
x-
org")
"A list of MIME types to be displayed automatically."
:type '(repeat regexp)
:group 'mime-display)
"A list of MIME types to be displayed automatically."
:type '(repeat regexp)
:group 'mime-display)
@@
-354,7
+361,7
@@
to:
(\"text/html\" \"text/richtext\")
Adding \"image/.*\" might also be useful. Spammers use it as the
(\"text/html\" \"text/richtext\")
Adding \"image/.*\" might also be useful. Spammers use it as the
-prefered part of multipart/alternative messages. See also
+prefer
r
ed part of multipart/alternative messages. See also
`gnus-buttonized-mime-types', to which adding \"multipart/alternative\"
enables you to choose manually one of two types those mails include."
:type '(repeat regexp) ;; See `mm-preferred-alternative-precedence'.
`gnus-buttonized-mime-types', to which adding \"multipart/alternative\"
enables you to choose manually one of two types those mails include."
:type '(repeat regexp) ;; See `mm-preferred-alternative-precedence'.
@@
-572,7
+579,13
@@
Postpone undisplaying of viewers for types in
(setq ct (mail-fetch-field "content-type")
ctl (and ct (mail-header-parse-content-type ct))
cte (mail-fetch-field "content-transfer-encoding")
(setq ct (mail-fetch-field "content-type")
ctl (and ct (mail-header-parse-content-type ct))
cte (mail-fetch-field "content-transfer-encoding")
- cd (mail-fetch-field "content-disposition")
+ cd (or (mail-fetch-field "content-disposition")
+ (when (and ctl
+ (eq 'mm-inline-text
+ (cadr (mm-assoc-string-match
+ mm-inline-media-tests
+ (car ctl)))))
+ "inline"))
;; Newlines in description should be stripped so as
;; not to break the MIME tag into two or more lines.
description (message-fetch-field "content-description")
;; Newlines in description should be stripped so as
;; not to break the MIME tag into two or more lines.
description (message-fetch-field "content-description")
@@
-641,8
+654,14
@@
Postpone undisplaying of viewers for types in
(if (equal "text/plain" (car ctl))
(assoc 'format ctl)
t))
(if (equal "text/plain" (car ctl))
(assoc 'format ctl)
t))
- (mm-make-handle
- (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
+ (let ((handle
+ (mm-make-handle
+ (mm-copy-to-buffer) ctl cte nil cdl description nil id))
+ (decoder (assoc (car ctl) mm-archive-decoders)))
+ (if (and decoder
+ (executable-find (cadr decoder)))
+ (mm-dissect-archive handle)
+ handle))))
(defun mm-dissect-multipart (ctl from)
(goto-char (point-min))
(defun mm-dissect-multipart (ctl from)
(goto-char (point-min))
@@
-930,7
+949,7
@@
external if displayed external."
;; In particular, the timer object (which is
;; a vector in Emacs but is a list in XEmacs)
;; requires that it is lexically scoped.
;; In particular, the timer object (which is
;; a vector in Emacs but is a list in XEmacs)
;; requires that it is lexically scoped.
- (timer (run-at-time
2
.0 nil 'ignore)))
+ (timer (run-at-time
30
.0 nil 'ignore)))
(if (featurep 'xemacs)
(lambda (process state)
(when (eq 'exit (process-status process))
(if (featurep 'xemacs)
(lambda (process state)
(when (eq 'exit (process-status process))
@@
-1341,7
+1360,7
@@
Use CMD as the process."
(mailcap-mime-info type 'all)))
(method (let ((minibuffer-local-completion-map
mm-viewer-completion-map))
(mailcap-mime-info type 'all)))
(method (let ((minibuffer-local-completion-map
mm-viewer-completion-map))
- (
gnus-completing-read "Viewer
" methods))))
+ (
completing-read "Viewer:
" methods))))
(when (string= method "")
(error "No method given"))
(if (string-match "^[^% \t]+$" method)
(when (string= method "")
(error "No method given"))
(if (string-match "^[^% \t]+$" method)
@@
-1379,9
+1398,10
@@
Use CMD as the process."
(setq handles (nconc (delete handle handles) (list handle))))))
;; Remove empty parts.
(dolist (handle (copy-sequence handles))
(setq handles (nconc (delete handle handles) (list handle))))))
;; Remove empty parts.
(dolist (handle (copy-sequence handles))
- (unless (with-current-buffer (mm-handle-buffer handle)
- (goto-char (point-min))
- (re-search-forward "[^ \t\n]" nil t))
+ (when (and (bufferp (mm-handle-buffer handle))
+ (not (with-current-buffer (mm-handle-buffer handle)
+ (goto-char (point-min))
+ (re-search-forward "[^ \t\n]" nil t))))
(setq handles (nconc (delete handle handles) (list handle)))))
(mapcar #'mm-handle-media-type handles))
(setq handles (nconc (delete handle handles) (list handle)))))
(mapcar #'mm-handle-media-type handles))
@@
-1481,7
+1501,7
@@
be determined."
(or (not image)
(if (featurep 'xemacs)
;; XEmacs' glyphs can actually tell us about their width, so
(or (not image)
(if (featurep 'xemacs)
;; XEmacs' glyphs can actually tell us about their width, so
- ;; lets be nice and smart about them.
+ ;; let
'
s be nice and smart about them.
(or mm-inline-large-images
(and (<= (glyph-width image) (window-pixel-width))
(<= (glyph-height image) (window-pixel-height))))
(or mm-inline-large-images
(and (<= (glyph-width image) (window-pixel-width))
(<= (glyph-height image) (window-pixel-height))))
@@
-1711,6
+1731,7
@@
If RECURSIVE, search recursively."
(buffer-string))))))
shr-inhibit-images shr-blocked-images charset char)
(if (and (boundp 'gnus-summary-buffer)
(buffer-string))))))
shr-inhibit-images shr-blocked-images charset char)
(if (and (boundp 'gnus-summary-buffer)
+ (bufferp gnus-summary-buffer)
(buffer-name gnus-summary-buffer))
(with-current-buffer gnus-summary-buffer
(setq shr-inhibit-images gnus-inhibit-images
(buffer-name gnus-summary-buffer))
(with-current-buffer gnus-summary-buffer
(setq shr-inhibit-images gnus-inhibit-images
@@
-1751,6
+1772,13
@@
If RECURSIVE, search recursively."
(delete-region ,(point-min-marker)
,(point-max-marker))))))))
(delete-region ,(point-min-marker)
,(point-max-marker))))))))
+(defun mm-handle-filename (handle)
+ "Return filename of HANDLE if any."
+ (or (mail-content-type-get (mm-handle-type handle)
+ 'name)
+ (mail-content-type-get (mm-handle-disposition handle)
+ 'filename)))
+
(provide 'mm-decode)
;;; mm-decode.el ends here
(provide 'mm-decode)
;;; mm-decode.el ends here