(require 'message)
(require 'mm-decode)
(require 'mailcap)
+(require 'icalendar)
(require 'notmuch-lib)
(require 'notmuch-query)
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
'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 ": ") "")
(if (not (string-equal declared-type content-type))
(concat " (as " content-type ")")
"")
+ (or comment "")
" ]\n")
:type 'notmuch-show-part-button-type
:notmuch-part nth
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)
+ (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,
(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.
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
(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
projects / notmuch / blobdiff