;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'pcase))
+
(require 'mm-view)
(require 'message)
(require 'mm-decode)
(declare-function notmuch-count-attachments "notmuch" (mm-handle))
(declare-function notmuch-save-attachments "notmuch" (mm-handle &optional queryp))
(declare-function notmuch-tree "notmuch-tree"
- (&optional query query-context target buffer-name open-target))
+ (&optional query query-context target buffer-name open-target unthreaded))
(declare-function notmuch-tree-get-message-properties "notmuch-tree" nil)
+(declare-function notmuch-unthreaded
+ (&optional query query-context target buffer-name open-target))
(declare-function notmuch-read-query "notmuch" (prompt))
(declare-function notmuch-draft-resume "notmuch-draft" (id))
(make-variable-buffer-local 'notmuch-show-indent-content)
(defvar notmuch-show-attachment-debug nil
- "If t log stdout and stderr from attachment handlers
+ "If t log stdout and stderr from attachment handlers.
When set to nil (the default) stdout and stderr from attachment
handlers is discarded. When set to t the stdout and stderr from
24.3 to work.")
(defcustom notmuch-show-stash-mlarchive-link-alist
- '(("Gmane" . "http://mid.gmane.org/")
+ '(("Gmane" . "https://mid.gmane.org/")
("MARC" . "https://marc.info/?i=")
("Mail Archive, The" . "https://mid.mail-archive.com/")
("LKML" . "https://lkml.kernel.org/r/")
:type 'function
:group 'notmuch-show)
+(defcustom notmuch-show-imenu-indent nil
+ "Should Imenu display messages indented.
+
+By default, Imenu (see Info node `(emacs) Imenu') in a
+notmuch-show buffer displays all messages straight. This is
+because the default Emacs frontend for Imenu makes it difficult
+to select an Imenu entry with spaces in front. Other imenu
+frontends such as counsel-imenu does not have this limitation.
+In these cases, Imenu entries can be indented to reflect the
+position of the message in the thread."
+ :type 'boolean
+ :group 'notmuch-show)
+
(defmacro with-current-notmuch-show-message (&rest body)
- "Evaluate body with current buffer set to the text of current message"
+ "Evaluate body with current buffer set to the text of current message."
`(save-excursion
(let ((id (notmuch-show-get-message-id)))
(let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))
(with-temp-buffer
(insert all)
(if indenting
- (indent-rigidly (point-min) (point-max) (- depth)))
+ (indent-rigidly (point-min) (point-max) (- (* notmuch-show-indent-messages-width depth))))
;; Remove the original header.
(goto-char (point-min))
(re-search-forward "^$" (point-max) nil)
(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)
+ (cl-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))
- 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)))
+ until (string= start-of-loop p-name)))
;; If the address is 'foo@bar.com <foo@bar.com>' then show just
;; 'foo@bar.com'.
;; Recurse on sub-parts
(let ((ctype (notmuch-split-content-type
(downcase (plist-get part :content-type)))))
- (cond ((equal (first ctype) "multipart")
+ (cond ((equal (car ctype) "multipart")
(mapc (apply-partially #'notmuch-show--register-cids msg)
(plist-get part :content)))
((equal ctype '("message" "rfc822"))
(notmuch-show--register-cids
msg
- (first (plist-get (first (plist-get part :content)) :body)))))))
+ (car (plist-get (car (plist-get part :content)) :body)))))))
(defun notmuch-show--get-cid-content (cid)
"Return a list (CID-content content-type) or nil.
will return nil if the CID is unknown or cannot be retrieved."
(let ((descriptor (cdr (assoc cid notmuch-show--cids))))
(when descriptor
- (let* ((msg (first descriptor))
- (part (second descriptor))
+ (let* ((msg (car descriptor))
+ (part (cadr descriptor))
;; Request caching for this content, as some messages
;; reference the same cid: part many times (hundreds!).
(content (notmuch-get-bodypart-binary
(unless (assq 'notmuch-show-mode w3m-cid-retrieve-function-alist)
(push (cons 'notmuch-show-mode #'notmuch-show--cid-w3m-retrieve)
w3m-cid-retrieve-function-alist)))
- (setq mm-inline-text-html-with-images t))
+ (setq mm-html-inhibit-images nil))
(defvar w3m-current-buffer) ;; From `w3m.el'.
(defun notmuch-show--cid-w3m-retrieve (url &rest args)
(with-current-buffer w3m-current-buffer
(notmuch-show--get-cid-content cid))))
(when content-and-type
- (insert (first content-and-type))
- (second content-and-type))))
+ (insert (car content-and-type))
+ (cadr content-and-type))))
;; MIME part renderers
(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth button)
(notmuch-show-insert-part-text/calendar msg part content-type nth depth button))
+(if (version< emacs-version "25.3")
+ ;; https://bugs.gnu.org/28350
+ ;;
+ ;; For newer emacs, we fall back to notmuch-show-insert-part-*/*
+ ;; (see notmuch-show-handlers-for)
+ (defun notmuch-show-insert-part-text/enriched (msg part content-type nth depth button)
+ ;; By requiring enriched below, we ensure that the function enriched-decode-display-prop
+ ;; is defined before it will be shadowed by the letf below. Otherwise the version
+ ;; in enriched.el may be loaded a bit later and used instead (for the first time).
+ (require 'enriched)
+ (cl-letf (((symbol-function 'enriched-decode-display-prop)
+ (lambda (start end &optional param) (list start end))))
+ (notmuch-show-insert-part-*/* msg part content-type nth depth button))))
+
(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.
;; shr strips the "cid:" part of URL, but doesn't
;; URL-decode it (see RFC 2392).
(let ((cid (url-unhex-string url)))
- (first (notmuch-show--get-cid-content cid))))))
+ (car (notmuch-show--get-cid-content cid))))))
(shr-insert-document dom)
t))
(defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth button)
;; Run the handlers until one of them succeeds.
- (loop for handler in (notmuch-show-handlers-for content-type)
- until (condition-case err
- (funcall handler msg part content-type nth depth button)
- ;; Specifying `debug' here lets the debugger run if
- ;; `debug-on-error' is non-nil.
- ((debug error)
- (insert "!!! Bodypart handler `" (prin1-to-string handler) "' threw an error:\n"
- "!!! " (error-message-string err) "\n")
- nil))))
+ (cl-loop for handler in (notmuch-show-handlers-for content-type)
+ until (condition-case err
+ (funcall handler msg part content-type nth depth button)
+ ;; Specifying `debug' here lets the debugger run if
+ ;; `debug-on-error' is non-nil.
+ ((debug error)
+ (insert "!!! Bodypart handler `" (prin1-to-string handler)
+ "' threw an error:\n"
+ "!!! " (error-message-string err) "\n")
+ nil))))
(defun notmuch-show-create-part-overlays (button beg end)
- "Add an overlay to the part between BEG and END"
+ "Add an overlay to the part between BEG and END."
;; If there is no button (i.e., the part is text/plain and the first
;; part) or if the part has no content then we don't make the part
t))
(defun notmuch-show-record-part-information (part beg end)
- "Store PART as a text property from BEG to END"
+ "Store PART as a text property from BEG to END."
;; Record part information. Since we already inserted subparts,
;; don't override existing :notmuch-part properties.
;; watch out for sticky specs of t, which means all properties are
;; front-sticky/rear-nonsticky.
(notmuch-map-text-property beg end 'front-sticky
- (lambda (v) (if (listp v)
- (pushnew :notmuch-part v)
- v)))
+ (lambda (v)
+ (if (listp v)
+ (cl-pushnew :notmuch-part v)
+ v)))
(notmuch-map-text-property beg end 'rear-nonsticky
- (lambda (v) (if (listp v)
- (pushnew :notmuch-part v)
- v))))
+ (lambda (v)
+ (if (listp v)
+ (cl-pushnew :notmuch-part v)
+ v))))
(defun notmuch-show-lazy-part (part-args button)
;; Insert the lazy part after the button for the part. We would just
(narrow-to-region part-beg part-end)
(delete-region part-beg part-end)
(apply #'notmuch-show-insert-bodypart-internal part-args)
- (indent-rigidly part-beg part-end depth))
+ (indent-rigidly part-beg part-end (* notmuch-show-indent-messages-width depth)))
(goto-char part-end)
(delete-char 1)
- (notmuch-show-record-part-information (second part-args)
+ (notmuch-show-record-part-information (cadr part-args)
(button-start button)
part-end)
;; Create the overlay. If the lazy-part turned out to be empty/not
;; Register all content IDs for this message. According to RFC
;; 2392, content IDs are *global*, but it's okay if an MUA treats
;; them as only global within a message.
- (notmuch-show--register-cids msg (first body))
+ (notmuch-show--register-cids msg (car body))
(mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
(url-unhex-string (match-string 0 mid-cid)))))
(push (list (match-beginning 0) (match-end 0)
(notmuch-id-to-query mid)) links)))
- (dolist (link links)
+ (pcase-dolist (`(,beg ,end ,link) links)
;; Remove the overlay created by goto-address-mode
- (remove-overlays (first link) (second link) 'goto-address t)
- (make-text-button (first link) (second link)
+ (remove-overlays beg end 'goto-address t)
+ (make-text-button beg end
:type 'notmuch-button-type
'action `(lambda (arg)
- (notmuch-show ,(third link) current-prefix-arg))
+ (notmuch-show ,link current-prefix-arg))
'follow-link t
'help-echo "Mouse-1, RET: search for this message"
'face goto-address-mail-face)))))
;; aren't wiped out.
(setq notmuch-show-thread-id thread-id
notmuch-show-parent-buffer parent-buffer
- notmuch-show-query-context query-context
+ notmuch-show-query-context (if (or (string= query-context "")
+ (string= query-context "*"))
+ nil query-context)
notmuch-show-process-crypto notmuch-crypto-process-mime
;; If `elide-toggle', invert the default value.
(list win-id-combo (notmuch-show-get-message-ids-for-open-messages))))
(defun notmuch-show-get-query ()
- "Return the current query in this show buffer"
+ "Return the current query in this show buffer."
(if notmuch-show-query-context
(concat notmuch-show-thread-id
" and ("
(defun notmuch-show-goto-message (msg-id)
"Go to message with msg-id."
(goto-char (point-min))
- (unless (loop if (string= msg-id (notmuch-show-get-message-id))
- return t
- until (not (notmuch-show-goto-message-next)))
+ (unless (cl-loop if (string= msg-id (notmuch-show-get-message-id))
+ return t
+ until (not (notmuch-show-goto-message-next)))
(goto-char (point-min))
(message "Message-id not found."))
(notmuch-show-message-adjust))
;; Open those that were open.
(goto-char (point-min))
- (loop do (notmuch-show-message-visible (notmuch-show-get-message-properties)
- (member (notmuch-show-get-message-id) open))
- until (not (notmuch-show-goto-message-next)))
+ (cl-loop do (notmuch-show-message-visible (notmuch-show-get-message-properties)
+ (member (notmuch-show-get-message-id) open))
+ until (not (notmuch-show-goto-message-next)))
(dolist (win-msg-pair win-msg-alist)
(with-selected-window (car win-msg-pair)
(define-key map "G" 'notmuch-show-stash-git-send-email)
(define-key map "?" 'notmuch-subkeymap-help)
map)
- "Submap for stash commands")
+ "Submap for stash commands.")
(fset 'notmuch-show-stash-map notmuch-show-stash-map)
(defvar notmuch-show-part-map
(define-key map "m" 'notmuch-show-choose-mime-of-part)
(define-key map "?" 'notmuch-subkeymap-help)
map)
- "Submap for part commands")
+ "Submap for part commands.")
(fset 'notmuch-show-part-map notmuch-show-part-map)
(defvar notmuch-show-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map notmuch-common-keymap)
(define-key map "Z" 'notmuch-tree-from-show-current-query)
+ (define-key map "U" 'notmuch-unthreaded-from-show-current-query)
(define-key map (kbd "<C-tab>") 'widget-backward)
(define-key map (kbd "M-TAB") 'notmuch-show-previous-button)
(define-key map (kbd "<backtab>") 'notmuch-show-previous-button)
(define-key map "<" 'notmuch-show-toggle-thread-indentation)
(define-key map "t" 'toggle-truncate-lines)
(define-key map "." 'notmuch-show-part-map)
+ (define-key map "B" 'notmuch-show-browse-urls)
map)
"Keymap for \"notmuch show\" buffers.")
(fset 'notmuch-show-mode-map notmuch-show-mode-map)
\\{notmuch-show-mode-map}"
(setq notmuch-buffer-refresh-function #'notmuch-show-refresh-view)
(setq buffer-read-only t
- truncate-lines t))
+ truncate-lines t)
+ (setq imenu-prev-index-position-function
+ #'notmuch-show-imenu-prev-index-position-function)
+ (setq imenu-extract-index-name-function
+ #'notmuch-show-imenu-extract-index-name-function))
(defun notmuch-tree-from-show-current-query ()
- "Call notmuch tree with the current query"
+ "Call notmuch tree with the current query."
(interactive)
(notmuch-tree notmuch-show-thread-id
notmuch-show-query-context
(notmuch-show-get-message-id)))
+(defun notmuch-unthreaded-from-show-current-query ()
+ "Call notmuch unthreaded with the current query."
+ (interactive)
+ (notmuch-unthreaded notmuch-show-thread-id
+ notmuch-show-query-context
+ (notmuch-show-get-message-id)))
+
(defun notmuch-show-move-to-message-top ()
(goto-char (notmuch-show-message-top)))
;; region a->b is not found when point is at b. We walk backwards
;; until finding the property.
(defun notmuch-show-message-extent ()
+ "Return a cons cell containing the start and end buffer offset
+of the current message."
(let (r)
(save-excursion
(while (not (setq r (get-text-property (point) :notmuch-message-extent)))
effects."
(save-excursion
(goto-char (point-min))
- (loop do (funcall function)
- while (notmuch-show-goto-message-next))))
+ (cl-loop do (funcall function)
+ while (notmuch-show-goto-message-next))))
;; Functions relating to the visibility of messages and their
;; components.
;; dme: Would it make sense to use a macro for many of these?
+;; XXX TODO figure out what to do about multiple filenames
(defun notmuch-show-get-filename ()
"Return the filename of the current message."
- (notmuch-show-get-prop :filename))
+ (car (notmuch-show-get-prop :filename)))
(defun notmuch-show-get-header (header &optional props)
"Return the named header of the current message, if any."
(notmuch-show-message-visible props (plist-get props :match))))
(defun notmuch-show-goto-first-wanted-message ()
- "Move to the first open message and mark it read"
+ "Move to the first open message and mark it read."
(goto-char (point-min))
(unless (notmuch-show-message-visible-p)
(notmuch-show-next-open-message))
(interactive)
(save-excursion
(goto-char (point-min))
- (loop do (notmuch-show-message-visible (notmuch-show-get-message-properties)
- (not current-prefix-arg))
- until (not (notmuch-show-goto-message-next))))
+ (cl-loop do (notmuch-show-message-visible (notmuch-show-get-message-properties)
+ (not current-prefix-arg))
+ until (not (notmuch-show-goto-message-next))))
(force-window-update))
(defun notmuch-show-next-button ()
(notmuch-tag-change-list notmuch-archive-tags unarchive))))
(defun notmuch-show-archive-message-then-next-or-exit ()
- "Archive the current message, then show the next open message in the current thread.
+ "Archive current message, then show next open message in current thread.
If at the last open message in the current thread, then exit back
to search results."
(notmuch-show-next-open-message t))
(defun notmuch-show-archive-message-then-next-or-next-thread ()
- "Archive the current message, then show the next open message in the current thread.
+ "Archive current message, then show next open message in current or next thread.
If at the last open message in the current thread, then show next
thread from search."
(view-buffer buf 'kill-buffer-if-not-modified))))
(defun notmuch-show-choose-mime-of-part (mime-type)
- "Choose the mime type to use for displaying part"
+ "Choose the mime type to use for displaying part."
(interactive
(list (completing-read "Mime type to use (default text/plain): "
(mailcap-mime-types) nil nil nil nil "text/plain")))
(notmuch-show-apply-to-current-part-handle #'notmuch-show--mm-display-part mime-type))
+(defun notmuch-show-imenu-prev-index-position-function ()
+ "Move point to previous message in notmuch-show buffer.
+This function is used as a value for
+`imenu-prev-index-position-function'."
+ (if (bobp)
+ nil
+ (notmuch-show-previous-message)
+ t))
+
+(defun notmuch-show-imenu-extract-index-name-function ()
+ "Return imenu name for line at point.
+This function is used as a value for
+`imenu-extract-index-name-function'. Point should be at the
+beginning of the line."
+ (back-to-indentation)
+ (buffer-substring-no-properties (if notmuch-show-imenu-indent
+ (line-beginning-position)
+ (point))
+ (line-end-position)))
+
+(defmacro notmuch-show--with-currently-shown-message (&rest body)
+ "Evaluate BODY with display restricted to the currently shown
+message."
+ `(save-excursion
+ (save-restriction
+ (let ((extent (notmuch-show-message-extent)))
+ (narrow-to-region (car extent) (cdr extent))
+ ,@body))))
+
+(defun notmuch-show--gather-urls ()
+ "Gather any URLs in the current message."
+ (notmuch-show--with-currently-shown-message
+ (let (urls)
+ (goto-char (point-min))
+ (while (re-search-forward goto-address-url-regexp (point-max) t)
+ (push (match-string-no-properties 0) urls))
+ (reverse urls))))
+
+(defun notmuch-show-browse-urls (&optional kill)
+ "Offer to browse any URLs in the current message.
+With a prefix argument, copy the URL to the kill ring rather than
+browsing."
+ (interactive "P")
+ (let ((urls (notmuch-show--gather-urls))
+ (prompt (if kill "Copy URL to kill ring: " "Browse URL: "))
+ (fn (if kill #'kill-new #'browse-url)))
+ (if urls
+ (funcall fn (completing-read prompt urls nil nil nil nil (car urls)))
+ (message "No URLs found."))))
+
(provide 'notmuch-show)
;;; notmuch-show.el ends here