;;; mm-decode.el --- Functions for decoding MIME things
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
("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"
mm-inline-text-html
(lambda (handle)
"application/pkcs7-signature" "application/x-pkcs7-mime"
"application/pkcs7-mime"
;; Mutt still uses this even though it has already been withdrawn.
- "application/pgp\\'")
+ "application/pgp\\'"
+ "text/x-org")
"A list of MIME types to be displayed automatically."
:type '(repeat regexp)
:group 'mime-display)
no-strict-mime
(and cd (mail-header-parse-content-disposition cd))
description id)
- ctl))))
+ ctl from))))
(when id
(when (string-match " *<\\(.*\\)> *" id)
(setq id (match-string 1 id)))
(save-restriction
(narrow-to-region start end)
(setq parts (nconc (list (mm-dissect-buffer t nil from)) parts)))))
- (mm-possibly-verify-or-decrypt (nreverse parts) ctl)))
+ (mm-possibly-verify-or-decrypt (nreverse parts) ctl from)))
(defun mm-copy-to-buffer ()
"Copy the contents of the current buffer to a fresh buffer."
(defun mm-preferred-alternative-precedence (handles)
"Return the precedence based on HANDLES and `mm-discouraged-alternatives'."
- (let ((seq (nreverse (mapcar #'mm-handle-media-type
- handles))))
- (dolist (disc (reverse mm-discouraged-alternatives))
- (dolist (elem (copy-sequence seq))
- (when (string-match disc elem)
- (setq seq (nconc (delete elem seq) (list elem))))))
- seq))
+ (setq handles (reverse handles))
+ (dolist (disc (reverse mm-discouraged-alternatives))
+ (dolist (handle (copy-sequence handles))
+ (when (string-match disc (mm-handle-media-type handle))
+ (setq handles (nconc (delete handle handles) (list handle))))))
+ ;; Remove empty parts.
+ (dolist (handle (copy-sequence handles))
+ (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))
(defun mm-get-content-id (id)
"Return the handle(s) referred to by ID."
(autoload 'mm-view-pkcs7 "mm-view")
-(defun mm-possibly-verify-or-decrypt (parts ctl)
+(defun mm-possibly-verify-or-decrypt (parts ctl &optional from)
(let ((type (car ctl))
(subtype (cadr (split-string (car ctl) "/")))
(mm-security-handle ctl) ;; (car CTL) is the type.
((eq mm-decrypt-option 'known) t)
(t (y-or-n-p
(format "Decrypt (S/MIME) part? "))))
- (mm-view-pkcs7 parts))
+ (mm-view-pkcs7 parts from))
(setq parts (mm-dissect-buffer t)))))
((equal subtype "signed")
(unless (and (setq protocol
(start end &optional base-url))
(declare-function shr-insert-document "shr" (dom))
(defvar shr-blocked-images)
+(defvar gnus-inhibit-images)
(autoload 'gnus-blocked-images "gnus-art")
(defun mm-shr (handle)
;; Require since we bind its variables.
(require 'shr)
(let ((article-buffer (current-buffer))
- (shr-blocked-images (if (and (boundp 'gnus-summary-buffer)
- (buffer-name gnus-summary-buffer))
- (with-current-buffer gnus-summary-buffer
- (gnus-blocked-images))
- shr-blocked-images))
(shr-content-function (lambda (id)
(let ((handle (mm-get-content-id id)))
(when handle
(mm-with-part handle
(buffer-string))))))
- charset)
+ shr-inhibit-images shr-blocked-images charset char)
+ (if (and (boundp 'gnus-summary-buffer)
+ (buffer-name gnus-summary-buffer))
+ (with-current-buffer gnus-summary-buffer
+ (setq shr-inhibit-images gnus-inhibit-images
+ shr-blocked-images (gnus-blocked-images)))
+ (setq shr-inhibit-images gnus-inhibit-images
+ shr-blocked-images (gnus-blocked-images)))
(unless handle
(setq handle (mm-dissect-buffer t)))
(setq charset (mail-content-type-get (mm-handle-type handle) 'charset))
(narrow-to-region (point) (point))
(shr-insert-document
(mm-with-part handle
- (when (and charset
- (setq charset (mm-charset-to-coding-system charset))
- (not (eq charset 'ascii)))
- (insert (prog1
- (mm-decode-coding-string (buffer-string) charset)
- (erase-buffer)
- (mm-enable-multibyte))))
+ (insert (prog1
+ (if (and charset
+ (setq charset
+ (mm-charset-to-coding-system charset))
+ (not (eq charset 'ascii)))
+ (mm-decode-coding-string (buffer-string) charset)
+ (mm-string-as-multibyte (buffer-string)))
+ (erase-buffer)
+ (mm-enable-multibyte)))
+ (goto-char (point-min))
+ (setq case-fold-search t)
+ (while (re-search-forward
+ "&#\\(?:x\\([89][0-9a-f]\\)\\|\\(1[2-5][0-9]\\)\\);" nil t)
+ (when (setq char
+ (cdr (assq (if (match-beginning 1)
+ (string-to-number (match-string 1) 16)
+ (string-to-number (match-string 2)))
+ mm-extra-numeric-entities)))
+ (replace-match (char-to-string char))))
(libxml-parse-html-region (point-min) (point-max))))
(mm-handle-set-undisplayer
handle