-;;; notmuch-show.el --- displaying notmuch forests
+;;; notmuch-show.el --- displaying notmuch forests -*- lexical-binding: t -*-
;;
;; Copyright © Carl Worth
;; Copyright © David Edmondson
(declare-function notmuch-read-query "notmuch" (prompt))
(declare-function notmuch-draft-resume "notmuch-draft" (id))
+(defvar shr-blocked-images)
+(defvar gnus-blocked-images)
+(defvar shr-content-function)
+
+;;; Options
+
(defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
"Headers that should be shown in a message, in this order.
:type '(choice (const nil) regexp)
:group 'notmuch-show)
-(defvar notmuch-show-thread-id nil)
-(make-variable-buffer-local 'notmuch-show-thread-id)
+;;; Variables
-(defvar notmuch-show-parent-buffer nil)
-(make-variable-buffer-local 'notmuch-show-parent-buffer)
+(defvar-local notmuch-show-thread-id nil)
-(defvar notmuch-show-query-context nil)
-(make-variable-buffer-local 'notmuch-show-query-context)
+(defvar-local notmuch-show-parent-buffer nil)
-(defvar notmuch-show-process-crypto nil)
-(make-variable-buffer-local 'notmuch-show-process-crypto)
+(defvar-local notmuch-show-query-context nil)
-(defvar notmuch-show-elide-non-matching-messages nil)
-(make-variable-buffer-local 'notmuch-show-elide-non-matching-messages)
+(defvar-local notmuch-show-process-crypto nil)
-(defvar notmuch-show-indent-content t)
-(make-variable-buffer-local 'notmuch-show-indent-content)
+(defvar-local notmuch-show-elide-non-matching-messages nil)
+
+(defvar-local notmuch-show-indent-content t)
(defvar notmuch-show-attachment-debug nil
"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
each attachment handler is logged in buffers with names beginning
-\" *notmuch-part*\". This option requires emacs version at least
-24.3 to work.")
+\" *notmuch-part*\".")
+
+;;; Options
(defcustom notmuch-show-stash-mlarchive-link-alist
'(("Gmane" . "https://mid.gmane.org/")
:type 'boolean
:group 'notmuch-show)
+;;; Utilities
+
(defmacro with-current-notmuch-show-message (&rest body)
"Evaluate body with current buffer set to the text of current message."
`(save-excursion
"Enable Visual Line mode."
(visual-line-mode t))
+;;; Commands
+
;; DEPRECATED in Notmuch 0.16 since we now have convenient part
;; commands. We'll keep the command around for a version or two in
;; case people want to bind it themselves.
(interactive)
(notmuch-show-with-message-as-text 'notmuch-print-message))
+;;; Headers
+
(defun notmuch-show-fontify-header ()
(let ((face (cond
((looking-at "[Tt]o:")
(narrow-to-region start (point-max))
(run-hooks 'notmuch-show-markup-headers-hook)))))
+;;; Parts
+
(define-button-type 'notmuch-show-part-button-type
'action 'notmuch-show-part-button-default
'follow-link t
(overlay-put overlay 'invisible (not show))
t)))))))
-;; Part content ID handling
+;;; Part content ID handling
(defvar notmuch-show--cids nil
"Alist from raw content ID to (MSG PART).")
;; alternative (even if we can't render it).
(push (list content-id msg part) notmuch-show--cids)))
;; Recurse on sub-parts
- (let ((ctype (notmuch-split-content-type
- (downcase (plist-get part :content-type)))))
- (cond ((equal (car ctype) "multipart")
+ (pcase-let ((`(,content ,type)
+ (split-string (downcase (plist-get part :content-type)) "/")))
+ (cond ((equal content "multipart")
(mapc (apply-partially #'notmuch-show--register-cids msg)
(plist-get part :content)))
- ((equal ctype '("message" "rfc822"))
+ ((and (equal content "message")
+ (equal type "rfc822"))
(notmuch-show--register-cids
msg
(car (plist-get (car (plist-get part :content)) :body)))))))
(gnus-blocked-images notmuch-show-text/html-blocked-images))
(notmuch-show-insert-part-*/* msg part content-type nth depth button))))
-;; These functions are used by notmuch-show--insert-part-text/html-shr
+;;; Functions used by notmuch-show--insert-part-text/html-shr
+
(declare-function libxml-parse-html-region "xml.c")
(declare-function shr-insert-document "shr")
(notmuch-mm-display-part-inline msg part content-type notmuch-show-process-crypto)
t)
-;; Functions for determining how to handle MIME parts.
+;;; Functions for determining how to handle MIME parts.
(defun notmuch-show-handlers-for (content-type)
"Return a list of content handlers for a part of type CONTENT-TYPE."
(push func result)))
;; Reverse order of prefrence.
(list (intern (concat "notmuch-show-insert-part-*/*"))
- (intern (concat
- "notmuch-show-insert-part-"
- (car (notmuch-split-content-type content-type))
- "/*"))
+ (intern (concat "notmuch-show-insert-part-"
+ (car (split-string content-type "/"))
+ "/*"))
(intern (concat "notmuch-show-insert-part-" content-type))))
result))
-;; \f
+;;; Parts
(defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth button)
;; Run the handlers until one of them succeeds.
(notmuch-show-message-visible msg (and (plist-get msg :match)
(not (plist-get msg :excluded))))))
+;;; Toggle commands
+
(defun notmuch-show-toggle-process-crypto ()
"Toggle the processing of cryptographic MIME parts."
(interactive)
"Content is not indented."))
(notmuch-show-refresh-view))
+;;; Main insert functions
+
(defun notmuch-show-insert-tree (tree depth)
"Insert the message tree TREE at depth DEPTH in the current thread."
(let ((msg (car tree))
"Insert the forest of threads FOREST."
(mapc (lambda (thread) (notmuch-show-insert-thread thread 0)) forest))
+;;; Link buttons
+
(defvar notmuch-id-regexp
(concat
;; Match the id: prefix only if it begins a word (to disallow, for
'help-echo "Mouse-1, RET: search for this message"
'face goto-address-mail-face)))))
+;;; Show command
+
;;;###autoload
(defun notmuch-show (thread-id &optional elide-toggle parent-buffer query-context buffer-name)
"Run \"notmuch show\" with the given thread ID and display results.
;; Report back to the caller whether any messages matched.
forest))
+;;; Refresh command
+
(defun notmuch-show-capture-state ()
"Capture the state of the current buffer.
(ding)
(message "Refreshing the buffer resulted in no messages!"))))
+;;; Keymaps
+
(defvar notmuch-show-stash-map
(let ((map (make-sparse-keymap)))
(define-key map "c" 'notmuch-show-stash-cc)
(define-key map "B" 'notmuch-show-browse-urls)
map)
"Keymap for \"notmuch show\" buffers.")
-(fset 'notmuch-show-mode-map notmuch-show-mode-map)
+
+;;; Mode
(define-derived-mode notmuch-show-mode fundamental-mode "notmuch-show"
"Major mode for viewing a thread with notmuch.
(setq imenu-extract-index-name-function
#'notmuch-show-imenu-extract-index-name-function))
+;;; Tree commands
+
(defun notmuch-tree-from-show-current-query ()
"Call notmuch tree with the current query."
(interactive)
notmuch-show-query-context
(notmuch-show-get-message-id)))
+;;; Movement related functions.
+
(defun notmuch-show-move-to-message-top ()
(goto-char (notmuch-show-message-top)))
(defun notmuch-show-move-to-message-bottom ()
(goto-char (notmuch-show-message-bottom)))
-(defun notmuch-show-message-adjust ()
- (recenter 0))
-
-;; Movement related functions.
-
;; There's some strangeness here where a text property applied to a
;; region a->b is not found when point is at b. We walk backwards
;; until finding the property.
(cl-loop do (funcall function)
while (notmuch-show-goto-message-next))))
-;; Functions relating to the visibility of messages and their
-;; components.
+;;; Functions relating to the visibility of messages and their components.
(defun notmuch-show-message-visible (props visible-p)
(overlay-put (plist-get props :message-overlay) 'invisible (not visible-p))
(overlay-put (plist-get props :headers-overlay) 'invisible (not visible-p))
(notmuch-show-set-prop :headers-visible visible-p props))
-;; Functions for setting and getting attributes of the current
-;; message.
+;;; Functions for setting and getting attributes of the current message.
(defun notmuch-show-set-message-properties (props)
(save-excursion
(funcall notmuch-show-mark-read-function (window-start) (window-end))
((debug error)
(unless notmuch-show--seen-has-errored
- (setq notmuch-show--seen-has-errored 't)
+ (setq notmuch-show--seen-has-errored t)
(setq header-line-format
(concat header-line-format
(propertize
(notmuch-show-refresh-view t)
(notmuch-show-goto-message msg-id)))
-;; Functions for getting attributes of several messages in the current
-;; thread.
+;;; Functions for getting attributes of several messages in the current thread.
(defun notmuch-show-get-message-ids-for-open-messages ()
"Return a list of all id: queries for open messages in the current thread."
(setq done (not (notmuch-show-goto-message-next))))
message-ids)))
-;; Commands typically bound to keys.
+;;; Commands typically bound to keys.
(defun notmuch-show-advance ()
"Advance through thread.
(message-resend addresses)
(notmuch-bury-or-kill-this-buffer)))
+(defun notmuch-show-message-adjust ()
+ (recenter 0))
+
(defun notmuch-show-next-message (&optional pop-at-end)
"Show the next message.
(browse-url (current-kill 0 t)))
(defun notmuch-show-stash-git-helper (addresses prefix)
- "Escape, trim, quote, and add PREFIX to each address in list of ADDRESSES, and return the result as a single string."
+ "Normalize all ADDRESSES while adding PREFIX.
+Escape, trim, quote and add PREFIX to each address in list
+of ADDRESSES, and return the result as a single string."
(mapconcat (lambda (x)
(concat prefix "\""
;; escape double-quotes
addresses " "))
(put 'notmuch-show-stash-git-send-email 'notmuch-prefix-doc
- "Copy From/To/Cc of current message to kill-ring in a form suitable for pasting to git send-email command line.")
+ "Copy From/To/Cc of current message to kill-ring.
+Use a form suitable for pasting to git send-email command line.")
(defun notmuch-show-stash-git-send-email (&optional no-in-reply-to)
- "Copy From/To/Cc/Message-Id of current message to kill-ring in a form suitable for pasting to git send-email command line.
+ "Copy From/To/Cc/Message-Id of current message to kill-ring.
+Use a form suitable for pasting to git send-email command line.
If invoked with a prefix argument (or NO-IN-REPLY-TO is non-nil),
omit --in-reply-to=<Message-Id>."
(list (notmuch-show-get-message-id t)) "--in-reply-to="))))
" ")))
-;; Interactive part functions and their helpers
+;;; Interactive part functions and their helpers
(defun notmuch-show-generate-part-buffer (msg part)
"Return a temporary buffer containing the specified part's content."
is destroyed when FN returns. If MIME-TYPE is given then force
part to be treated as if it had that mime-type."
(let ((handle (notmuch-show-current-part-handle mime-type)))
- ;; emacs 24.3+ puts stdout/stderr into the calling buffer so we
- ;; call it from a temp-buffer, unless
- ;; notmuch-show-attachment-debug is non-nil in which case we put
- ;; it in " *notmuch-part*".
+ ;; Emacs puts stdout/stderr into the calling buffer so we call
+ ;; it from a temp-buffer, unless notmuch-show-attachment-debug
+ ;; is non-nil, in which case we put it in " *notmuch-part*".
(unwind-protect
(if notmuch-show-attachment-debug
(with-current-buffer (generate-new-buffer " *notmuch-part*")
(funcall fn (completing-read prompt urls nil nil nil nil (car urls)))
(message "No URLs found."))))
+;;; _
+
(provide 'notmuch-show)
;;; notmuch-show.el ends here
projects / notmuch / blobdiff