X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=93c5e53b2d235e0ead9b321011149183422216d1;hp=3a60d4308470c5643975741d21912c4ac49d89bc;hb=784649561abb627a9d81e4f718656dad0b6b6207;hpb=75d616c6caa0e0ac51c34371ebee7574dbea2952 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index 3a60d430..93c5e53b 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,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 @@ -198,12 +222,30 @@ any given message." 'face 'notmuch-tag-face) ")")))))) +(defun notmuch-show-clean-address (address) + "Clean a single email address for display." + (let* ((parsed (mail-header-parse-address address)) + (address (car parsed)) + (name (cdr parsed))) + ;; Remove double quotes. They might be required during transport, + ;; but we don't need to see them. + (when name + (setq name (replace-regexp-in-string "\"" "" name))) + ;; If the address is 'foo@bar.com ' then show just + ;; 'foo@bar.com'. + (when (string= name address) + (setq name nil)) + + (if (not name) + address + (concat name " <" address ">")))) + (defun notmuch-show-insert-headerline (headers date tags depth) "Insert a notmuch style headerline based on HEADERS for a message at DEPTH in the current thread." (let ((start (point))) (insert (notmuch-show-spaces-n depth) - (plist-get headers :From) + (notmuch-show-clean-address (plist-get headers :From)) " (" date ") (" @@ -236,7 +278,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 +286,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,6 +323,157 @@ 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-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)) + (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)) + inner-parts)) + t) + (defun notmuch-show-insert-part-text/plain (msg part content-type nth depth declared-type) (let ((start (point))) ;; If this text/plain part is not the first part in the message, @@ -293,6 +487,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. @@ -344,7 +556,7 @@ current buffer, if possible." (with-temp-buffer (let ((coding-system-for-read 'no-conversion)) (call-process notmuch-command nil t nil - "part" (format "--part=%s" part-number) message-id) + "show" "--format=raw" (format "--part=%s" part-number) message-id) (buffer-string)))) (defun notmuch-show-get-bodypart-content (msg part nth) @@ -438,8 +650,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)) @@ -579,7 +792,7 @@ function is used. " (define-key map (kbd "") 'notmuch-show-previous-button) (define-key map (kbd "TAB") 'notmuch-show-next-button) (define-key map "s" 'notmuch-search) - (define-key map "m" 'notmuch-mua-mail) + (define-key map "m" 'notmuch-mua-new-mail) (define-key map "f" 'notmuch-show-forward-message) (define-key map "r" 'notmuch-show-reply) (define-key map "|" 'notmuch-show-pipe-message) @@ -948,7 +1161,7 @@ any effects from previous calls to The given command will be executed with the raw contents of the current email message as stdin. Anything printed by the command -to stdout or stderr will appear in the *Messages* buffer. +to stdout or stderr will appear in the *notmuch-pipe* buffer. When invoked with a prefix argument, the command will receive all open messages in the current thread (formatted as an mbox) rather @@ -964,7 +1177,18 @@ than only the current message." (setq shell-command (concat notmuch-command " show --format=raw " (shell-quote-argument (notmuch-show-get-message-id)) " | " command))) - (start-process-shell-command "notmuch-pipe-command" "*notmuch-pipe*" shell-command))) + (let ((buf (get-buffer-create (concat "*notmuch-pipe*")))) + (with-current-buffer buf + (setq buffer-read-only nil) + (erase-buffer) + (let ((exit-code (call-process-shell-command shell-command nil buf))) + (goto-char (point-max)) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (unless (zerop exit-code) + (switch-to-buffer-other-window buf) + (message (format "Command '%s' exited abnormally with code %d" + shell-command exit-code)))))))) (defun notmuch-show-add-tags-worker (current-tags add-tags) "Add to `current-tags' with any tags from `add-tags' not @@ -994,10 +1218,8 @@ the result." (new-tags (notmuch-show-add-tags-worker current-tags toadd))) (unless (equal current-tags new-tags) - (apply 'notmuch-call-notmuch-process - (append (cons "tag" - (mapcar (lambda (s) (concat "+" s)) toadd)) - (cons (notmuch-show-get-message-id) nil))) + (apply 'notmuch-tag (notmuch-show-get-message-id) + (mapcar (lambda (s) (concat "+" s)) toadd)) (notmuch-show-set-tags new-tags)))) (defun notmuch-show-remove-tag (&rest toremove) @@ -1010,10 +1232,8 @@ the result." (new-tags (notmuch-show-del-tags-worker current-tags toremove))) (unless (equal current-tags new-tags) - (apply 'notmuch-call-notmuch-process - (append (cons "tag" - (mapcar (lambda (s) (concat "-" s)) toremove)) - (cons (notmuch-show-get-message-id) nil))) + (apply 'notmuch-tag (notmuch-show-get-message-id) + (mapcar (lambda (s) (concat "-" s)) toremove)) (notmuch-show-set-tags new-tags)))) (defun notmuch-show-toggle-headers ()