X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=9c174e25e85576640a549f78924f6377bd91a566;hp=b208003277f4181a7433e4cb10dcbc3d4e40ef15;hb=4f04d2734f5e6a765aac05dbb205565774782123;hpb=f35813df38c811f35a654cc6e949a21a303a334b diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index b2080032..9c174e25 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) @@ -63,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'.") @@ -82,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. @@ -318,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) @@ -327,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)) @@ -371,6 +469,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. @@ -516,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))