;; notmuch-show-display.el --- displaying notmuch forests.
;;
;; Copyright © Carl Worth
;; Copyright © David Edmondson
;;
;; This file is part of Notmuch.
;;
;; Notmuch is free software: you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Notmuch is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.
;;
;; Authors: Carl Worth <cworth@cworth.org>
;;          David Edmondson <dme@dme.org>

(require 'mm-view)
(require 'message)
(require 'mm-decode)
(require 'mailcap)

(require 'notmuch-lib)
(require 'notmuch-tag)
(require 'notmuch-wash)
(require 'notmuch-crypto)

(declare-function notmuch-show-get-header "notmuch-show" (header &optional props))
(declare-function notmuch-show-set-message-properties "notmuch-show" (props))
(declare-function notmuch-show-set-prop  "notmuch-show" (prop val &optional props))

(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-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)

(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-indent-content t)
(make-variable-buffer-local 'notmuch-show-indent-content)
(put 'notmuch-show-indent-content 'permanent-local t)

(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-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-show-clean-address (plist-get headers :From))
	    " ("
	    date
	    ") ("
	    (notmuch-tag-format-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 ": " 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)))))

(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 nth
	   :notmuch-filename name
	   :notmuch-content-type content-type))
    (insert "\n")
    ;; return button
    button))

;; This is taken from notmuch-wash: maybe it should be unified?
(defun notmuch-show-toggle-part-invisibility (&optional button)
  (interactive)
  (let* ((button (or button (button-at (point))))
	 (overlay (button-get button 'overlay)))
    (when overlay
      (let* ((show (overlay-get overlay 'invisible))
	     (new-start (button-start button))
	     (button-label (button-get button :base-label))
	     (old-point (point))
	     (inhibit-read-only t))
	(overlay-put overlay 'invisible (not show))
	(goto-char new-start)
	(insert "[ " button-label (if show " ]" " (hidden) ]"))
	(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))))))))

(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 declared-type)
  (notmuch-show-insert-part-header nth declared-type content-type nil)
  (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 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/signed (msg part content-type nth depth declared-type)
  (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil)))
    (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 declared-type)
  (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil)))
    (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 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)
  (notmuch-show-insert-part-header nth declared-type content-type nil)
  (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 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-get-bodypart-content msg part nth 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 declared-type)
  (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))
  (insert (with-temp-buffer
	    (insert (notmuch-get-bodypart-content msg part nth 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 declared-type)
  (notmuch-show-insert-part-text/calendar msg part content-type nth depth declared-type))

(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))))

;; Handler for wash generated inline patch fake parts.
(defun notmuch-show-insert-part-inline-patch-fake-part (msg part content-type nth depth declared-type)
  (notmuch-show-insert-part-*/* msg part content-type nth depth declared-type))

(defun notmuch-show-insert-part-text/html (msg part content-type nth depth declared-type)
  ;; 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 declared-type)))

(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))
  (notmuch-mm-display-part-inline msg part nth 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 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 (condition-case err
			 (funcall (car handlers) msg part content-type nth depth declared-type)
		       (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 (msg beg end hide)
  "Add an overlay to the part between BEG and END"
  (let* ((button (button-at beg))
	 (part-beg (and button (1+ (button-end button)))))

    ;; If the part contains no text we do not make it toggleable. We
    ;; also need to check that the button is a genuine part button not
    ;; a notmuch-wash button.
    (when (and button (/= part-beg end) (button-get button :base-label))
      (button-put button 'overlay (make-overlay part-beg end))
      ;; We toggle the button for hidden parts as that gets the
      ;; button label right.
      (save-excursion
	(when hide
	  (notmuch-show-toggle-part-invisibility button))))))

(defun notmuch-show-insert-bodypart (msg part depth &optional hide)
  "Insert the body part PART at depth DEPTH in the current thread.

If HIDE is non-nil then initially hide this part."
  (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)))

    (notmuch-show-insert-bodypart-internal msg part mime-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.
    (unless (bolp)
      (insert "\n"))
    (notmuch-show-create-part-overlays msg beg (point) hide)))

(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-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-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))

;; Functions relating to the visibility of messages and their
;; components.

(defun notmuch-show-message-visible (props visible-p)
  (overlay-put (plist-get props :message-overlay) 'invisible (not visible-p))
  (notmuch-show-set-prop :message-visible visible-p props))

(defun notmuch-show-headers-visible (props visible-p)
  (overlay-put (plist-get props :headers-overlay) 'invisible (not visible-p))
  (notmuch-show-set-prop :headers-visible visible-p props))

;;

(provide 'notmuch-show-display)