X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=3d8431a6e90f5f04b571ba5e8ce7bbe6f608d39e;hp=9f045d7d2fdb26d5fdb9f4293d094c93644d5363;hb=31bd2872c36d744d0b5081dc3aefaad26d7e2858;hpb=362ab047c264ae67ec3de041aec637979077db21

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 9f045d7d..3d8431a6 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -26,6 +26,7 @@
 (require 'message)
 (require 'mm-decode)
 (require 'mailcap)
+(require 'icalendar)
 
 (require 'notmuch-lib)
 (require 'notmuch-query)
@@ -82,6 +83,18 @@ 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.
+  :group 'notmuch
+  :type 'boolean)
+
 (defmacro with-current-notmuch-show-message (&rest body)
   "Evaluate body with current buffer set to the text of current message"
   `(save-excursion
@@ -236,7 +249,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 +257,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,9 +294,72 @@ 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)
+  (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))
+	(start (point)))
+    ;; 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 (plist-get inner-part :content-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)
+
+    (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)
-  (let ((inner-parts (plist-get part :content)))
+  (notmuch-show-insert-part-header nth declared-type content-type nil)
+  (let ((inner-parts (plist-get part :content))
+	(start (point)))
+    ;; Show all of the parts.
+    (mapc (lambda (inner-part)
+	    (notmuch-show-insert-bodypart msg inner-part depth))
+	  inner-parts)
+
+    (when notmuch-show-indent-multipart
+      (indent-rigidly start (point) 1)))
+  t)
+
+(defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth declared-type)
+  (let* ((message-part (plist-get part :content))
+	 (inner-parts (plist-get message-part :content)))
     (notmuch-show-insert-part-header nth declared-type content-type nil)
+    ;; Override `notmuch-message-headers' to force `From' to be
+    ;; displayed.
+    (let ((notmuch-message-headers '("From" "Subject" "To" "Cc" "Date")))
+      (notmuch-show-insert-headers (plist-get part :headers)))
+    ;; Blank line after headers to be compatible with the normal
+    ;; message display.
+    (insert "\n")
+
     ;; Show all of the parts.
     (mapc (lambda (inner-part)
 	    (notmuch-show-insert-bodypart msg inner-part depth))
@@ -302,6 +379,24 @@ current buffer, if possible."
 	(run-hook-with-args 'notmuch-show-insert-text/plain-hook depth))))
   t)
 
+(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth declared-type)
+  (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))
+  (insert (with-temp-buffer
+	    (insert (notmuch-show-get-bodypart-content msg part nth))
+	    (goto-char (point-min))
+	    (let ((file (make-temp-file "notmuch-ical"))
+		  result)
+	      (icalendar--convert-ical-to-diary
+	       (icalendar--read-element nil nil)
+	       file t)
+	      (set-buffer (get-file-buffer file))
+	      (setq result (buffer-substring (point-min) (point-max)))
+	      (set-buffer-modified-p nil)
+	      (kill-buffer (current-buffer))
+	      (delete-file file)
+	      result)))
+  t)
+
 (defun notmuch-show-insert-part-application/octet-stream (msg part content-type nth depth declared-type)
   ;; If we can deduce a MIME type from the filename of the attachment,
   ;; do so and pass it on to the handler for that type.