emacs: Add `notmuch-show-multipart/alternative-discouraged'.

Also improved implementation of indication of which parts are
not shown.

Signed-off-by: Jameson Rollins <jrollins@finestructure.net>

1 files changed, 34 insertions, 12 deletions

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index e08497d9..a6a43bb5 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -236,7 +236,7 @@ message at DEPTH in the current thread."
   'follow-link t
   'face 'message-mml)
 
-(defun notmuch-show-insert-part-header (nth content-type declared-type &optional name)
+(defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment)
   (insert-button
    (concat "[ "
 	   (if name (concat name ": ") "")
@@ -244,6 +244,7 @@ message at DEPTH in the current thread."
 	   (if (not (string-equal declared-type content-type))
 	       (concat " (as " content-type ")")
 	     "")
+	   (or comment "")
 	   " ]\n")
    :type 'notmuch-show-part-button-type
    :notmuch-part nth
@@ -280,19 +281,40 @@ current buffer, if possible."
 	      t)
 	  nil)))))
 
+(defvar notmuch-show-multipart/alternative-discouraged
+  '(
+    ;; Avoid HTML parts.
+    "text/html"
+    ;; multipart/related usually contain a text/html part and some associated graphics.
+    "multipart/related"
+    ))
+
+(defun notmuch-show-multipart/*-to-list (part)
+  (mapcar '(lambda (inner-part) (plist-get inner-part :content-type))
+	  (plist-get part :content)))
+
+(defun notmuch-show-multipart/alternative-choose (types)
+  ;; Based on `mm-preferred-alternative-precedence'.
+  (let ((seq types))
+    (dolist (pref (reverse notmuch-show-multipart/alternative-discouraged))
+      (dolist (elem (copy-sequence seq))
+	(when (string-match pref elem)
+	  (setq seq (nconc (delete elem seq) (list elem))))))
+    seq))
+
 (defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth declared-type)
-  (let ((inner-parts (plist-get part :content)))
-    (notmuch-show-insert-part-header nth declared-type content-type nil)
-    ;; In most cases, multipart/alternative is used to provide both
-    ;; text/plain and text/html (or multipart/related with text/html
-    ;; and image/*) parts. We might allow the user to express a
-    ;; preference about which part to show, but for the moment we just
-    ;; choose the first. This is usually the text/plain part.
-    (notmuch-show-insert-bodypart msg (car inner-parts) depth)
+  (notmuch-show-insert-part-header nth declared-type content-type nil)
+  (let ((chosen-type (car (notmuch-show-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))
+	(inner-parts (plist-get part :content)))
+    ;; This inserts all parts of the chosen type rather than just one,
+    ;; but it's not clear that this is the wrong thing to do - which
+    ;; should be chosen if there are more than one that match?
     (mapc (lambda (inner-part)
-	    (let ((inner-type (concat (plist-get inner-part :content-type) " (not shown)")))
-	      (notmuch-show-insert-part-header (plist-get inner-part :id) inner-type inner-type nil)))
-	  (cdr inner-parts)))
+	    (let ((inner-type (plist-get inner-part :content-type)))
+	      (if (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))
   t)
 
 (defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth declared-type)