X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmm-decode.el;h=3909e12186fb55f9fb7500049c449e63f5585ad4;hb=d7925de009d5e3047e07e52657d7312d9f97979c;hp=f3c04cee4f80d956ef72a83cc7d37db5691d79d0;hpb=5ff762eb86582d92b995918dffb65a9669783b9e;p=gnus diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index f3c04cee4..3909e1218 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -1,7 +1,6 @@ ;;; 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 ;; MORIOKA Tomohiko @@ -224,20 +223,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/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) @@ -313,7 +309,8 @@ when selecting a different article." "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) @@ -624,7 +621,7 @@ Postpone undisplaying of viewers for types in 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))) @@ -666,7 +663,7 @@ Postpone undisplaying of viewers for types in (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." @@ -1251,11 +1248,13 @@ PROMPT overrides the default one used to ask user for a file name." (setq filename (gnus-map-function mm-file-name-rewrite-functions (file-name-nondirectory filename)))) (setq file - (read-file-name (or prompt - (format "Save MIME part to (default %s): " - (or filename ""))) - (or mm-default-directory default-directory) - (or filename ""))) + (read-file-name + (or prompt + (format "Save MIME part to (default %s): " + (or filename ""))) + (or mm-default-directory default-directory) + (expand-file-name (or filename "") + (or mm-default-directory default-directory)))) (if (file-directory-p file) (setq file (expand-file-name filename file)) (setq file (expand-file-name @@ -1365,13 +1364,19 @@ Use CMD as the process." (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." @@ -1567,7 +1572,7 @@ If RECURSIVE, search recursively." (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. @@ -1582,7 +1587,7 @@ If RECURSIVE, search recursively." ((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 @@ -1685,23 +1690,26 @@ If RECURSIVE, search recursively." (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)) @@ -1709,13 +1717,25 @@ If RECURSIVE, search recursively." (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