(require 'notmuch-lib)
(require 'notmuch-tag)
-(require 'notmuch-query)
(require 'notmuch-wash)
(require 'notmuch-mua)
(require 'notmuch-crypto)
(defvar shr-blocked-images)
(defvar gnus-blocked-images)
(defvar shr-content-function)
+(defvar w3m-ignored-image-url-regexp)
;;; Options
:type 'boolean
:group 'notmuch-show)
+(defcustom notmuch-show-header-line t
+ "Show a header line in notmuch show buffers.
+
+If t (the default), the header line will contain the current
+message's subject.
+
+If a string, this value is interpreted as a format string to be
+passed to `format-spec` with `%s` as the substitution variable
+for the message's subject. E.g., to display the subject trimmed
+to a maximum of 80 columns, you could use \"%>-80s\" as format.
+
+If you assign to this variable a function, it will be called with
+the subject as argument, and the return value will be used as the
+header line format. Since the function is called with the
+message buffer as the current buffer, it is also possible to
+access any other properties of the message, using for instance
+notmuch-show functions such as
+`notmuch-show-get-message-properties'.
+
+Finally, if this variable is set to nil, no header is
+displayed."
+ :type '(choice (const :tag "No header" ni)
+ (const :tag "Subject" t)
+ (string :tag "Format")
+ (function :tag "Function"))
+ :group 'notmuch-show)
+
+(defcustom notmuch-show-depth-limit nil
+ "Depth beyond which message bodies are displayed lazily.
+
+If bound to an integer, any message with tree depth greater than
+this will have its body display lazily, initially
+inserting only a button.
+
+If this variable is set to nil (the default) no such lazy
+insertion is done."
+ :type '(choice (const :tag "No limit" nil)
+ (number :tag "Limit" 10))
+ :group 'notmuch-show)
+
+(defcustom notmuch-show-height-limit nil
+ "Height (from leaves) beyond which message bodies are displayed lazily.
+
+If bound to an integer, any message with height in the message
+tree greater than this will have its body displayed lazily,
+initially only a button.
+
+If this variable is set to nil (the default) no such lazy
+display is done."
+ :type '(choice (const :tag "No limit" nil)
+ (number :tag "Limit" 10))
+ :group 'notmuch-show)
+
(defcustom notmuch-show-relative-dates t
"Display relative dates in the message summary line."
:type 'boolean
(let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))
(with-current-buffer buf
(let ((coding-system-for-read 'no-conversion))
- (call-process notmuch-command nil t nil "show" "--format=raw" id))
+ (notmuch--call-process notmuch-command nil t nil "show" "--format=raw" id))
,@body)
(kill-buffer buf)))))
;; Otherwise format the name and address together.
(concat p-name " <" p-address ">"))))
+(defun notmuch-show--mark-height (tree)
+ "Calculate and cache height (distance from deepest descendent)"
+ (let* ((msg (car tree))
+ (children (cadr tree))
+ (cached-height (plist-get msg :height)))
+ (or cached-height
+ (let ((height
+ (if (null children) 0
+ (1+ (apply #'max (mapcar #'notmuch-show--mark-height children))))))
+ (plist-put msg :height height)
+ height))))
+
(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."
t)
(defun notmuch-show-insert-part-message/rfc822 (msg part _content-type _nth depth _button)
- (let* ((message (car (plist-get part :content)))
- (body (car (plist-get message :body)))
- (start (point)))
- ;; Override `notmuch-message-headers' to force `From' to be
- ;; displayed.
- (let ((notmuch-message-headers '("From" "Subject" "To" "Cc" "Date")))
- (notmuch-show-insert-headers (plist-get message :headers)))
- ;; Blank line after headers to be compatible with the normal
- ;; message display.
- (insert "\n")
- ;; Show the body
- (notmuch-show-insert-bodypart msg body depth)
- (when notmuch-show-indent-multipart
- (indent-rigidly start (point) 1)))
- t)
+ (let ((message (car (plist-get part :content))))
+ (and
+ message
+ (let ((body (car (plist-get message :body)))
+ (start (point)))
+ ;; Override `notmuch-message-headers' to force `From' to be
+ ;; displayed.
+ (let ((notmuch-message-headers '("From" "Subject" "To" "Cc" "Date")))
+ (notmuch-show-insert-headers (plist-get message :headers)))
+ ;; Blank line after headers to be compatible with the normal
+ ;; message display.
+ (insert "\n")
+ ;; Show the body
+ (notmuch-show-insert-bodypart msg body depth)
+ (when notmuch-show-indent-multipart
+ (indent-rigidly start (point) 1))
+ t))))
(defun notmuch-show-insert-part-text/plain (msg part _content-type _nth depth button)
;; For backward compatibility we want to apply the text/plain hook
(let ((mm-inline-text-html-with-w3m-keymap nil)
;; FIXME: If we block an image, offer a button to load external
;; images.
- (gnus-blocked-images notmuch-show-text/html-blocked-images))
+ (gnus-blocked-images notmuch-show-text/html-blocked-images)
+ (w3m-ignored-image-url-regexp notmuch-show-text/html-blocked-images))
(notmuch-show-insert-part-*/* msg part content-type nth depth button))))
;;; Functions used by notmuch-show--insert-part-text/html-shr
(let* ((content-type (plist-get part :content-type))
(mime-type (notmuch-show-mime-type part))
(nth (plist-get part :id))
+ (height (plist-get msg :height))
(long (and (notmuch-match-content-type mime-type "text/*")
(> notmuch-show-max-text-part-size 0)
(> (length (plist-get part :content))
notmuch-show-max-text-part-size)))
+ (deep (and notmuch-show-depth-limit
+ (> depth notmuch-show-depth-limit)))
+ (high (and notmuch-show-height-limit
+ (> height notmuch-show-height-limit)))
(beg (point))
;; This default header-p function omits the part button for
;; the first (or only) part if this is text/plain.
- (button (and (funcall notmuch-show-insert-header-p-function part hide)
+ (button (and (or deep long high
+ (funcall notmuch-show-insert-header-p-function part hide))
(notmuch-show-insert-part-header
nth mime-type
(and content-type (downcase content-type))
(plist-get part :filename))))
- ;; Hide the part initially if HIDE is t, or if it is too long
+ ;; Hide the part initially if HIDE is t, or if it is too long/deep
;; and we have a button to allow toggling.
(show-part (not (or (equal hide t)
+ (and deep button)
+ (and high button)
(and long button))))
(content-beg (point)))
;; Store the computed mime-type for later use (e.g. by attachment handlers).
(replies (cadr tree)))
;; We test whether there is a message or just some replies.
(when msg
+ (notmuch-show--mark-height tree)
(notmuch-show-insert-msg msg depth))
(notmuch-show-insert-thread replies (1+ depth))))
(let ((buffer-name (generate-new-buffer-name
(or buffer-name
(concat "*notmuch-" thread-id "*"))))
- ;; We override mm-inline-override-types to stop application/*
- ;; parts from being displayed unless the user has customized
- ;; it themselves.
- (mm-inline-override-types
- (if (equal mm-inline-override-types
- (eval (car (get 'mm-inline-override-types 'standard-value))))
- (cons "application/*" mm-inline-override-types)
- mm-inline-override-types)))
+ (mm-inline-override-types (notmuch--inline-override-types)))
+
(pop-to-buffer-same-window (get-buffer-create buffer-name))
;; No need to track undo information for this buffer.
(setq buffer-undo-list t)
(push (list thread "and (" context ")") queries))
queries))
+(defun notmuch-show--header-line-format ()
+ "Compute the header line format of a notmuch-show buffer."
+ (when notmuch-show-header-line
+ (let* ((s (notmuch-sanitize
+ (notmuch-show-strip-re (notmuch-show-get-subject))))
+ (subject (replace-regexp-in-string "%" "%%" s)))
+ (cond ((stringp notmuch-show-header-line)
+ (format-spec notmuch-show-header-line `((?s . ,subject))))
+ ((functionp notmuch-show-header-line)
+ (funcall notmuch-show-header-line subject))
+ (notmuch-show-header-line subject)))))
+
(defun notmuch-show--build-buffer (&optional state)
"Display messages matching the current buffer context.
(notmuch-show-previous-subject ""))
;; Use results from the first query that returns some.
(while (and (not forest) queries)
- (setq forest (notmuch-query-get-threads
+ (setq forest (notmuch--run-show
(append cli-args (list "'") (car queries) (list "'"))))
(when (and forest notmuch-show-single-message)
(setq forest (list (list (list forest)))))
;; display changes.
(notmuch-show-mapc
(lambda () (notmuch-show-set-prop :orig-tags (notmuch-show-get-tags))))
- ;; Set the header line to the subject of the first message.
- (setq header-line-format
- (replace-regexp-in-string "%" "%%"
- (notmuch-sanitize
- (notmuch-show-strip-re
- (notmuch-show-get-subject)))))
+ (setq header-line-format (notmuch-show--header-line-format))
(run-hooks 'notmuch-show-hook)
(if state
(notmuch-show-apply-state state)
(pop-to-buffer-same-window buf)
(erase-buffer)
(let ((coding-system-for-read 'no-conversion))
- (call-process notmuch-command nil t nil "show" "--format=raw" id))
+ (notmuch--call-process notmuch-command nil t nil "show" "--format=raw" id))
(goto-char (point-min))
(set-buffer-modified-p nil)
(setq buffer-read-only t)
(let ((cwd default-directory)
(buf (get-buffer-create (concat "*notmuch-pipe*"))))
(with-current-buffer buf
- (setq buffer-read-only nil)
- (erase-buffer)
- ;; Use the originating buffer's working directory instead of
- ;; that of the pipe buffer.
- (cd cwd)
- (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)
- (pop-to-buffer buf)
- (message (format "Command '%s' exited abnormally with code %d"
- shell-command exit-code))))))))
+ (setq buffer-read-only t)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ ;; Use the originating buffer's working directory instead of
+ ;; that of the pipe buffer.
+ (cd cwd)
+ (let ((exit-code (call-process-shell-command shell-command nil buf)))
+ (goto-char (point-max))
+ (set-buffer-modified-p nil)
+ (unless (zerop exit-code)
+ (pop-to-buffer buf)
+ (message (format "Command '%s' exited abnormally with code %d"
+ shell-command exit-code)))))))))
(defun notmuch-show-tag-message (&rest tag-changes)
"Change tags for the current message.
If SHOW is non-nil, open the next item in a show
buffer. Otherwise just highlight the next item in the search
buffer. If PREVIOUS is non-nil, move to the previous item in the
-search results instead."
+search results instead.
+
+Return non-nil on success."
(interactive "P")
(let ((parent-buffer notmuch-show-parent-buffer))
(notmuch-bury-or-kill-this-buffer)