emacs: Add custom `notmuch-show-elide-same-subject'

[notmuch] / emacs / notmuch-show.el

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 72c87a1f9943a8a6bf1e6a960019e0cef9cb8569..9c174e25e85576640a549f78924f6377bd91a566 100644 (file)
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -64,6 +64,17 @@ any given message."
   :group 'notmuch
   :type 'boolean)
 
+(defcustom notmuch-show-elide-same-subject nil
+  "Do not show the subject of a collapsed message if it is the
+same as that of the previous message."
+  :group 'notmuch
+  :type 'boolean)
+
+(defcustom notmuch-show-always-show-subject t
+  "Should a collapsed message show the `Subject:' line?"
+  :group 'notmuch
+  :type 'boolean)
+
 (defvar notmuch-show-markup-headers-hook '(notmuch-show-colour-headers)
   "A list of functions called to decorate the headers listed in
 `notmuch-message-headers'.")
@@ -83,6 +94,12 @@ any given message."
             notmuch-wash-elide-blank-lines
             notmuch-wash-excerpt-citations))
 
+;; Mostly useful for debugging.
+(defcustom notmuch-show-all-multipart/alternative-parts nil
+  "Should all parts of multipart/alternative parts be shown?"
+  :group 'notmuch
+  :type 'boolean)
+
 (defcustom notmuch-show-indent-multipart nil
   "Should the sub-parts of a multipart/* part be indented?"
   ;; dme: Not sure which is a good default.
@@ -319,7 +336,8 @@ current buffer, if possible."
     ;; should be chosen if there are more than one that match?
     (mapc (lambda (inner-part)
            (let ((inner-type (plist-get inner-part :content-type)))
-             (if (string= chosen-type inner-type)
+             (if (or notmuch-show-all-multipart/alternative-parts
+                     (string= chosen-type inner-type))
                  (notmuch-show-insert-bodypart msg inner-part depth)
                (notmuch-show-insert-part-header (plist-get inner-part :id) inner-type inner-type nil " (not shown)"))))
          inner-parts)
@@ -328,6 +346,85 @@ current buffer, if possible."
       (indent-rigidly start (point) 1)))
   t)
 
+(defun notmuch-show-setup-w3m ()
+  "Instruct w3m how to retrieve content from a \"related\" part of a message."
+  (interactive)
+  (if (boundp 'w3m-cid-retrieve-function-alist)
+    (unless (assq 'notmuch-show-mode w3m-cid-retrieve-function-alist)
+      (push (cons 'notmuch-show-mode 'notmuch-show-w3m-cid-retrieve)
+           w3m-cid-retrieve-function-alist)))
+  (setq mm-inline-text-html-with-images t))
+
+(defvar w3m-current-buffer) ;; From `w3m.el'.
+(defvar notmuch-show-w3m-cid-store nil)
+(make-variable-buffer-local 'notmuch-show-w3m-cid-store)
+
+(defun notmuch-show-w3m-cid-store-internal (content-id
+                                           message-id
+                                           part-number
+                                           content-type
+                                           content)
+  (push (list content-id
+             message-id
+             part-number
+             content-type
+             content)
+       notmuch-show-w3m-cid-store))
+
+(defun notmuch-show-w3m-cid-store (msg part)
+  (let ((content-id (plist-get part :content-id)))
+    (when content-id
+      (notmuch-show-w3m-cid-store-internal (concat "cid:" content-id)
+                                          (plist-get msg :id)
+                                          (plist-get part :id)
+                                          (plist-get part :content-type)
+                                          nil))))
+
+(defun notmuch-show-w3m-cid-retrieve (url &rest args)
+  (let ((matching-part (with-current-buffer w3m-current-buffer
+                        (assoc url notmuch-show-w3m-cid-store))))
+    (if matching-part
+       (let ((message-id (nth 1 matching-part))
+             (part-number (nth 2 matching-part))
+             (content-type (nth 3 matching-part))
+             (content (nth 4 matching-part)))
+         ;; If we don't already have the content, get it and cache
+         ;; it, as some messages reference the same cid: part many
+         ;; times (hundreds!), which results in many calls to
+         ;; `notmuch part'.
+         (unless content
+           (setq content (notmuch-show-get-bodypart-internal (concat "id:" message-id)
+                                                             part-number))
+           (with-current-buffer w3m-current-buffer
+             (notmuch-show-w3m-cid-store-internal url
+                                                  message-id
+                                                  part-number
+                                                  content-type
+                                                  content)))
+         (insert content)
+         content-type)
+      nil)))
+
+(defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth declared-type)
+  (notmuch-show-insert-part-header nth declared-type content-type nil)
+  (let ((inner-parts (plist-get part :content))
+       (start (point)))
+
+    ;; We assume that the first part is text/html and the remainder
+    ;; things that it references.
+
+    ;; Stash the non-primary parts.
+    (mapc (lambda (part)
+           (notmuch-show-w3m-cid-store msg part))
+         (cdr inner-parts))
+
+    ;; Render the primary part.
+    (notmuch-show-insert-bodypart msg (car inner-parts) depth)
+
+    (when notmuch-show-indent-multipart
+      (indent-rigidly start (point) 1)))
+  t)
+
 (defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth declared-type)
   (notmuch-show-insert-part-header nth declared-type content-type nil)
   (let ((inner-parts (plist-get part :content))
@@ -535,8 +632,9 @@ current buffer, if possible."
       ;; If the subject of this message is the same as that of the
       ;; previous message, don't display it when this message is
       ;; collapsed.
-      (when (not (string= notmuch-show-previous-subject
-                         bare-subject))
+      (when (and notmuch-show-elide-same-subject
+                (not (string= notmuch-show-previous-subject
+                              bare-subject)))
        (forward-line 1))
       (setq headers-start (point-marker)))
     (setq headers-end (point-marker))