+(declare-function notmuch-tree "notmuch-tree"
+ (&optional query query-context target buffer-name open-target))
+(declare-function notmuch-tree-get-message-properties "notmuch-tree" nil)
+
+(defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
+ "Headers that should be shown in a message, in this order.
+
+For an open message, all of these headers will be made visible
+according to `notmuch-message-headers-visible' or can be toggled
+with `notmuch-show-toggle-visibility-headers'. For a closed message,
+only the first header in the list will be visible."
+ :type '(repeat string)
+ :group 'notmuch-show)
+
+(defcustom notmuch-message-headers-visible t
+ "Should the headers be visible by default?
+
+If this value is non-nil, then all of the headers defined in
+`notmuch-message-headers' will be visible by default in the display
+of each message. Otherwise, these headers will be hidden and
+`notmuch-show-toggle-visibility-headers' can be used to make them
+visible for any given message."
+ :type 'boolean
+ :group 'notmuch-show)
+
+(defcustom notmuch-show-relative-dates t
+ "Display relative dates in the message summary line."
+ :type 'boolean
+ :group 'notmuch-show)
+
+(defvar notmuch-show-markup-headers-hook '(notmuch-show-colour-headers)
+ "A list of functions called to decorate the headers listed in
+`notmuch-message-headers'.")
+
+(defcustom notmuch-show-hook '(notmuch-show-turn-on-visual-line-mode)
+ "Functions called after populating a `notmuch-show' buffer."
+ :type 'hook
+ :options '(notmuch-show-turn-on-visual-line-mode)
+ :group 'notmuch-show
+ :group 'notmuch-hooks)
+
+(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-wrap-long-lines
+ notmuch-wash-tidy-citations
+ notmuch-wash-elide-blank-lines
+ notmuch-wash-excerpt-citations)
+ "Functions used to improve the display of text/plain parts."
+ :type 'hook
+ :options '(notmuch-wash-convert-inline-patch-to-part
+ notmuch-wash-wrap-long-lines
+ notmuch-wash-tidy-citations
+ notmuch-wash-elide-blank-lines
+ notmuch-wash-excerpt-citations)
+ :group 'notmuch-show
+ :group 'notmuch-hooks)
+
+;; Mostly useful for debugging.
+(defcustom notmuch-show-all-multipart/alternative-parts nil
+ "Should all parts of multipart/alternative parts be shown?"
+ :type 'boolean
+ :group 'notmuch-show)
+
+(defcustom notmuch-show-indent-messages-width 1
+ "Width of message indentation in threads.
+
+Messages are shown indented according to their depth in a thread.
+This variable determines the width of this indentation measured
+in number of blanks. Defaults to `1', choose `0' to disable
+indentation."
+ :type 'integer
+ :group 'notmuch-show)
+
+(defcustom notmuch-show-indent-multipart nil
+ "Should the sub-parts of a multipart/* part be indented?"
+ ;; dme: Not sure which is a good default.
+ :type 'boolean
+ :group 'notmuch-show)
+
+(defcustom notmuch-show-part-button-default-action 'notmuch-show-save-part
+ "Default part header button action (on ENTER or mouse click)."
+ :group 'notmuch-show
+ :type '(choice (const :tag "Save part"
+ notmuch-show-save-part)
+ (const :tag "View part"
+ notmuch-show-view-part)
+ (const :tag "View interactively"
+ notmuch-show-interactively-view-part)))
+
+(defcustom notmuch-show-only-matching-messages nil
+ "Only matching messages are shown by default."
+ :type 'boolean
+ :group 'notmuch-show)
+
+(defvar notmuch-show-thread-id nil)
+(make-variable-buffer-local 'notmuch-show-thread-id)
+(put 'notmuch-show-thread-id 'permanent-local t)
+
+(defvar notmuch-show-parent-buffer nil)
+(make-variable-buffer-local 'notmuch-show-parent-buffer)
+(put 'notmuch-show-parent-buffer 'permanent-local t)
+
+(defvar notmuch-show-query-context nil)
+(make-variable-buffer-local 'notmuch-show-query-context)
+(put 'notmuch-show-query-context 'permanent-local t)
+
+(defvar notmuch-show-process-crypto nil)
+(make-variable-buffer-local 'notmuch-show-process-crypto)
+(put 'notmuch-show-process-crypto 'permanent-local t)
+
+(defvar notmuch-show-elide-non-matching-messages nil)
+(make-variable-buffer-local 'notmuch-show-elide-non-matching-messages)
+(put 'notmuch-show-elide-non-matching-messages 'permanent-local t)
+
+(defvar notmuch-show-indent-content t)
+(make-variable-buffer-local 'notmuch-show-indent-content)
+(put 'notmuch-show-indent-content 'permanent-local t)
+
+(defvar notmuch-show-attachment-debug nil
+ "If t log stdout and stderr from attachment handlers
+
+When set to nil (the default) stdout and stderr from attachment
+handlers is discarded. When set to t the stdout and stderr from
+each attachment handler is logged in buffers with names beginning
+\" *notmuch-part*\". This option requires emacs version at least
+24.3 to work.")
+
+(defcustom notmuch-show-stash-mlarchive-link-alist
+ '(("Gmane" . "http://mid.gmane.org/")
+ ("MARC" . "http://marc.info/?i=")
+ ("Mail Archive, The" . "http://mid.mail-archive.com/")
+ ("LKML" . "http://lkml.kernel.org/r/")
+ ;; FIXME: can these services be searched by `Message-Id' ?
+ ;; ("MarkMail" . "http://markmail.org/")
+ ;; ("Nabble" . "http://nabble.com/")
+ ;; ("opensubscriber" . "http://opensubscriber.com/")
+ )
+ "List of Mailing List Archives to use when stashing links.
+
+This list is used for generating a Mailing List Archive reference
+URI with the current message's Message-Id in
+`notmuch-show-stash-mlarchive-link'.
+
+If the cdr of the alist element is not a function, the cdr is
+expected to contain a URI that is concatenated with the current
+message's Message-Id to create a ML archive reference URI.
+
+If the cdr is a function, the function is called with the
+Message-Id as the argument, and the function is expected to
+return the ML archive reference URI."
+ :type '(alist :key-type (string :tag "Name")
+ :value-type (choice
+ (string :tag "URL")
+ (function :tag "Function returning the URL")))
+ :group 'notmuch-show)
+
+(defcustom notmuch-show-stash-mlarchive-link-default "Gmane"
+ "Default Mailing List Archive to use when stashing links.
+
+This is used when `notmuch-show-stash-mlarchive-link' isn't
+provided with an MLA argument nor `completing-read' input."
+ :type `(choice
+ ,@(mapcar
+ (lambda (mla)
+ (list 'const :tag (car mla) :value (car mla)))
+ notmuch-show-stash-mlarchive-link-alist))
+ :group 'notmuch-show)
+
+(defcustom notmuch-show-mark-read-tags '("-unread")
+ "List of tag changes to apply to a message when it is marked as read.
+
+Tags starting with \"+\" (or not starting with either \"+\" or
+\"-\") in the list will be added, and tags starting with \"-\"
+will be removed from the message being marked as read.
+
+For example, if you wanted to remove an \"unread\" tag and add a
+\"read\" tag (which would make little sense), you would set:
+ (\"-unread\" \"+read\")"
+ :type '(repeat string)
+ :group 'notmuch-show)
+
+(defcustom notmuch-show-mark-read-function #'notmuch-show-seen-current-message
+ "Function to control which messages are marked read.
+
+The function should take two arguments START and END which will
+be the start and end of the visible portion of the buffer and
+should mark the appropriate messages read by applying
+`notmuch-show-mark-read'. This function will be called after
+every user interaction with notmuch."
+ :type 'function
+ :group 'notmuch-show)
+
+(defmacro with-current-notmuch-show-message (&rest body)
+ "Evaluate body with current buffer set to the text of current message"
+ `(save-excursion
+ (let ((id (notmuch-show-get-message-id)))
+ (let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))
+ (with-current-buffer buf
+ (let ((coding-system-for-read 'no-conversion))
+ (call-process notmuch-command nil t nil "show" "--format=raw" id))
+ ,@body)
+ (kill-buffer buf)))))
+
+(defun notmuch-show-turn-on-visual-line-mode ()
+ "Enable Visual Line mode."
+ (visual-line-mode t))
+
+;; DEPRECATED in Notmuch 0.16 since we now have convenient part
+;; commands. We'll keep the command around for a version or two in
+;; case people want to bind it themselves.
+(defun notmuch-show-view-all-mime-parts ()
+ "Use external viewers to view all attachments from the current message."
+ (interactive)
+ (with-current-notmuch-show-message
+ ;; We override the mm-inline-media-tests to indicate which message
+ ;; parts are already sufficiently handled by the original
+ ;; presentation of the message in notmuch-show mode. These parts
+ ;; will be inserted directly into the temporary buffer of
+ ;; with-current-notmuch-show-message and silently discarded.
+ ;;
+ ;; Any MIME part not explicitly mentioned here will be handled by an
+ ;; external viewer as configured in the various mailcap files.
+ (let ((mm-inline-media-tests '(
+ ("text/.*" ignore identity)
+ ("application/pgp-signature" ignore identity)
+ ("multipart/alternative" ignore identity)
+ ("multipart/mixed" ignore identity)
+ ("multipart/related" ignore identity)
+ )))
+ (mm-display-parts (mm-dissect-buffer)))))
+
+(defun notmuch-show-save-attachments ()
+ "Save all attachments from the current message."
+ (interactive)
+ (with-current-notmuch-show-message
+ (let ((mm-handle (mm-dissect-buffer)))
+ (notmuch-save-attachments
+ mm-handle (> (notmuch-count-attachments mm-handle) 1))))
+ (message "Done"))
+
+(defun notmuch-show-with-message-as-text (fn)
+ "Apply FN to a text representation of the current message.
+
+FN is called with one argument, the message properties. It should
+operation on the contents of the current buffer."
+
+ ;; Remake the header to ensure that all information is available.
+ (let* ((to (notmuch-show-get-to))
+ (cc (notmuch-show-get-cc))
+ (from (notmuch-show-get-from))
+ (subject (notmuch-show-get-subject))
+ (date (notmuch-show-get-date))
+ (tags (notmuch-show-get-tags))
+ (depth (notmuch-show-get-depth))
+
+ (header (concat
+ "Subject: " subject "\n"
+ "To: " to "\n"
+ (if (not (string= cc ""))
+ (concat "Cc: " cc "\n")
+ "")
+ "From: " from "\n"
+ "Date: " date "\n"
+ (if tags
+ (concat "Tags: "
+ (mapconcat #'identity tags ", ") "\n")
+ "")))
+ (all (buffer-substring (notmuch-show-message-top)
+ (notmuch-show-message-bottom)))
+
+ (props (notmuch-show-get-message-properties))
+ (indenting notmuch-show-indent-content))
+ (with-temp-buffer
+ (insert all)
+ (if indenting
+ (indent-rigidly (point-min) (point-max) (- depth)))
+ ;; Remove the original header.
+ (goto-char (point-min))
+ (re-search-forward "^$" (point-max) nil)
+ (delete-region (point-min) (point))
+ (insert header)
+ (funcall fn props))))
+
+(defun notmuch-show-print-message ()
+ "Print the current message."
+ (interactive)
+ (notmuch-show-with-message-as-text 'notmuch-print-message))
+
+(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 "("
+ (notmuch-tag-format-tags tags (notmuch-show-get-prop :orig-tags))
+ ")"))))))
+
+(defun notmuch-clean-address (address)
+ "Try to clean a single email ADDRESS for display. Return a cons
+cell of (AUTHOR_EMAIL AUTHOR_NAME). Return (ADDRESS nil) if
+parsing fails."
+ (condition-case nil
+ (let (p-name p-address)
+ ;; It would be convenient to use `mail-header-parse-address',
+ ;; but that expects un-decoded mailbox parts, whereas our
+ ;; mailbox parts are already decoded (and hence may contain
+ ;; UTF-8). Given that notmuch should handle most of the awkward
+ ;; cases, some simple string deconstruction should be sufficient
+ ;; here.
+ (cond
+ ;; "User <user@dom.ain>" style.
+ ((string-match "\\(.*\\) <\\(.*\\)>" address)
+ (setq p-name (match-string 1 address)
+ p-address (match-string 2 address)))
+
+ ;; "<user@dom.ain>" style.
+ ((string-match "<\\(.*\\)>" address)
+ (setq p-address (match-string 1 address)))
+
+ ;; Everything else.
+ (t
+ (setq p-address address)))
+
+ (when p-name
+ ;; Remove elements of the mailbox part that are not relevant for
+ ;; display, even if they are required during transport:
+ ;;
+ ;; Backslashes.
+ (setq p-name (replace-regexp-in-string "\\\\" "" p-name))
+
+ ;; Outer single and double quotes, which might be nested.
+ (loop
+ with start-of-loop
+ do (setq start-of-loop p-name)
+
+ when (string-match "^\"\\(.*\\)\"$" p-name)
+ do (setq p-name (match-string 1 p-name))
+
+ when (string-match "^'\\(.*\\)'$" p-name)
+ do (setq p-name (match-string 1 p-name))
+
+ until (string= start-of-loop p-name)))
+
+ ;; If the address is 'foo@bar.com <foo@bar.com>' then show just
+ ;; 'foo@bar.com'.
+ (when (string= p-name p-address)
+ (setq p-name nil))
+
+ (cons p-address p-name))
+ (error (cons address nil))))
+
+(defun notmuch-show-clean-address (address)
+ "Try to clean a single email ADDRESS for display. Return
+unchanged ADDRESS if parsing fails."
+ (let* ((clean-address (notmuch-clean-address address))
+ (p-address (car clean-address))
+ (p-name (cdr clean-address)))
+ ;; If no name, return just the address.
+ (if (not p-name)
+ p-address
+ ;; Otherwise format the name and address together.
+ (concat p-name " <" p-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 (* notmuch-show-indent-messages-width depth))
+ (notmuch-sanitize
+ (notmuch-show-clean-address (plist-get headers :From)))
+ " ("
+ date
+ ") ("
+ (notmuch-tag-format-tags tags tags)
+ ")\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 ": " (notmuch-sanitize 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-default
+ 'follow-link t
+ 'face 'message-mml
+ :supertype 'notmuch-button-type)
+
+(defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment)
+ (let ((button)
+ (base-label (concat (when name (concat name ": "))
+ declared-type
+ (unless (string-equal declared-type content-type)
+ (concat " (as " content-type ")"))
+ comment)))
+
+ (setq button
+ (insert-button
+ (concat "[ " base-label " ]")
+ :base-label base-label
+ :type 'notmuch-show-part-button-type
+ :notmuch-part-hidden nil))
+ (insert "\n")
+ ;; return button
+ button))
+
+(defun notmuch-show-toggle-part-invisibility (&optional button)
+ (interactive)
+ (let* ((button (or button (button-at (point))))
+ (overlay (button-get button 'overlay))
+ (lazy-part (button-get button :notmuch-lazy-part)))
+ ;; We have a part to toggle if there is an overlay or if there is a lazy part.
+ ;; If neither is present we cannot toggle the part so we just return nil.
+ (when (or overlay lazy-part)
+ (let* ((show (button-get button :notmuch-part-hidden))
+ (new-start (button-start button))
+ (button-label (button-get button :base-label))
+ (old-point (point))
+ (properties (text-properties-at (button-start button)))
+ (inhibit-read-only t))
+ ;; Toggle the button itself.
+ (button-put button :notmuch-part-hidden (not show))
+ (goto-char new-start)
+ (insert "[ " button-label (if show " ]" " (hidden) ]"))
+ (set-text-properties new-start (point) properties)
+ (let ((old-end (button-end button)))
+ (move-overlay button new-start (point))
+ (delete-region (point) old-end))
+ (goto-char (min old-point (1- (button-end button))))
+ ;; Return nil if there is a lazy-part, it is empty, and we are
+ ;; trying to show it. In all other cases return t.
+ (if lazy-part
+ (when show
+ (button-put button :notmuch-lazy-part nil)
+ (notmuch-show-lazy-part lazy-part button))
+ ;; else there must be an overlay.
+ (overlay-put overlay 'invisible (not show))
+ t)))))
+
+;; MIME part renderers
+
+(defun notmuch-show-multipart/*-to-list (part)
+ (mapcar (lambda (inner-part) (plist-get inner-part :content-type))
+ (plist-get part :content)))
+
+(defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth button)
+ (let ((chosen-type (car (notmuch-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))
+ (hide (not (or notmuch-show-all-multipart/alternative-parts
+ (string= chosen-type inner-type)))))
+ (notmuch-show-insert-bodypart msg inner-part depth hide)))
+ 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-get-bodypart-internal (notmuch-id-to-query message-id)
+ part-number notmuch-show-process-crypto))
+ (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 button)
+ (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)
+ ;; Add hidden buttons for the rest
+ (mapc (lambda (inner-part)
+ (notmuch-show-insert-bodypart msg inner-part depth t))
+ (cdr inner-parts))
+
+ (when notmuch-show-indent-multipart
+ (indent-rigidly start (point) 1)))
+ t)
+
+(defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth button)
+ (button-put button 'face 'notmuch-crypto-part-header)
+ ;; add signature status button if sigstatus provided
+ (if (plist-member part :sigstatus)
+ (let* ((from (notmuch-show-get-header :From msg))
+ (sigstatus (car (plist-get part :sigstatus))))
+ (notmuch-crypto-insert-sigstatus-button sigstatus from))
+ ;; if we're not adding sigstatus, tell the user how they can get it
+ (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts."))
+
+ (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-multipart/encrypted (msg part content-type nth depth button)
+ (button-put button 'face 'notmuch-crypto-part-header)
+ ;; add encryption status button if encstatus specified
+ (if (plist-member part :encstatus)
+ (let ((encstatus (car (plist-get part :encstatus))))
+ (notmuch-crypto-insert-encstatus-button encstatus)
+ ;; add signature status button if sigstatus specified
+ (if (plist-member part :sigstatus)
+ (let* ((from (notmuch-show-get-header :From msg))
+ (sigstatus (car (plist-get part :sigstatus))))
+ (notmuch-crypto-insert-sigstatus-button sigstatus from))))
+ ;; if we're not adding encstatus, tell the user how they can get it
+ (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts."))
+
+ (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-multipart/* (msg part content-type nth depth button)
+ (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 button)
+ (let* ((message (car (plist-get part :content)))
+ (body (car (plist-get message :body)))
+ (start (point)))
+
+ ;; 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 message :headers)))
+
+ ;; Blank line after headers to be compatible with the normal
+ ;; message display.
+ (insert "\n")
+
+ ;; Show the body
+ (notmuch-show-insert-bodypart msg body depth)
+
+ (when notmuch-show-indent-multipart
+ (indent-rigidly start (point) 1)))
+ t)
+
+(defun notmuch-show-insert-part-text/plain (msg part content-type nth depth button)
+ ;; For backward compatibility we want to apply the text/plain hook
+ ;; to the whole of the part including the part button if there is
+ ;; one.
+ (let ((start (if button
+ (button-start button)
+ (point))))
+ (insert (notmuch-get-bodypart-content msg part notmuch-show-process-crypto))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start (point-max))
+ (run-hook-with-args 'notmuch-show-insert-text/plain-hook msg depth))))
+ t)
+
+(defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth button)
+ (insert (with-temp-buffer
+ (insert (notmuch-get-bodypart-content msg part notmuch-show-process-crypto))
+ ;; notmuch-get-bodypart-content provides "raw", non-converted
+ ;; data. Replace CRLF with LF before icalendar can use it.
+ (goto-char (point-min))
+ (while (re-search-forward "\r\n" nil t)
+ (replace-match "\n" nil nil))
+ (let ((file (make-temp-file "notmuch-ical"))
+ result)
+ (unwind-protect
+ (progn
+ (unless (icalendar-import-buffer file t)
+ (error "Icalendar import error. See *icalendar-errors* for more information"))
+ (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)
+
+;; For backwards compatibility.
+(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth button)
+ (notmuch-show-insert-part-text/calendar msg part content-type nth depth button))
+
+(defun notmuch-show-get-mime-type-of-application/octet-stream (part)
+ ;; If we can deduce a MIME type from the filename of the attachment,
+ ;; we return that.
+ (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")))
+ mime-type
+ nil))
+ nil))))
+
+(defun notmuch-show-insert-part-text/html (msg part content-type nth depth button)
+ ;; text/html handler to work around bugs in renderers and our
+ ;; invisibile parts code. In particular w3m sets up a keymap which
+ ;; "leaks" outside the invisible region and causes strange effects
+ ;; in notmuch. We set mm-inline-text-html-with-w3m-keymap to nil to
+ ;; tell w3m not to set a keymap (so the normal notmuch-show-mode-map
+ ;; remains).
+ (let ((mm-inline-text-html-with-w3m-keymap nil))
+ (notmuch-show-insert-part-*/* msg part content-type nth depth button)))
+
+(defun notmuch-show-insert-part-*/* (msg part content-type nth depth button)
+ ;; This handler _must_ succeed - it is the handler of last resort.
+ (notmuch-mm-display-part-inline msg part content-type notmuch-show-process-crypto)
+ t)
+
+;; Functions for determining how to handle MIME parts.
+
+(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-split-content-type content-type))
+ "/*"))
+ (intern (concat "notmuch-show-insert-part-" content-type))))
+ result))
+
+;; \f
+
+(defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth button)
+ (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 (condition-case err
+ (funcall (car handlers) msg part content-type nth depth button)
+ ;; Specifying `debug' here lets the debugger
+ ;; run if `debug-on-error' is non-nil.
+ ((debug error)
+ (progn
+ (insert "!!! Bodypart insert error: ")
+ (insert (error-message-string err))
+ (insert " !!!\n") nil)))))
+ (setq handlers (cdr handlers))))
+ t)
+
+(defun notmuch-show-create-part-overlays (button beg end)
+ "Add an overlay to the part between BEG and END"
+
+ ;; If there is no button (i.e., the part is text/plain and the first
+ ;; part) or if the part has no content then we don't make the part
+ ;; toggleable.
+ (when (and button (/= beg end))
+ (button-put button 'overlay (make-overlay beg end))
+ ;; Return true if we created an overlay.
+ t))
+
+(defun notmuch-show-record-part-information (part beg end)
+ "Store PART as a text property from BEG to END"
+
+ ;; Record part information. Since we already inserted subparts,
+ ;; don't override existing :notmuch-part properties.
+ (notmuch-map-text-property beg end :notmuch-part
+ (lambda (v) (or v part)))
+ ;; Make :notmuch-part front sticky and rear non-sticky so it stays
+ ;; applied to the beginning of each line when we indent the
+ ;; message. Since we're operating on arbitrary renderer output,
+ ;; watch out for sticky specs of t, which means all properties are
+ ;; front-sticky/rear-nonsticky.
+ (notmuch-map-text-property beg end 'front-sticky
+ (lambda (v) (if (listp v)
+ (pushnew :notmuch-part v)
+ v)))
+ (notmuch-map-text-property beg end 'rear-nonsticky
+ (lambda (v) (if (listp v)
+ (pushnew :notmuch-part v)
+ v))))
+
+(defun notmuch-show-lazy-part (part-args button)
+ ;; Insert the lazy part after the button for the part. We would just
+ ;; move to the start of the new line following the button and insert
+ ;; the part but that point might have text properties (eg colours
+ ;; from a message header etc) so instead we start from the last
+ ;; character of the button by adding a newline and finish by
+ ;; removing the extra newline from the end of the part.
+ (save-excursion
+ (goto-char (button-end button))
+ (insert "\n")
+ (let* ((inhibit-read-only t)
+ ;; We need to use markers for the start and end of the part
+ ;; because the part insertion functions do not guarantee
+ ;; to leave point at the end of the part.
+ (part-beg (copy-marker (point) nil))
+ (part-end (copy-marker (point) t))
+ ;; We have to save the depth as we can't find the depth
+ ;; when narrowed.
+ (depth (notmuch-show-get-depth)))
+ (save-restriction
+ (narrow-to-region part-beg part-end)
+ (delete-region part-beg part-end)
+ (apply #'notmuch-show-insert-bodypart-internal part-args)
+ (indent-rigidly part-beg part-end depth))
+ (goto-char part-end)
+ (delete-char 1)
+ (notmuch-show-record-part-information (second part-args)
+ (button-start button)
+ part-end)
+ ;; Create the overlay. If the lazy-part turned out to be empty/not
+ ;; showable this returns nil.
+ (notmuch-show-create-part-overlays button part-beg part-end))))
+
+(defun notmuch-show-insert-bodypart (msg part depth &optional hide)
+ "Insert the body part PART at depth DEPTH in the current thread.
+
+HIDE determines whether to show or hide the part and the button
+as follows: If HIDE is nil, show the part and the button. If HIDE
+is t, hide the part initially and show the button. If HIDE is
+'no-buttons, show the part but do not add any buttons (this is
+useful for quoting in replies)."
+
+ (let* ((content-type (downcase (plist-get part :content-type)))
+ (mime-type (or (and (string= content-type "application/octet-stream")
+ (notmuch-show-get-mime-type-of-application/octet-stream part))
+ (and (string= content-type "inline patch")
+ "text/x-diff")
+ content-type))
+ (nth (plist-get part :id))
+ (beg (point))
+ ;; Hide the part initially if HIDE is t.
+ (show-part (not (equal hide t)))
+ ;; We omit the part button for the first (or only) part if
+ ;; this is text/plain, or HIDE is 'no-buttons.
+ (button (unless (or (equal hide 'no-buttons)
+ (and (string= mime-type "text/plain") (<= nth 1)))
+ (notmuch-show-insert-part-header nth mime-type content-type (plist-get part :filename))))
+ (content-beg (point)))
+
+ ;; Store the computed mime-type for later use (e.g. by attachment handlers).
+ (plist-put part :computed-type mime-type)
+
+ (if show-part
+ (notmuch-show-insert-bodypart-internal msg part mime-type nth depth button)
+ (button-put button :notmuch-lazy-part
+ (list msg part mime-type nth depth button)))
+
+ ;; 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.
+ (unless (bolp)
+ (insert "\n"))
+ ;; We do not create the overlay for hidden (lazy) parts until
+ ;; they are inserted.
+ (if show-part
+ (notmuch-show-create-part-overlays button content-beg (point))
+ (save-excursion
+ (notmuch-show-toggle-part-invisibility button)))
+ (notmuch-show-record-part-information part beg (point))))
+
+(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
+ (bare-subject (notmuch-show-strip-re (plist-get headers :Subject))))
+
+ (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)
+ (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)
+
+ ;; A blank line between the headers and the body.
+ (insert "\n")
+ (notmuch-show-insert-body msg (plist-get msg :body)
+ (if notmuch-show-indent-content depth 0))
+ ;; Ensure that the body ends with a newline.
+ (unless (bolp)
+ (insert "\n"))
+ (setq content-end (point-marker))
+
+ ;; Indent according to the depth in the thread.
+ (if notmuch-show-indent-content
+ (indent-rigidly content-start content-end (* notmuch-show-indent-messages-width 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))
+
+ ;; Create overlays used to control visibility
+ (plist-put msg :headers-overlay (make-overlay headers-start headers-end))
+ (plist-put msg :message-overlay (make-overlay headers-start content-end))
+
+ (plist-put msg :depth depth)
+
+ ;; 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 (and (plist-get msg :match)
+ (not (plist-get msg :excluded))))))
+
+(defun notmuch-show-toggle-process-crypto ()
+ "Toggle the processing of cryptographic MIME parts."
+ (interactive)
+ (setq notmuch-show-process-crypto (not notmuch-show-process-crypto))
+ (message (if notmuch-show-process-crypto
+ "Processing cryptographic MIME parts."
+ "Not processing cryptographic MIME parts."))
+ (notmuch-show-refresh-view))
+
+(defun notmuch-show-toggle-elide-non-matching ()
+ "Toggle the display of non-matching messages."
+ (interactive)
+ (setq notmuch-show-elide-non-matching-messages (not notmuch-show-elide-non-matching-messages))
+ (message (if notmuch-show-elide-non-matching-messages
+ "Showing matching messages only."
+ "Showing all messages."))
+ (notmuch-show-refresh-view))
+
+(defun notmuch-show-toggle-thread-indentation ()
+ "Toggle the indentation of threads."
+ (interactive)
+ (setq notmuch-show-indent-content (not notmuch-show-indent-content))
+ (message (if notmuch-show-indent-content
+ "Content is indented."
+ "Content is not indented."))
+ (notmuch-show-refresh-view))
+
+(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)))
+ ;; We test whether there is a message or just some replies.
+ (when msg
+ (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))
+
+(defvar notmuch-id-regexp
+ (concat
+ ;; Match the id: prefix only if it begins a word (to disallow, for
+ ;; example, matching cid:).
+ "\\<id:\\("
+ ;; If the term starts with a ", then parse Xapian's quoted boolean
+ ;; term syntax, which allows for anything as long as embedded
+ ;; double quotes escaped by doubling them. We also disallow
+ ;; newlines (which Xapian allows) to prevent runaway terms.
+ "\"\\([^\"\n]\\|\"\"\\)*\""
+ ;; Otherwise, parse Xapian's unquoted syntax, which goes up to the
+ ;; next space or ). We disallow [.,;] as the last character
+ ;; because these are probably part of the surrounding text, and not
+ ;; part of the id. This doesn't match single character ids; meh.
+ "\\|[^\"[:space:])][^[:space:])]*[^])[:space:].,:;?!]"
+ "\\)")
+ "The regexp used to match id: links in messages.")
+
+(defvar notmuch-mid-regexp
+ ;; goto-address-url-regexp matched cid: links, which have the same
+ ;; grammar as the message ID part of a mid: link. Construct the
+ ;; regexp using the same technique as goto-address-url-regexp.
+ (concat "\\<mid:\\(" thing-at-point-url-path-regexp "\\)")
+ "The regexp used to match mid: links in messages.
+
+See RFC 2392.")
+
+(defun notmuch-show-buttonise-links (start end)
+ "Buttonise URLs and mail addresses between START and END.
+
+This also turns id:\"<message id>\"-parts and mid: links into
+buttons for a corresponding notmuch search."
+ (goto-address-fontify-region start end)
+ (save-excursion
+ (let (links)
+ (goto-char start)
+ (while (re-search-forward notmuch-id-regexp end t)
+ (push (list (match-beginning 0) (match-end 0)
+ (match-string-no-properties 0)) links))
+ (goto-char start)
+ (while (re-search-forward notmuch-mid-regexp end t)
+ (let* ((mid-cid (match-string-no-properties 1))
+ (mid (save-match-data
+ (string-match "^[^/]*" mid-cid)
+ (url-unhex-string (match-string 0 mid-cid)))))
+ (push (list (match-beginning 0) (match-end 0)
+ (notmuch-id-to-query mid)) links)))
+ (dolist (link links)
+ ;; Remove the overlay created by goto-address-mode
+ (remove-overlays (first link) (second link) 'goto-address t)
+ (make-text-button (first link) (second link)
+ :type 'notmuch-button-type
+ 'action `(lambda (arg)
+ (notmuch-show ,(third link) current-prefix-arg))
+ 'follow-link t
+ 'help-echo "Mouse-1, RET: search for this message"
+ 'face goto-address-mail-face)))))
+
+;;;###autoload
+(defun notmuch-show (thread-id &optional elide-toggle parent-buffer query-context buffer-name)
+ "Run \"notmuch show\" with the given thread ID and display results.
+
+ELIDE-TOGGLE, if non-nil, inverts the default elide behavior.
+
+The optional PARENT-BUFFER is the notmuch-search buffer from
+which this notmuch-show command was executed, (so that the
+next thread from that buffer can be show when done with this
+one).
+
+The optional QUERY-CONTEXT is a notmuch search term. Only
+messages from the thread matching this search term are shown if
+non-nil.
+
+The optional BUFFER-NAME provides the name of the buffer in
+which the message thread is shown. If it is nil (which occurs
+when the command is called interactively) the argument to the
+function is used."
+ (interactive "sNotmuch show: \nP")
+ (let ((buffer-name (generate-new-buffer-name
+ (or buffer-name
+ (concat "*notmuch-" thread-id "*")))))
+ (switch-to-buffer (get-buffer-create buffer-name))
+ ;; Set the default value for `notmuch-show-process-crypto' in this
+ ;; buffer.
+ (setq notmuch-show-process-crypto notmuch-crypto-process-mime)
+ ;; Set the default value for
+ ;; `notmuch-show-elide-non-matching-messages' in this buffer. If
+ ;; elide-toggle is set, invert the default.
+ (setq notmuch-show-elide-non-matching-messages notmuch-show-only-matching-messages)
+ (if elide-toggle
+ (setq notmuch-show-elide-non-matching-messages (not notmuch-show-elide-non-matching-messages)))
+
+ (setq notmuch-show-thread-id thread-id
+ notmuch-show-parent-buffer parent-buffer
+ notmuch-show-query-context query-context)
+ (notmuch-show-build-buffer)
+ (notmuch-show-goto-first-wanted-message)
+ (current-buffer)))
+
+(defun notmuch-show-build-buffer ()
+ (let ((inhibit-read-only t))
+
+ (notmuch-show-mode)
+ (add-hook 'post-command-hook #'notmuch-show-command-hook nil t)
+
+ ;; Don't track undo information for this buffer
+ (set 'buffer-undo-list t)
+
+ (notmuch-tag-clear-cache)
+ (erase-buffer)
+ (goto-char (point-min))
+ (save-excursion
+ (let* ((basic-args (list notmuch-show-thread-id))
+ (args (if notmuch-show-query-context
+ (append (list "\'") basic-args
+ (list "and (" notmuch-show-query-context ")\'"))
+ (append (list "\'") basic-args (list "\'"))))
+ (cli-args (cons "--exclude=false"
+ (when notmuch-show-elide-non-matching-messages
+ (list "--entire-thread=false")))))
+
+ (notmuch-show-insert-forest (notmuch-query-get-threads (append cli-args args)))
+ ;; If the query context reduced the results to nothing, run
+ ;; the basic query.
+ (when (and (eq (buffer-size) 0)
+ notmuch-show-query-context)
+ (notmuch-show-insert-forest
+ (notmuch-query-get-threads (append cli-args basic-args)))))
+
+ (jit-lock-register #'notmuch-show-buttonise-links)
+
+ (notmuch-show-mapc (lambda () (notmuch-show-set-prop :orig-tags (notmuch-show-get-tags))))
+
+ ;; Set the header line to the subject of the first message.
+ (setq header-line-format (notmuch-sanitize (notmuch-show-strip-re (notmuch-show-get-subject))))
+
+ (run-hooks 'notmuch-show-hook))))
+
+(defun notmuch-show-capture-state ()
+ "Capture the state of the current buffer.
+
+This includes:
+ - the list of open messages,
+ - the current message."
+ (list (notmuch-show-get-message-id) (notmuch-show-get-message-ids-for-open-messages)))
+
+(defun notmuch-show-get-query ()
+ "Return the current query in this show buffer"
+ (if notmuch-show-query-context
+ (concat notmuch-show-thread-id
+ " and ("
+ notmuch-show-query-context
+ ")")
+ notmuch-show-thread-id))
+
+(defun notmuch-show-apply-state (state)
+ "Apply STATE to the current buffer.
+
+This includes:
+ - opening the messages previously opened,
+ - closing all other messages,
+ - moving to the correct current message."
+ (let ((current (car state))
+ (open (cadr state)))
+
+ ;; Open those that were open.
+ (goto-char (point-min))
+ (loop do (notmuch-show-message-visible (notmuch-show-get-message-properties)
+ (member (notmuch-show-get-message-id) open))
+ until (not (notmuch-show-goto-message-next)))
+
+ ;; Go to the previously open message.
+ (goto-char (point-min))
+ (unless (loop if (string= current (notmuch-show-get-message-id))
+ return t
+ until (not (notmuch-show-goto-message-next)))
+ (goto-char (point-min))
+ (message "Previously current message not found."))
+ (notmuch-show-message-adjust)))
+
+(defun notmuch-show-refresh-view (&optional reset-state)
+ "Refresh the current view.
+
+Refreshes the current view, observing changes in display
+preferences. If invoked with a prefix argument (or RESET-STATE is
+non-nil) then the state of the buffer (open/closed messages) is
+reset based on the original query."
+ (interactive "P")
+ (let ((inhibit-read-only t)
+ (state (unless reset-state
+ (notmuch-show-capture-state))))
+ ;; erase-buffer does not seem to remove overlays, which can lead
+ ;; to weird effects such as remaining images, so remove them
+ ;; manually.
+ (remove-overlays)
+ (erase-buffer)
+ (notmuch-show-build-buffer)
+ (if state
+ (notmuch-show-apply-state state)
+ ;; We're resetting state, so navigate to the first open message
+ ;; and mark it read, just like opening a new show buffer.
+ (notmuch-show-goto-first-wanted-message))))