+(defun notmuch-show-fontify-header ()
+ (let ((face (cond
+ ((looking-at "[Tt]o:")
+ 'message-header-to)
+ ((looking-at "[Bb]?[Cc][Cc]:")
+ 'message-header-cc)
+ ((looking-at "[Ss]ubject:")
+ 'message-header-subject)
+ ((looking-at "[Ff]rom:")
+ 'message-header-from)
+ (t
+ 'message-header-other))))
+
+ (overlay-put (make-overlay (point) (re-search-forward ":"))
+ 'face 'message-header-name)
+ (overlay-put (make-overlay (point) (re-search-forward ".*$"))
+ 'face face)))
+
+(defun notmuch-show-colour-headers ()
+ "Apply some colouring to the current headers."
+ (goto-char (point-min))
+ (while (looking-at "^[A-Za-z][-A-Za-z0-9]*:")
+ (notmuch-show-fontify-header)
+ (forward-line)))
+
+(defun notmuch-show-spaces-n (n)
+ "Return a string comprised of `n' spaces."
+ (make-string n ? ))
+
+(defun notmuch-show-update-tags (tags)
+ "Update the displayed tags of the current message."
+ (save-excursion
+ (goto-char (notmuch-show-message-top))
+ (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)
+ (let ((inhibit-read-only t))
+ (replace-match (concat "("
+ (propertize (mapconcat 'identity tags " ")
+ 'face 'notmuch-tag-face)
+ ")"))))))
+
+(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)
+ " ("
+ date
+ ") ("
+ (propertize (mapconcat 'identity tags " ")
+ 'face 'notmuch-tag-face)
+ ")\n")
+ (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))
+
+(defun notmuch-show-insert-header (header header-value)
+ "Insert a single header."
+ (insert header ": " header-value "\n"))
+
+(defun notmuch-show-insert-headers (headers)
+ "Insert the headers of the current message."
+ (let ((start (point)))
+ (mapc '(lambda (header)
+ (let* ((header-symbol (intern (concat ":" header)))
+ (header-value (plist-get headers header-symbol)))
+ (if (and header-value
+ (not (string-equal "" header-value)))
+ (notmuch-show-insert-header header header-value))))
+ notmuch-message-headers)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start (point-max))
+ (run-hooks 'notmuch-show-markup-headers-hook)))))
+
+(define-button-type 'notmuch-show-part-button-type
+ 'action 'notmuch-show-part-button-action
+ 'follow-link t
+ 'face 'message-mml)
+
+(defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment)
+ (insert-button
+ (concat "[ "
+ (if name (concat name ": ") "")
+ declared-type
+ (if (not (string-equal declared-type content-type))
+ (concat " (as " content-type ")")
+ "")
+ (or comment "")
+ " ]\n")
+ :type 'notmuch-show-part-button-type
+ :notmuch-part nth
+ :notmuch-filename name))
+
+;; Functions handling particular MIME parts.
+
+(defun notmuch-show-save-part (message-id nth &optional filename)
+ (with-temp-buffer
+ ;; Always acquires the part via `notmuch part', even if it is
+ ;; available in the JSON output.
+ (insert (notmuch-show-get-bodypart-internal message-id nth))
+ (let ((file (read-file-name
+ "Filename to save as: "
+ (or mailcap-download-directory "~/")
+ nil nil
+ filename))
+ (require-final-newline nil)
+ (coding-system-for-write 'no-conversion))
+ (write-region (point-min) (point-max) file))))
+
+(defun notmuch-show-mm-display-part-inline (msg part content-type content)
+ "Use the mm-decode/mm-view functions to display a part in the
+current buffer, if possible."
+ (let ((display-buffer (current-buffer)))
+ (with-temp-buffer
+ (insert content)
+ (let ((handle (mm-make-handle (current-buffer) (list content-type))))
+ (set-buffer display-buffer)
+ (if (and (mm-inlinable-p handle)
+ (mm-inlined-p handle))
+ (progn
+ (mm-display-part handle)
+ 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,
+ ;; insert a header to make this clear.
+ (if (> nth 1)
+ (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename)))
+ (insert (notmuch-show-get-bodypart-content msg part nth))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start (point-max))
+ (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.
+ (if (plist-get part :filename)
+ (let ((extension (file-name-extension (plist-get part :filename)))
+ mime-type)
+ (if extension
+ (progn
+ (mailcap-parse-mimetypes)
+ (setq mime-type (mailcap-extension-to-mime extension))
+ (if (and mime-type
+ (not (string-equal mime-type "application/octet-stream")))
+ (notmuch-show-insert-bodypart-internal msg part mime-type nth depth content-type)
+ nil))
+ nil))))
+
+(defun notmuch-show-insert-part-*/* (msg part content-type nth depth declared-type)
+ ;; This handler _must_ succeed - it is the handler of last resort.
+ (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename))
+ (let ((content (notmuch-show-get-bodypart-content msg part nth)))
+ (if content
+ (notmuch-show-mm-display-part-inline msg part content-type content)))
+ t)
+
+;; Functions for determining how to handle MIME parts.
+
+(defun notmuch-show-split-content-type (content-type)
+ (split-string content-type "/"))
+
+(defun notmuch-show-handlers-for (content-type)
+ "Return a list of content handlers for a part of type CONTENT-TYPE."
+ (let (result)
+ (mapc (lambda (func)
+ (if (functionp func)
+ (push func result)))
+ ;; Reverse order of prefrence.
+ (list (intern (concat "notmuch-show-insert-part-*/*"))
+ (intern (concat
+ "notmuch-show-insert-part-"
+ (car (notmuch-show-split-content-type content-type))
+ "/*"))
+ (intern (concat "notmuch-show-insert-part-" content-type))))
+ result))
+
+;; Helper for parts which are generally not included in the default
+;; JSON output.
+
+(defun notmuch-show-get-bodypart-internal (message-id part-number)
+ (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)
+ (buffer-string))))
+
+(defun notmuch-show-get-bodypart-content (msg part nth)
+ (or (plist-get part :content)
+ (notmuch-show-get-bodypart-internal (concat "id:" (plist-get msg :id)) nth)))
+
+;; \f
+
+(defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth declared-type)
+ (let ((handlers (notmuch-show-handlers-for content-type)))
+ ;; Run the content handlers until one of them returns a non-nil
+ ;; value.
+ (while (and handlers
+ (not (funcall (car handlers) msg part content-type nth depth declared-type)))
+ (setq handlers (cdr handlers))))
+ t)
+
+(defun notmuch-show-insert-bodypart (msg part depth)
+ "Insert the body part PART at depth DEPTH in the current thread."
+ (let ((content-type (downcase (plist-get part :content-type)))
+ (nth (plist-get part :id)))
+ (notmuch-show-insert-bodypart-internal msg part content-type nth depth content-type))
+ ;; Some of the body part handlers leave point somewhere up in the
+ ;; part, so we make sure that we're down at the end.
+ (goto-char (point-max))
+ ;; Ensure that the part ends with a carriage return.
+ (if (not (bolp))
+ (insert "\n")))
+
+(defun notmuch-show-insert-body (msg body depth)
+ "Insert the body BODY at depth DEPTH in the current thread."
+ (mapc '(lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
+
+(defun notmuch-show-make-symbol (type)
+ (make-symbol (concat "notmuch-show-" type)))
+
+(defun notmuch-show-strip-re (string)
+ (replace-regexp-in-string "\\([Rr]e: *\\)+" "" string))
+
+(defvar notmuch-show-previous-subject "")
+(make-variable-buffer-local 'notmuch-show-previous-subject)
+
+(defun notmuch-show-insert-msg (msg depth)
+ "Insert the message MSG at depth DEPTH in the current thread."
+ (let* ((headers (plist-get msg :headers))
+ ;; Indentation causes the buffer offset of the start/end
+ ;; points to move, so we must use markers.
+ message-start message-end
+ content-start content-end
+ headers-start headers-end
+ body-start body-end
+ (headers-invis-spec (notmuch-show-make-symbol "header"))
+ (message-invis-spec (notmuch-show-make-symbol "message"))
+ (bare-subject (notmuch-show-strip-re (plist-get headers :Subject))))
+
+ ;; Set `buffer-invisibility-spec' to `nil' (a list), otherwise
+ ;; removing items from `buffer-invisibility-spec' (which is what
+ ;; `notmuch-show-headers-visible' and
+ ;; `notmuch-show-message-visible' do) is a no-op and has no
+ ;; effect. This caused threads with only matching messages to have
+ ;; those messages hidden initially because
+ ;; `buffer-invisibility-spec' stayed `t'.
+ ;;
+ ;; This needs to be set here (rather than just above the call to
+ ;; `notmuch-show-headers-visible') because some of the part
+ ;; rendering or body washing functions
+ ;; (e.g. `notmuch-wash-text/plain-citations') manipulate
+ ;; `buffer-invisibility-spec').
+ (when (eq buffer-invisibility-spec t)
+ (setq buffer-invisibility-spec nil))
+
+ (setq message-start (point-marker))
+
+ (notmuch-show-insert-headerline headers
+ (or (if notmuch-show-relative-dates
+ (plist-get msg :date_relative)
+ nil)
+ (plist-get headers :Date))
+ (plist-get msg :tags) depth)
+
+ (setq content-start (point-marker))
+
+ ;; Set `headers-start' to point after the 'Subject:' header to be
+ ;; compatible with the existing implementation. This just sets it
+ ;; to after the first header.
+ (notmuch-show-insert-headers headers)
+ ;; Headers should include a blank line (backwards compatibility).
+ (insert "\n")
+ (save-excursion
+ (goto-char content-start)
+ ;; 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))
+ (forward-line 1))
+ (setq headers-start (point-marker)))
+ (setq headers-end (point-marker))
+
+ (setq notmuch-show-previous-subject bare-subject)
+
+ (setq body-start (point-marker))
+ (notmuch-show-insert-body msg (plist-get msg :body) depth)
+ ;; Ensure that the body ends with a newline.
+ (if (not (bolp))
+ (insert "\n"))
+ (setq body-end (point-marker))
+ (setq content-end (point-marker))
+
+ ;; Indent according to the depth in the thread.
+ (indent-rigidly content-start content-end depth)
+
+ (setq message-end (point-max-marker))
+
+ ;; Save the extents of this message over the whole text of the
+ ;; message.
+ (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end))
+
+ (plist-put msg :headers-invis-spec headers-invis-spec)
+ (overlay-put (make-overlay headers-start headers-end) 'invisible headers-invis-spec)
+
+ (plist-put msg :message-invis-spec message-invis-spec)
+ (overlay-put (make-overlay body-start body-end) 'invisible message-invis-spec)
+
+ ;; Save the properties for this message. Currently this saves the
+ ;; entire message (augmented it with other stuff), which seems
+ ;; like overkill. We might save a reduced subset (for example, not
+ ;; the content).
+ (notmuch-show-set-message-properties msg)
+
+ ;; Set header visibility.
+ (notmuch-show-headers-visible msg notmuch-message-headers-visible)
+
+ ;; Message visibility depends on whether it matched the search
+ ;; criteria.
+ (notmuch-show-message-visible msg (plist-get msg :match))))
+
+(defun notmuch-show-insert-tree (tree depth)
+ "Insert the message tree TREE at depth DEPTH in the current thread."
+ (let ((msg (car tree))
+ (replies (cadr tree)))
+ (notmuch-show-insert-msg msg depth)
+ (notmuch-show-insert-thread replies (1+ depth))))
+
+(defun notmuch-show-insert-thread (thread depth)
+ "Insert the thread THREAD at depth DEPTH in the current forest."
+ (mapc '(lambda (tree) (notmuch-show-insert-tree tree depth)) thread))
+
+(defun notmuch-show-insert-forest (forest)
+ "Insert the forest of threads FOREST."
+ (mapc '(lambda (thread) (notmuch-show-insert-thread thread 0)) forest))