(require 'message)
(require 'mm-decode)
(require 'mailcap)
+(require 'icalendar)
(require 'notmuch-lib)
(require 'notmuch-query)
:group 'notmuch
:type 'boolean)
+(defcustom notmuch-show-elide-same-subject nil
+ "Do not show the subject of a collapsed message if it is the
+same as that of the previous message."
+ :group 'notmuch
+ :type 'boolean)
+
+(defcustom notmuch-show-always-show-subject t
+ "Should a collapsed message show the `Subject:' line?"
+ :group 'notmuch
+ :type 'boolean)
+
(defvar notmuch-show-markup-headers-hook '(notmuch-show-colour-headers)
"A list of functions called to decorate the headers listed in
`notmuch-message-headers'.")
notmuch-wash-elide-blank-lines
notmuch-wash-excerpt-citations))
+;; Mostly useful for debugging.
+(defcustom notmuch-show-all-multipart/alternative-parts nil
+ "Should all parts of multipart/alternative parts be shown?"
+ :group 'notmuch
+ :type 'boolean)
+
+(defcustom notmuch-show-indent-multipart nil
+ "Should the sub-parts of a multipart/* part be indented?"
+ ;; dme: Not sure which is a good default.
+ :group 'notmuch
+ :type 'boolean)
+
(defmacro with-current-notmuch-show-message (&rest body)
"Evaluate body with current buffer set to the text of current message"
`(save-excursion
'face 'notmuch-tag-face)
")"))))))
+(defun notmuch-show-clean-address (address)
+ "Clean a single email address for display."
+ (let* ((parsed (mail-header-parse-address address))
+ (address (car parsed))
+ (name (cdr parsed)))
+ ;; Remove double quotes. They might be required during transport,
+ ;; but we don't need to see them.
+ (when name
+ (setq name (replace-regexp-in-string "\"" "" name)))
+ ;; If the address is 'foo@bar.com <foo@bar.com>' then show just
+ ;; 'foo@bar.com'.
+ (when (string= name address)
+ (setq name nil))
+
+ (if (not name)
+ address
+ (concat name " <" 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 depth)
- (plist-get headers :From)
+ (notmuch-show-clean-address (plist-get headers :From))
" ("
date
") ("
'follow-link t
'face 'message-mml)
-(defun notmuch-show-insert-part-header (nth content-type declared-type &optional name)
+(defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment)
(insert-button
(concat "[ "
(if name (concat name ": ") "")
(if (not (string-equal declared-type content-type))
(concat " (as " content-type ")")
"")
+ (or comment "")
" ]\n")
:type 'notmuch-show-part-button-type
:notmuch-part nth
t)
nil)))))
+(defvar notmuch-show-multipart/alternative-discouraged
+ '(
+ ;; Avoid HTML parts.
+ "text/html"
+ ;; multipart/related usually contain a text/html part and some associated graphics.
+ "multipart/related"
+ ))
+
+(defun notmuch-show-multipart/*-to-list (part)
+ (mapcar '(lambda (inner-part) (plist-get inner-part :content-type))
+ (plist-get part :content)))
+
+(defun notmuch-show-multipart/alternative-choose (types)
+ ;; Based on `mm-preferred-alternative-precedence'.
+ (let ((seq types))
+ (dolist (pref (reverse notmuch-show-multipart/alternative-discouraged))
+ (dolist (elem (copy-sequence seq))
+ (when (string-match pref elem)
+ (setq seq (nconc (delete elem seq) (list elem))))))
+ seq))
+
+(defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth declared-type)
+ (notmuch-show-insert-part-header nth declared-type content-type nil)
+ (let ((chosen-type (car (notmuch-show-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))
+ (inner-parts (plist-get part :content))
+ (start (point)))
+ ;; This inserts all parts of the chosen type rather than just one,
+ ;; but it's not clear that this is the wrong thing to do - which
+ ;; should be chosen if there are more than one that match?
+ (mapc (lambda (inner-part)
+ (let ((inner-type (plist-get inner-part :content-type)))
+ (if (or notmuch-show-all-multipart/alternative-parts
+ (string= chosen-type inner-type))
+ (notmuch-show-insert-bodypart msg inner-part depth)
+ (notmuch-show-insert-part-header (plist-get inner-part :id) inner-type inner-type nil " (not shown)"))))
+ inner-parts)
+
+ (when notmuch-show-indent-multipart
+ (indent-rigidly start (point) 1)))
+ t)
+
+(defun notmuch-show-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-show-get-bodypart-internal (concat "id:" message-id)
+ part-number))
+ (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/* (msg part content-type nth depth declared-type)
+ (notmuch-show-insert-part-header nth declared-type content-type nil)
+ (let ((inner-parts (plist-get part :content))
+ (start (point)))
+ ;; Show all of the parts.
+ (mapc (lambda (inner-part)
+ (notmuch-show-insert-bodypart msg inner-part depth))
+ inner-parts)
+
+ (when notmuch-show-indent-multipart
+ (indent-rigidly start (point) 1)))
+ t)
+
+(defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth declared-type)
+ (let* ((message-part (plist-get part :content))
+ (inner-parts (plist-get message-part :content)))
+ (notmuch-show-insert-part-header nth declared-type content-type nil)
+ ;; Override `notmuch-message-headers' to force `From' to be
+ ;; displayed.
+ (let ((notmuch-message-headers '("From" "Subject" "To" "Cc" "Date")))
+ (notmuch-show-insert-headers (plist-get part :headers)))
+ ;; Blank line after headers to be compatible with the normal
+ ;; message display.
+ (insert "\n")
+
+ ;; Show all of the parts.
+ (mapc (lambda (inner-part)
+ (notmuch-show-insert-bodypart msg inner-part depth))
+ inner-parts))
+ t)
+
(defun notmuch-show-insert-part-text/plain (msg part content-type nth depth declared-type)
(let ((start (point)))
;; If this text/plain part is not the first part in the message,
(run-hook-with-args 'notmuch-show-insert-text/plain-hook depth))))
t)
+(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth declared-type)
+ (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))
+ (insert (with-temp-buffer
+ (insert (notmuch-show-get-bodypart-content msg part nth))
+ (goto-char (point-min))
+ (let ((file (make-temp-file "notmuch-ical"))
+ result)
+ (icalendar--convert-ical-to-diary
+ (icalendar--read-element nil nil)
+ file t)
+ (set-buffer (get-file-buffer file))
+ (setq result (buffer-substring (point-min) (point-max)))
+ (set-buffer-modified-p nil)
+ (kill-buffer (current-buffer))
+ (delete-file file)
+ result)))
+ t)
+
(defun notmuch-show-insert-part-application/octet-stream (msg part content-type nth depth declared-type)
;; If we can deduce a MIME type from the filename of the attachment,
;; do so and pass it on to the handler for that type.
(with-temp-buffer
(let ((coding-system-for-read 'no-conversion))
(call-process notmuch-command nil t nil
- "part" (format "--part=%s" part-number) message-id)
+ "show" "--format=raw" (format "--part=%s" part-number) message-id)
(buffer-string))))
(defun notmuch-show-get-bodypart-content (msg part nth)
;; 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))
+ (when (and notmuch-show-elide-same-subject
+ (not (string= notmuch-show-previous-subject
+ bare-subject)))
(forward-line 1))
(setq headers-start (point-marker)))
(setq headers-end (point-marker))
projects / notmuch / blobdiff