;;; 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
: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 "*"))))
(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
(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
;; 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)
- (letf (((symbol-function 'enriched-decode-display-prop)
+ (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))))
;; 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
(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)))))
(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)
#'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)))
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.
(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 ()
(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")))
(push (match-string-no-properties 0) urls))
(reverse urls))))
-(defun notmuch-show-browse-urls ()
- "Offer to browse any URLs in the current message."
- (interactive)
- (let ((urls (notmuch-show--gather-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
- (browse-url (completing-read "Browse URL: " (cdr urls) nil nil (car urls)))
+ (funcall fn (completing-read prompt urls nil nil nil nil (car urls)))
(message "No URLs found."))))
(provide 'notmuch-show)
projects / notmuch / blobdiff