---
emacs/notmuch-show-display.el | 704 ++++++++++++++++++++++++++++++++++++++++-
emacs/notmuch-show.el | 692 ----------------------------------------
2 files changed, 703 insertions(+), 693 deletions(-)
diff --git a/emacs/notmuch-show-display.el b/emacs/notmuch-show-display.el
index 50d83ad..82678c2 100644
--- a/emacs/notmuch-show-display.el
+++ b/emacs/notmuch-show-display.el
@@ -21,5 +21,707 @@
;; Authors: Carl Worth <cworth@cworth.org>
;; David Edmondson <dme@dme.org>
+(require 'mm-view)
+(require 'message)
+(require 'mm-decode)
+(require 'mailcap)
-(provide 'notmuch-show-display)
\ No newline at end of file
+(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))
+
+;;
+
+(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)
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 37ba911..9e3401d 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -22,17 +22,12 @@
;; David Edmondson <dme@dme.org>
(eval-when-compile (require 'cl))
-(require 'mm-view)
-(require 'message)
-(require 'mm-decode)
-(require 'mailcap)
(require 'icalendar)
(require 'goto-addr)
(require 'notmuch-lib)
(require 'notmuch-tag)
(require 'notmuch-query)
-(require 'notmuch-wash)
(require 'notmuch-mua)
(require 'notmuch-crypto)
(require 'notmuch-print)
@@ -43,36 +38,6 @@
(declare-function notmuch-search-previous-thread "notmuch" nil)
(declare-function notmuch-search-show-thread "notmuch" 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
@@ -80,42 +45,6 @@ visible for any given message."
: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
@@ -143,18 +72,10 @@ indentation."
(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)
-
(defcustom notmuch-show-stash-mlarchive-link-alist
'(("Gmane" . "http://mid.gmane.org/")
("MARC" . "http://marc.info/?i=")
@@ -328,35 +249,6 @@ operation on the contents of the current buffer."
(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
@@ -367,104 +259,6 @@ operation on the contents of the current buffer."
(notmuch-tag-format-tags 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-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)))))
-
(define-button-type 'notmuch-show-part-button-type
'action 'notmuch-show-part-button-default
'keymap 'notmuch-show-part-button-map
@@ -483,26 +277,6 @@ message at DEPTH in the current thread."
"Submap for button commands")
(fset 'notmuch-show-part-button-map notmuch-show-part-button-map)
-(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))
-
;; Functions handling particular MIME parts.
(defmacro notmuch-with-temp-part-buffer (message-id nth &rest body)
@@ -550,447 +324,9 @@ message at DEPTH in the current thread."
(let ((handle (mm-make-handle (current-buffer) (list content-type))))
(mm-pipe-part handle))))
-;; 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))
-
-;;
-
-(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-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)
@@ -1018,23 +354,6 @@ If HIDE is non-nil then initially hide this part."
"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
@@ -1373,17 +692,6 @@ effects."
(loop do (funcall function)
while (notmuch-show-goto-message-next))))
-;; 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))
-
;; Functions for setting and getting attributes of the current
;; message.
--
1.7.9.1