;;; 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>
(require 'mail-parse)
(require 'mm-bodies)
+(require 'mm-archive)
(eval-when-compile (require 'cl)
(require 'term))
"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;
-`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)
("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)
("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).
- ("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/javascript" mm-display-javascript-inline identity)
("text/dns" mm-display-dns-inline identity)
("text/x-org" mm-display-org-inline identity)
("text/html"
("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)
(\"text/html\" \"text/richtext\")
Adding \"image/.*\" might also be useful. Spammers use it as the
-prefered part of multipart/alternative messages. See also
+preferred 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'.
(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")
(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))
;; 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))
(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)
(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))))
(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
(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
projects / gnus / blobdiff