NEWS: bump date

[notmuch] / emacs / notmuch-show.el

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 34dcedd28459cb92b640a4d8162be1fc38ed2ab7..2a53461ee64290c2f25f2faee5b4f456003d735e 100644 (file)
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -99,6 +99,13 @@ visible for any given message."
   :group 'notmuch-show
   :group 'notmuch-hooks)
 
+(defcustom notmuch-show-max-text-part-size 10000
+  "Maximum size of a text part to be shown by default in characters.
+
+Set to 0 to show the part regardless of size."
+  :type 'integer
+  :group 'notmuch-show)
+
 ;; Mostly useful for debugging.
 (defcustom notmuch-show-all-multipart/alternative-parts nil
   "Should all parts of multipart/alternative parts be shown?"
@@ -136,6 +143,13 @@ indentation."
   :type 'boolean
   :group 'notmuch-show)
 
+;; By default, block all external images to prevent privacy leaks and
+;; potential attacks.
+(defcustom notmuch-show-text/html-blocked-images "."
+  "Remote images that have URLs matching this regexp will be blocked."
+  :type '(choice (const nil) regexp)
+  :group 'notmuch-show)
+
 (defvar notmuch-show-thread-id nil)
 (make-variable-buffer-local 'notmuch-show-thread-id)
 (put 'notmuch-show-thread-id 'permanent-local t)
@@ -767,14 +781,46 @@ will return nil if the CID is unknown or cannot be retrieved."
          nil))))
 
 (defun notmuch-show-insert-part-text/html (msg part content-type nth depth button)
-  ;; text/html handler to work around bugs in renderers and our
-  ;; invisibile parts code. In particular w3m sets up a keymap which
-  ;; "leaks" outside the invisible region and causes strange effects
-  ;; in notmuch. We set mm-inline-text-html-with-w3m-keymap to nil to
-  ;; tell w3m not to set a keymap (so the normal notmuch-show-mode-map
-  ;; remains).
-  (let ((mm-inline-text-html-with-w3m-keymap nil))
-    (notmuch-show-insert-part-*/* msg part content-type nth depth button)))
+  (if (eq mm-text-html-renderer 'shr)
+      ;; It's easier to drive shr ourselves than to work around the
+      ;; goofy things `mm-shr' does (like irreversibly taking over
+      ;; content ID handling).
+
+      ;; FIXME: If we block an image, offer a button to load external
+      ;; images.
+      (let ((shr-blocked-images notmuch-show-text/html-blocked-images))
+       (notmuch-show--insert-part-text/html-shr msg part))
+    ;; Otherwise, let message-mode do the heavy lifting
+    ;;
+    ;; w3m sets up a keymap which "leaks" outside the invisible region
+    ;; and causes strange effects in notmuch. We set
+    ;; mm-inline-text-html-with-w3m-keymap to nil to tell w3m not to
+    ;; set a keymap (so the normal notmuch-show-mode-map remains).
+    (let ((mm-inline-text-html-with-w3m-keymap nil)
+         ;; FIXME: If we block an image, offer a button to load external
+         ;; images.
+         (gnus-blocked-images notmuch-show-text/html-blocked-images))
+      (notmuch-show-insert-part-*/* msg part content-type nth depth button))))
+
+;; These functions are used by notmuch-show--insert-part-text/html-shr
+(declare-function libxml-parse-html-region "xml.c")
+(declare-function shr-insert-document "shr")
+
+(defun notmuch-show--insert-part-text/html-shr (msg part)
+  ;; Make sure shr is loaded before we start let-binding its globals
+  (require 'shr)
+  (let ((dom (let ((process-crypto notmuch-show-process-crypto))
+              (with-temp-buffer
+                (insert (notmuch-get-bodypart-text msg part process-crypto))
+                (libxml-parse-html-region (point-min) (point-max)))))
+       (shr-content-function
+        (lambda (url)
+          ;; shr strips the "cid:" part of URL, but doesn't
+          ;; URL-decode it (see RFC 2392).
+          (let ((cid (url-unhex-string url)))
+            (first (notmuch-show--get-cid-content cid))))))
+    (shr-insert-document dom)
+    t))
 
 (defun notmuch-show-insert-part-*/* (msg part content-type nth depth button)
   ;; This handler _must_ succeed - it is the handler of last resort.
@@ -898,14 +944,20 @@ useful for quoting in replies)."
                             "text/x-diff")
                        content-type))
         (nth (plist-get part :id))
+        (long (and (notmuch-match-content-type mime-type "text/*")
+                   (> notmuch-show-max-text-part-size 0)
+                   (> (length (plist-get part :content)) notmuch-show-max-text-part-size)))
         (beg (point))
-        ;; Hide the part initially if HIDE is t.
-        (show-part (not (equal hide t)))
         ;; We omit the part button for the first (or only) part if
         ;; this is text/plain, or HIDE is 'no-buttons.
         (button (unless (or (equal hide 'no-buttons)
                             (and (string= mime-type "text/plain") (<= nth 1)))
                   (notmuch-show-insert-part-header nth mime-type content-type (plist-get part :filename))))
+        ;; Hide the part initially if HIDE is t, or if it is too long
+        ;; and we have a button to allow toggling (thus reply which
+        ;; uses 'no-buttons automatically includes long parts)
+        (show-part (not (or (equal hide t)
+                            (and long button))))
         (content-beg (point)))
 
     ;; Store the computed mime-type for later use (e.g. by attachment handlers).