(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.
(defun notmuch-show-make-symbol (type)
(make-symbol (concat "notmuch-show-" type)))
+(defun notmuch-show-strip-re (string)
+ (replace-regexp-in-string "\\([Rr]e: *\\)+" "" string))
+
+(defvar notmuch-show-previous-subject "")
+(make-variable-buffer-local 'notmuch-show-previous-subject)
+
(defun notmuch-show-insert-msg (msg depth)
"Insert the message MSG at depth DEPTH in the current thread."
- (let ((headers (plist-get msg :headers))
- ;; Indentation causes the buffer offset of the start/end
- ;; points to move, so we must use markers.
- message-start message-end
- content-start content-end
- headers-start headers-end
- body-start body-end
- (headers-invis-spec (notmuch-show-make-symbol "header"))
- (message-invis-spec (notmuch-show-make-symbol "message")))
+ (let* ((headers (plist-get msg :headers))
+ ;; Indentation causes the buffer offset of the start/end
+ ;; points to move, so we must use markers.
+ message-start message-end
+ content-start content-end
+ headers-start headers-end
+ body-start body-end
+ (headers-invis-spec (notmuch-show-make-symbol "header"))
+ (message-invis-spec (notmuch-show-make-symbol "message"))
+ (bare-subject (notmuch-show-strip-re (plist-get headers :Subject))))
;; Set `buffer-invisibility-spec' to `nil' (a list), otherwise
;; removing items from `buffer-invisibility-spec' (which is what
(insert "\n")
(save-excursion
(goto-char content-start)
- (forward-line 1)
+ ;; 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 (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))
+ (setq notmuch-show-previous-subject bare-subject)
+
(setq body-start (point-marker))
(notmuch-show-insert-body msg (plist-get msg :body) depth)
;; Ensure that the body ends with a newline.
;; Move straight to the first open message
(if (not (notmuch-show-message-visible-p))
(notmuch-show-next-open-message))
+
+ ;; Set the header line to the subject of the first open message.
+ (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))
+
(notmuch-show-mark-read)))
(defvar notmuch-show-stash-map
(defun notmuch-show-view-raw-message ()
"View the file holding the current message."
(interactive)
- (let ((id (notmuch-show-get-message-id)))
- (let ((buf (get-buffer-create (concat "*notmuch-raw-" id "*"))))
- (switch-to-buffer buf)
- (save-excursion
- (call-process notmuch-command nil t nil "show" "--format=raw" id)))))
+ (let* ((id (notmuch-show-get-message-id))
+ (buf (get-buffer-create (concat "*notmuch-raw-" id "*"))))
+ (call-process notmuch-command nil buf nil "show" "--format=raw" id)
+ (switch-to-buffer buf)
+ (goto-char (point-min))
+ (set-buffer-modified-p nil)
+ (view-buffer buf 'kill-buffer-if-not-modified)))
(defun notmuch-show-pipe-message (entire-thread command)
"Pipe the contents of the current message (or thread) to the given command.
The given command will be executed with the raw contents of the
current email message as stdin. Anything printed by the command
-to stdout or stderr will appear in the *Messages* buffer.
+to stdout or stderr will appear in the *notmuch-pipe* buffer.
When invoked with a prefix argument, the command will receive all
open messages in the current thread (formatted as an mbox) rather
(setq shell-command
(concat notmuch-command " show --format=raw "
(shell-quote-argument (notmuch-show-get-message-id)) " | " command)))
- (start-process-shell-command "notmuch-pipe-command" "*notmuch-pipe*" shell-command)))
+ (let ((buf (get-buffer-create (concat "*notmuch-pipe*"))))
+ (with-current-buffer buf
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (let ((exit-code (call-process-shell-command shell-command nil buf)))
+ (goto-char (point-max))
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ (unless (zerop exit-code)
+ (switch-to-buffer-other-window buf)
+ (message (format "Command '%s' exited abnormally with code %d"
+ shell-command exit-code))))))))
(defun notmuch-show-add-tags-worker (current-tags add-tags)
"Add to `current-tags' with any tags from `add-tags' not
(interactive)
(notmuch-show-archive-thread-internal nil))
-(defun notmuch-show-do-stash (text)
- (kill-new text)
- (message "Saved: %s" text))
-
(defun notmuch-show-stash-cc ()
"Copy CC field of current message to kill-ring."
(interactive)
- (notmuch-show-do-stash (notmuch-show-get-cc)))
+ (notmuch-common-do-stash (notmuch-show-get-cc)))
(defun notmuch-show-stash-date ()
"Copy date of current message to kill-ring."
(interactive)
- (notmuch-show-do-stash (notmuch-show-get-date)))
+ (notmuch-common-do-stash (notmuch-show-get-date)))
(defun notmuch-show-stash-filename ()
"Copy filename of current message to kill-ring."
(interactive)
- (notmuch-show-do-stash (notmuch-show-get-filename)))
+ (notmuch-common-do-stash (notmuch-show-get-filename)))
(defun notmuch-show-stash-from ()
"Copy From address of current message to kill-ring."
(interactive)
- (notmuch-show-do-stash (notmuch-show-get-from)))
+ (notmuch-common-do-stash (notmuch-show-get-from)))
(defun notmuch-show-stash-message-id ()
"Copy message ID of current message to kill-ring."
(interactive)
- (notmuch-show-do-stash (notmuch-show-get-message-id)))
+ (notmuch-common-do-stash (notmuch-show-get-message-id)))
(defun notmuch-show-stash-subject ()
"Copy Subject field of current message to kill-ring."
(interactive)
- (notmuch-show-do-stash (notmuch-show-get-subject)))
+ (notmuch-common-do-stash (notmuch-show-get-subject)))
(defun notmuch-show-stash-tags ()
"Copy tags of current message to kill-ring as a comma separated list."
(interactive)
- (notmuch-show-do-stash (mapconcat 'identity (notmuch-show-get-tags) ",")))
+ (notmuch-common-do-stash (mapconcat 'identity (notmuch-show-get-tags) ",")))
(defun notmuch-show-stash-to ()
"Copy To address of current message to kill-ring."
(interactive)
- (notmuch-show-do-stash (notmuch-show-get-to)))
+ (notmuch-common-do-stash (notmuch-show-get-to)))
;; Commands typically bound to buttons.
projects / notmuch / blobdiff