Most people who write lots of lisp tend to only sparsely use empty
"separator" lines within forms. In lisp they feel unnecessary and
since most files stick to this convention we get a bit confused
when there are extra empty lines. It feels like the s-expressions
are falling into pieces.
All of this is especially true between a function's doc-string and
body because the doc-string is colored differently, which visually
already separates it quite sufficiently from the code that follows.
14 files changed:
(defun batch-make-deps ()
"Invoke `make-deps' for each file on the command line."
(defun batch-make-deps ()
"Invoke `make-deps' for each file on the command line."
(setq debug-on-error t)
(dolist (file command-line-args-left)
(let ((default-directory command-line-default-directory))
(setq debug-on-error t)
(dolist (file command-line-args-left)
(let ((default-directory command-line-default-directory))
This prints make dependencies to `standard-output' based on the
top-level `require' expressions in the current buffer. Paths in
rules will be given relative to DIR, or `default-directory'."
This prints make dependencies to `standard-output' based on the
top-level `require' expressions in the current buffer. Paths in
rules will be given relative to DIR, or `default-directory'."
(setq dir (or dir default-directory))
(save-excursion
(goto-char (point-min))
(setq dir (or dir default-directory))
(save-excursion
(goto-char (point-min))
Address harvesting may take some time so the address collection runs
asynchronously unless SYNCHRONOUS is t. In case of asynchronous
execution, CALLBACK is called when harvesting finishes."
Address harvesting may take some time so the address collection runs
asynchronously unless SYNCHRONOUS is t. In case of asynchronous
execution, CALLBACK is called when harvesting finishes."
(let* ((sent (eq (car notmuch-address-internal-completion) 'sent))
(config-query (cadr notmuch-address-internal-completion))
(prefix-query (when addr-prefix
(let* ((sent (eq (car notmuch-address-internal-completion) 'sent))
(config-query (cadr notmuch-address-internal-completion))
(prefix-query (when addr-prefix
;; Kill any existing process
(when current-proc
(kill-buffer (process-buffer current-proc))) ; this also kills the process
;; Kill any existing process
(when current-proc
(kill-buffer (process-buffer current-proc))) ; this also kills the process
(setq current-proc
(apply 'notmuch-start-notmuch proc-name proc-buf
callback ; process sentinel
(setq current-proc
(apply 'notmuch-start-notmuch proc-name proc-buf
callback ; process sentinel
face 'notmuch-crypto-signature-good-key))
(setq button-action 'notmuch-crypto-sigstatus-good-callback
help-msg (concat "Click to list key ID 0x" fingerprint "."))))
face 'notmuch-crypto-signature-good-key))
(setq button-action 'notmuch-crypto-sigstatus-good-callback
help-msg (concat "Click to list key ID 0x" fingerprint "."))))
((string= status "error")
(setq label (concat "Unknown key ID " keyid " or unsupported algorithm")
button-action 'notmuch-crypto-sigstatus-error-callback
help-msg (concat "Click to retrieve key ID " keyid
" from keyserver.")))
((string= status "error")
(setq label (concat "Unknown key ID " keyid " or unsupported algorithm")
button-action 'notmuch-crypto-sigstatus-error-callback
help-msg (concat "Click to retrieve key ID " keyid
" from keyserver.")))
((string= status "bad")
(setq label (concat "Bad signature (claimed key ID " keyid ")")
face 'notmuch-crypto-signature-bad))
((string= status "bad")
(setq label (concat "Bad signature (claimed key ID " keyid ")")
face 'notmuch-crypto-signature-bad))
(status
(setq label (concat "Unknown signature status: " status)))
(t
(status
(setq label (concat "Unknown signature status: " status)))
(t
(process-put p :notmuch-show-buffer (current-buffer))
(process-put p :notmuch-show-point (point))
(message "Getting the GPG key %s asynchronously..." keyid)))
(process-put p :notmuch-show-buffer (current-buffer))
(process-put p :notmuch-show-point (point))
(message "Getting the GPG key %s asynchronously..." keyid)))
(let ((window (display-buffer buffer)))
(with-selected-window window
(with-current-buffer buffer
(let ((window (display-buffer buffer)))
(with-selected-window window
(with-current-buffer buffer
;; The saved-search format is also used by the all-tags notmuch-hello
;; section. This section generates its own saved-search list in one of
;; the latter two forms.
;; The saved-search format is also used by the all-tags notmuch-hello
;; section. This section generates its own saved-search list in one of
;; the latter two forms.
:get 'notmuch-hello--saved-searches-to-plist
:type '(repeat notmuch-saved-search-plist)
:tag "List of Saved Searches"
:get 'notmuch-hello--saved-searches-to-plist
:type '(repeat notmuch-saved-search-plist)
:tag "List of Saved Searches"
;; Count is 9 wide (8 digits plus space), 1 for the space
;; after the name.
(+ 9 1 (max notmuch-column-control widest)))))
;; Count is 9 wide (8 digits plus space), 1 for the space
;; after the name.
(+ 9 1 (max notmuch-column-control widest)))))
((floatp notmuch-column-control)
(let* ((available-width (- (window-width) notmuch-hello-indent))
(proposed-width (max (* available-width notmuch-column-control)
widest)))
(floor available-width proposed-width)))
((floatp notmuch-column-control)
(let* ((available-width (- (window-width) notmuch-hello-indent))
(proposed-width (max (* available-width notmuch-column-control)
widest)))
(floor available-width proposed-width)))
(t
(max 1
(/ (- (window-width) notmuch-hello-indent)
;; Count is 9 wide (8 digits plus space), 1 for the space
;; after the name.
(+ 9 1 widest)))))))
(t
(max 1
(/ (- (window-width) notmuch-hello-indent)
;; Count is 9 wide (8 digits plus space), 1 for the space
;; after the name.
(+ 9 1 widest)))))))
(cons tags-per-line (/ (max 1
(- (window-width) notmuch-hello-indent
;; Count is 9 wide (8 digits plus
(cons tags-per-line (/ (max 1
(- (window-width) notmuch-hello-indent
;; Count is 9 wide (8 digits plus
(or (plist-get options :filter-count)
(plist-get options :filter))))
"\n")))
(or (plist-get options :filter-count)
(plist-get options :filter))))
"\n")))
(unless (= (call-process-region (point-min) (point-max) notmuch-command
t t nil "count" "--batch") 0)
(notmuch-logged-error
(unless (= (call-process-region (point-min) (point-max) notmuch-command
t t nil "count" "--batch") 0)
(notmuch-logged-error
"Please check that the notmuch CLI is new enough to support `count
--batch'. In general we recommend running matching versions of
the CLI and emacs interface."))
"Please check that the notmuch CLI is new enough to support `count
--batch'. In general we recommend running matching versions of
the CLI and emacs interface."))
(notmuch-remove-if-not
#'identity
(mapcar
(notmuch-remove-if-not
#'identity
(mapcar
(setq column-indent 0)
(widget-insert "\n")))
reordered-list)
(setq column-indent 0)
(widget-insert "\n")))
reordered-list)
;; If the last line was not full (and hence did not include a
;; carriage return), insert one now.
(unless (eq (% count tags-per-line) 0)
;; If the last line was not full (and hence did not include a
;; carriage return), insert one now.
(unless (eq (% count tags-per-line) 0)
(car (process-lines notmuch-command "count")))))
(widget-insert " messages.\n")))
(car (process-lines notmuch-command "count")))))
(widget-insert " messages.\n")))
(defun notmuch-hello-insert-saved-searches ()
"Insert the saved-searches section."
(let ((searches (notmuch-hello-query-counts
(defun notmuch-hello-insert-saved-searches ()
"Insert the saved-searches section."
(let ((searches (notmuch-hello-query-counts
(defun notmuch-hello (&optional no-display)
"Run notmuch and display saved searches, known tags, etc."
(interactive)
(defun notmuch-hello (&optional no-display)
"Run notmuch and display saved searches, known tags, etc."
(interactive)
(notmuch-assert-cli-sane)
;; This may cause a window configuration change, so if the
;; auto-refresh hook is already installed, avoid recursive refresh.
(notmuch-assert-cli-sane)
;; This may cause a window configuration change, so if the
;; auto-refresh hook is already installed, avoid recursive refresh.
(if no-display
(set-buffer "*notmuch-hello*")
(switch-to-buffer "*notmuch-hello*")))
(if no-display
(set-buffer "*notmuch-hello*")
(switch-to-buffer "*notmuch-hello*")))
;; Install auto-refresh hook
(when notmuch-hello-auto-refresh
(add-hook 'window-configuration-change-hook
#'notmuch-hello-window-configuration-change))
;; Install auto-refresh hook
(when notmuch-hello-auto-refresh
(add-hook 'window-configuration-change-hook
#'notmuch-hello-window-configuration-change))
(let ((target-line (line-number-at-pos))
(target-column (current-column))
(inhibit-read-only t))
(let ((target-line (line-number-at-pos))
(target-column (current-column))
(inhibit-read-only t))
;; Delete all editable widget fields. Editable widget fields are
;; tracked in a buffer local variable `widget-field-list' (and
;; others). If we do `erase-buffer' without properly deleting the
;; widgets, some widget-related functions are confused later.
(mapc 'widget-delete widget-field-list)
;; Delete all editable widget fields. Editable widget fields are
;; tracked in a buffer local variable `widget-field-list' (and
;; others). If we do `erase-buffer' without properly deleting the
;; widgets, some widget-related functions are confused later.
(mapc 'widget-delete widget-field-list)
(unless (eq major-mode 'notmuch-hello-mode)
(notmuch-hello-mode))
(unless (eq major-mode 'notmuch-hello-mode)
(notmuch-hello-mode))
(let ((all (overlay-lists)))
;; Delete all the overlays.
(mapc 'delete-overlay (car all))
(mapc 'delete-overlay (cdr all)))
(let ((all (overlay-lists)))
;; Delete all the overlays.
(mapc 'delete-overlay (car all))
(mapc 'delete-overlay (cdr all)))
(mapc
(lambda (section)
(let ((point-before (point)))
(mapc
(lambda (section)
(let ((point-before (point)))
(widget-insert "\n"))))
notmuch-hello-sections)
(widget-setup)
(widget-insert "\n"))))
notmuch-hello-sections)
(widget-setup)
;; Move point back to where it was before refresh. Use line and
;; column instead of point directly to be insensitive to additions
;; and removals of text within earlier lines.
;; Move point back to where it was before refresh. Use line and
;; column instead of point directly to be insensitive to additions
;; and removals of text within earlier lines.
Typically these shortcuts are a single key long, so this is a
fast way to jump to a saved search from anywhere in Notmuch."
(interactive)
Typically these shortcuts are a single key long, so this is a
fast way to jump to a saved search from anywhere in Notmuch."
(interactive)
;; Build the action map
(let (action-map)
(dolist (saved-search notmuch-saved-searches)
;; Build the action map
(let (action-map)
(dolist (saved-search notmuch-saved-searches)
`(lambda () (notmuch-search ',query ',oldest-first)))))
action-map)))))
(setq action-map (nreverse action-map))
`(lambda () (notmuch-search ',query ',oldest-first)))))
action-map)))))
(setq action-map (nreverse action-map))
(if action-map
(notmuch-jump action-map "Search: ")
(error "To use notmuch-jump, \
(if action-map
(notmuch-jump action-map "Search: ")
(error "To use notmuch-jump, \
the buffer, and ACTION is a nullary function to call. LABEL may
be null, in which case the action will still be bound, but will
not appear in the pop-up buffer."
the buffer, and ACTION is a nullary function to call. LABEL may
be null, in which case the action will still be bound, but will
not appear in the pop-up buffer."
(let* ((items (notmuch-jump--format-actions action-map))
;; Format the table of bindings and the full prompt
(table
(let* ((items (notmuch-jump--format-actions action-map))
;; Format the table of bindings and the full prompt
(table
(notmuch-jump--action nil))
;; Read the action
(read-from-minibuffer full-prompt nil minibuffer-map)
(notmuch-jump--action nil))
;; Read the action
(read-from-minibuffer full-prompt nil minibuffer-map)
;; If we got an action, do it
(when notmuch-jump--action
(funcall notmuch-jump--action))))
;; If we got an action, do it
(when notmuch-jump--action
(funcall notmuch-jump--action))))
Returns a list of strings, one for each item with a label in
ACTION-MAP. These strings can be inserted into a tabular
buffer."
Returns a list of strings, one for each item with a label in
ACTION-MAP. These strings can be inserted into a tabular
buffer."
;; Compute the maximum key description width
(let ((key-width 1))
(pcase-dolist (`(,key ,desc) action-map)
;; Compute the maximum key description width
(let ((key-width 1))
(pcase-dolist (`(,key ,desc) action-map)
(while (< i (length prefix))
(aset prefix i (aref key i))
(setq i (1+ i)))
(while (< i (length prefix))
(aset prefix i (aref key i))
(setq i (1+ i)))
(let* ((subkeymap (key-binding prefix))
(ua-keys (where-is-internal 'universal-argument nil t))
(prefix-string (notmuch-prefix-key-description prefix))
(let* ((subkeymap (key-binding prefix))
(ua-keys (where-is-internal 'universal-argument nil t))
(prefix-string (notmuch-prefix-key-description prefix))
The caller is responsible for prepending the term prefix and a
colon. This performs minimal escaping in order to produce
user-friendly queries."
The caller is responsible for prepending the term prefix and a
colon. This performs minimal escaping in order to produce
user-friendly queries."
(save-match-data
(if (or (equal term "")
;; To be pessimistic, only pass through terms composed
(save-match-data
(if (or (equal term "")
;; To be pessimistic, only pass through terms composed
attributes, or a list of these. If START and/or END are omitted,
they default to the beginning/end of OBJECT. For convenience
when applied to strings, this returns OBJECT."
attributes, or a list of these. If START and/or END are omitted,
they default to the beginning/end of OBJECT. For convenience
when applied to strings, this returns OBJECT."
;; A face property can have three forms: a face name (a string or
;; symbol), a property list, or a list of these two forms. In the
;; list case, the faces will be combined, with the earlier faces
;; A face property can have three forms: a face name (a string or
;; symbol), a property list, or a list of these two forms. In the
;; list case, the faces will be combined, with the earlier faces
signals MSG as an error. If EXTRA is non-nil, text referring the
user to the *Notmuch errors* buffer will be appended to the
signaled error. This function does not return."
signals MSG as an error. If EXTRA is non-nil, text referring the
user to the *Notmuch errors* buffer will be appended to the
signaled error. This function does not return."
(with-current-buffer (get-buffer-create "*Notmuch errors*")
(goto-char (point-max))
(unless (bobp)
(with-current-buffer (get-buffer-create "*Notmuch errors*")
(goto-char (point-max))
(unless (bobp)
giving the output of command. ERR, if provided, is the error
output of command. OUTPUT and ERR will be included in the error
message."
giving the output of command. ERR, if provided, is the error
output of command. OUTPUT and ERR will be included in the error
message."
(cond
((eq exit-status 0) t)
((eq exit-status 20)
(cond
((eq exit-status 0) t)
((eq exit-status 20)
This wraps `call-process'. DESTINATION has the same meaning as
for `call-process'. ARGS is as described for
`notmuch-call-notmuch-process'."
This wraps `call-process'. DESTINATION has the same meaning as
for `call-process'. ARGS is as described for
`notmuch-call-notmuch-process'."
(let (stdin-string)
(while (keywordp (car args))
(cl-case (car args)
(let (stdin-string)
(while (keywordp (car args))
(cl-case (car args)
Like `notmuch-call-notmuch-process', if notmuch exits with a
non-zero status, this will report its output and signal an
error."
Like `notmuch-call-notmuch-process', if notmuch exits with a
non-zero status, this will report its output and signal an
error."
(with-temp-buffer
(let ((err-file (make-temp-file "nmerr")))
(unwind-protect
(with-temp-buffer
(let ((err-file (make-temp-file "nmerr")))
(unwind-protect
invoke `set-process-sentinel' directly on the returned process,
as that will interfere with the handling of stderr and the exit
status."
invoke `set-process-sentinel' directly on the returned process,
as that will interfere with the handling of stderr and the exit
status."
(let (err-file err-buffer proc err-proc
;; Find notmuch using Emacs' `exec-path'
(command (or (executable-find notmuch-command)
(let (err-file err-buffer proc err-proc
;; Find notmuch using Emacs' `exec-path'
(command (or (executable-find notmuch-command)
(process-put err-proc 'err-file err-file)
(process-put err-proc 'err-buffer err-buffer)
(set-process-sentinel err-proc #'notmuch-start-notmuch-error-sentinel))
(process-put err-proc 'err-file err-file)
(process-put err-proc 'err-buffer err-buffer)
(set-process-sentinel err-proc #'notmuch-start-notmuch-error-sentinel))
;; On Emacs versions before 25, there is no way to capture
;; stdout and stderr separately for asynchronous processes, or
;; even to redirect stderr to a file, so we use a trivial shell
;; On Emacs versions before 25, there is no way to capture
;; stdout and stderr separately for asynchronous processes, or
;; even to redirect stderr to a file, so we use a trivial shell
"exec 2>\"$1\"; shift; exec \"$0\" \"$@\""
command err-file args)))
(process-put proc 'err-file err-file))
"exec 2>\"$1\"; shift; exec \"$0\" \"$@\""
command err-file args)))
(process-put proc 'err-file err-file))
(process-put proc 'sub-sentinel sentinel)
(process-put proc 'real-command (cons notmuch-command args))
(set-process-sentinel proc #'notmuch-start-notmuch-sentinel)
(process-put proc 'sub-sentinel sentinel)
(process-put proc 'real-command (cons notmuch-command args))
(set-process-sentinel proc #'notmuch-start-notmuch-sentinel)
Originally intended to be use a hook function, but now called directly
by notmuch-mua-mail."
Originally intended to be use a hook function, but now called directly
by notmuch-mua-mail."
(let ((subdir
(cond
((or (not notmuch-fcc-dirs)
(message-field-value "Fcc"))
;; Nothing set or an existing header.
nil)
(let ((subdir
(cond
((or (not notmuch-fcc-dirs)
(message-field-value "Fcc"))
;; Nothing set or an existing header.
nil)
((stringp notmuch-fcc-dirs)
notmuch-fcc-dirs)
((stringp notmuch-fcc-dirs)
notmuch-fcc-dirs)
((and (listp notmuch-fcc-dirs)
(stringp (car notmuch-fcc-dirs)))
;; Old style - no longer works.
(error "Invalid `notmuch-fcc-dirs' setting (old style)"))
((and (listp notmuch-fcc-dirs)
(stringp (car notmuch-fcc-dirs)))
;; Old style - no longer works.
(error "Invalid `notmuch-fcc-dirs' setting (old style)"))
((listp notmuch-fcc-dirs)
(let* ((from (message-field-value "From"))
(match
((listp notmuch-fcc-dirs)
(let* ((from (message-field-value "From"))
(match
(cdr match)
(message "No Fcc header added.")
nil)))
(cdr match)
(message "No Fcc header added.")
nil)))
(t
(error "Invalid `notmuch-fcc-dirs' setting (neither string nor list)")))))
(t
(error "Invalid `notmuch-fcc-dirs' setting (neither string nor list)")))))
(when subdir
(if notmuch-maildir-use-notmuch-insert
(notmuch-maildir-add-notmuch-insert-style-fcc-header subdir)
(when subdir
(if notmuch-maildir-use-notmuch-insert
(notmuch-maildir-add-notmuch-insert-style-fcc-header subdir)
(defun notmuch-maildir-add-notmuch-insert-style-fcc-header (subdir)
;; Notmuch insert does not accept absolute paths, so check the user
;; really want this header inserted.
(defun notmuch-maildir-add-notmuch-insert-style-fcc-header (subdir)
;; Notmuch insert does not accept absolute paths, so check the user
;; really want this header inserted.
(when (or (not (= (elt subdir 0) ?/))
(y-or-n-p
(format "Fcc header %s is an absolute path and notmuch insert is requested.
(when (or (not (= (elt subdir 0) ?/))
(y-or-n-p
(format "Fcc header %s is an absolute path and notmuch insert is requested.
original)
(when process-crypto
(setq args (append args '("--decrypt=true"))))
original)
(when process-crypto
(setq args (append args '("--decrypt=true"))))
(if reply-all
(setq args (append args '("--reply-to=all")))
(setq args (append args '("--reply-to=sender"))))
(setq args (append args (list query-string)))
(if reply-all
(setq args (append args '("--reply-to=all")))
(setq args (append args '("--reply-to=sender"))))
(setq args (append args (list query-string)))
;; Get the reply object as SEXP, and parse it into an elisp object.
(setq reply (apply #'notmuch-call-notmuch-sexp args))
;; Get the reply object as SEXP, and parse it into an elisp object.
(setq reply (apply #'notmuch-call-notmuch-sexp args))
;; Extract the original message to simplify the following code.
(setq original (plist-get reply :original))
;; Extract the original message to simplify the following code.
(setq original (plist-get reply :original))
;; Extract the headers of both the reply and the original message.
(let* ((original-headers (plist-get original :headers))
(reply-headers (plist-get reply :reply-headers)))
;; Extract the headers of both the reply and the original message.
(let* ((original-headers (plist-get original :headers))
(reply-headers (plist-get reply :reply-headers)))
;; If sender is non-nil, set the From: header to its value.
(when sender
(plist-put reply-headers :From sender))
;; If sender is non-nil, set the From: header to its value.
(when sender
(plist-put reply-headers :From sender))
;; Overlay the composition window on that being used to read
;; the original message.
((same-window-regexps '("\\*mail .*")))
;; Overlay the composition window on that being used to read
;; the original message.
((same-window-regexps '("\\*mail .*")))
;; We modify message-header-format-alist to get around
;; a bug in message.el. See the comment above on
;; notmuch-mua-insert-references.
;; We modify message-header-format-alist to get around
;; a bug in message.el. See the comment above on
;; notmuch-mua-insert-references.
(notmuch-sanitize (plist-get reply-headers :Subject))
(notmuch-headers-plist-to-alist reply-headers)
nil (notmuch-mua-get-switch-function))))
(notmuch-sanitize (plist-get reply-headers :Subject))
(notmuch-headers-plist-to-alist reply-headers)
nil (notmuch-mua-get-switch-function))))
;; Create a buffer-local queue for tag changes triggered when
;; sending the reply.
(when notmuch-message-replied-tags
(setq-local notmuch-message-queued-tag-changes
(list (cons query-string notmuch-message-replied-tags))))
;; Create a buffer-local queue for tag changes triggered when
;; sending the reply.
(when notmuch-message-replied-tags
(setq-local notmuch-message-queued-tag-changes
(list (cons query-string notmuch-message-replied-tags))))
;; Insert the message body - but put it in front of the signature
;; if one is present, and after any other content
;; message*setup-hooks may have added to the message body already.
;; Insert the message body - but put it in front of the signature
;; if one is present, and after any other content
;; message*setup-hooks may have added to the message body already.
(if message-signature-insert-empty-line
(forward-line -1))
(goto-char (point-max))))
(if message-signature-insert-empty-line
(forward-line -1))
(goto-char (point-max))))
(let ((from (plist-get original-headers :From))
(date (plist-get original-headers :Date))
(start (point)))
(let ((from (plist-get original-headers :From))
(date (plist-get original-headers :Date))
(start (point)))
;; notmuch-mua-cite-function constructs a citation line based
;; on the From and Date headers of the original message, which
;; are assumed to be in the buffer.
(insert "From: " from "\n")
(insert "Date: " date "\n\n")
;; notmuch-mua-cite-function constructs a citation line based
;; on the From and Date headers of the original message, which
;; are assumed to be in the buffer.
(insert "From: " from "\n")
(insert "Date: " date "\n\n")
(insert
(with-temp-buffer
(let
(insert
(with-temp-buffer
(let
((symbol-function 'notmuch-crypto-insert-encstatus-button) #'ignore))
(notmuch-show-insert-body original (plist-get original :body) 0)
(buffer-substring-no-properties (point-min) (point-max))))))
((symbol-function 'notmuch-crypto-insert-encstatus-button) #'ignore))
(notmuch-show-insert-body original (plist-get original :body) 0)
(buffer-substring-no-properties (point-min) (point-max))))))
(set-mark (point))
(goto-char start)
;; Quote the original message according to the user's configured style.
(funcall notmuch-mua-cite-function)))
(set-mark (point))
(goto-char start)
;; Quote the original message according to the user's configured style.
(funcall notmuch-mua-cite-function)))
;; Crypto processing based crypto content of the original message
(when process-crypto
(notmuch-mua-reply-crypto (plist-get original :body))))
;; Crypto processing based crypto content of the original message
(when process-crypto
(notmuch-mua-reply-crypto (plist-get original :body))))
;; Push mark right before signature, if any.
(message-goto-signature)
(unless (eobp)
(end-of-line -1))
(push-mark)
;; Push mark right before signature, if any.
(message-goto-signature)
(unless (eobp)
(end-of-line -1))
(push-mark)
(message-goto-body)
(set-buffer-modified-p nil))
(message-goto-body)
(set-buffer-modified-p nil))
return-action &rest ignored)
"Invoke the notmuch mail composition window."
(interactive)
return-action &rest ignored)
"Invoke the notmuch mail composition window."
(interactive)
(when notmuch-mua-user-agent-function
(let ((user-agent (funcall notmuch-mua-user-agent-function)))
(when (not (string= "" user-agent))
(push (cons 'User-Agent user-agent) other-headers))))
(when notmuch-mua-user-agent-function
(let ((user-agent (funcall notmuch-mua-user-agent-function)))
(when (not (string= "" user-agent))
(push (cons 'User-Agent user-agent) other-headers))))
(unless (assq 'From other-headers)
(push (cons 'From (message-make-from
(notmuch-user-name)
(notmuch-user-primary-email)))
other-headers))
(unless (assq 'From other-headers)
(push (cons 'From (message-make-from
(notmuch-user-name)
(notmuch-user-primary-email)))
other-headers))
(notmuch-mua-pop-to-buffer (message-buffer-name "mail" to)
(or switch-function
(notmuch-mua-get-switch-function)))
(notmuch-mua-pop-to-buffer (message-buffer-name "mail" to)
(or switch-function
(notmuch-mua-get-switch-function)))
(message-hide-headers)
(set-buffer-modified-p nil)
(notmuch-mua-maybe-set-window-dedicated)
(message-hide-headers)
(set-buffer-modified-p nil)
(notmuch-mua-maybe-set-window-dedicated)
(message-goto-to))
(defcustom notmuch-identities nil
(message-goto-to))
(defcustom notmuch-identities nil
;; applied later.
forward-references ;; List of accumulated message-references of forwarded messages
forward-queries) ;; List of corresponding message-query
;; applied later.
forward-references ;; List of accumulated message-references of forwarded messages
forward-queries) ;; List of corresponding message-query
;; Generate the template for the outgoing message.
(notmuch-mua-mail nil "" other-headers nil (notmuch-mua-get-switch-function))
;; Generate the template for the outgoing message.
(notmuch-mua-mail nil "" other-headers nil (notmuch-mua-get-switch-function))
(save-excursion
;; Insert all of the forwarded messages.
(mapc (lambda (id)
(save-excursion
;; Insert all of the forwarded messages.
(mapc (lambda (id)
;; `message-forward-make-body' always puts the message at
;; the top, so do them in reverse order.
(reverse messages))
;; `message-forward-make-body' always puts the message at
;; the top, so do them in reverse order.
(reverse messages))
;; Add in the appropriate subject.
(save-restriction
(message-narrow-to-headers)
;; Add in the appropriate subject.
(save-restriction
(message-narrow-to-headers)
(message-remove-header "References")
(message-add-header (concat "References: "
(mapconcat 'identity forward-references " "))))
(message-remove-header "References")
(message-add-header (concat "References: "
(mapconcat 'identity forward-references " "))))
;; Create a buffer-local queue for tag changes triggered when
;; sending the message.
(when notmuch-message-forwarded-tags
;; Create a buffer-local queue for tag changes triggered when
;; sending the message.
(when notmuch-message-forwarded-tags
(cl-loop for id in forward-queries
collect
(cons id notmuch-message-forwarded-tags))))
(cl-loop for id in forward-queries
collect
(cons id notmuch-message-forwarded-tags))))
;; `message-forward-make-body' shows the User-agent header. Hide
;; it again.
(message-hide-headers)
;; `message-forward-make-body' shows the User-agent header. Hide
;; it again.
(message-hide-headers)
If PROMPT-FOR-SENDER is non-nil, the user will be prompted for
the From: address first. If REPLY-ALL is non-nil, the message
will be addressed to all recipients of the source message."
If PROMPT-FOR-SENDER is non-nil, the user will be prompted for
the From: address first. If REPLY-ALL is non-nil, the message
will be addressed to all recipients of the source message."
;; In current emacs (24.3) select-active-regions is set to t by
;; default. The reply insertion code sets the region to the quoted
;; message to make it easy to delete (kill-region or C-w). These two
;; In current emacs (24.3) select-active-regions is set to t by
;; default. The reply insertion code sets the region to the quoted
;; message to make it easy to delete (kill-region or C-w). These two
;; primary selection was previously in a non-emacs window but not if
;; it was in an emacs window. To avoid the problem in the latter case
;; we deactivate mark.
;; primary selection was previously in a non-emacs window but not if
;; it was in an emacs window. To avoid the problem in the latter case
;; we deactivate mark.
(let ((sender
(when prompt-for-sender
(notmuch-mua-prompt-for-sender)))
(let ((sender
(when prompt-for-sender
(notmuch-mua-prompt-for-sender)))
The parser always consumes input from point in the current
buffer. Hence, the caller is allowed to delete any data before
point and may resynchronize after an error by moving point."
The parser always consumes input from point in the current
buffer. Hence, the caller is allowed to delete any data before
point and may resynchronize after an error by moving point."
(vector 'notmuch-sexp-parser
;; List depth
0
(vector 'notmuch-sexp-parser
;; List depth
0
list, this moves point just past the terminator and returns 'end.
Otherwise, this moves point to just past the end of the value and
returns the value."
list, this moves point just past the terminator and returns 'end.
Otherwise, this moves point to just past the end of the value and
returns the value."
(skip-chars-forward " \n\r\t")
(cond ((eobp) 'retry)
((= (char-after) ?\))
(skip-chars-forward " \n\r\t")
(cond ((eobp) 'retry)
((= (char-after) ?\))
returns t. Later calls to `notmuch-sexp-read' will return the
elements inside the list. If the input in buffer is not the
beginning of a list, throw invalid-read-syntax."
returns t. Later calls to `notmuch-sexp-read' will return the
elements inside the list. If the input in buffer is not the
beginning of a list, throw invalid-read-syntax."
(skip-chars-forward " \n\r\t")
(cond ((eobp) 'retry)
((= (char-after) ?\()
(skip-chars-forward " \n\r\t")
(cond ((eobp) 'retry)
((= (char-after) ?\()
Moves point to the beginning of any trailing data or to the end
of the buffer if there is only trailing whitespace."
Moves point to the beginning of any trailing data or to the end
of the buffer if there is only trailing whitespace."
(skip-chars-forward " \n\r\t")
(unless (eobp)
(error "Trailing garbage following expression")))
(skip-chars-forward " \n\r\t")
(unless (eobp)
(error "Trailing garbage following expression")))
be called whenever the input buffer has been extended with
additional data. The caller just needs to ensure it does not
move point in the input buffer."
be called whenever the input buffer has been extended with
additional data. The caller just needs to ensure it does not
move point in the input buffer."
;; Set up the initial state
(unless (local-variable-p 'notmuch-sexp--parser)
(set (make-local-variable 'notmuch-sexp--parser)
;; Set up the initial state
(unless (local-variable-p 'notmuch-sexp--parser)
(set (make-local-variable 'notmuch-sexp--parser)
FN is called with one argument, the message properties. It should
operation on the contents of the current buffer."
FN is called with one argument, the message properties. It should
operation on the contents of the current buffer."
;; Remake the header to ensure that all information is available.
(let* ((to (notmuch-show-get-to))
(cc (notmuch-show-get-cc))
;; Remake the header to ensure that all information is available.
(let* ((to (notmuch-show-get-to))
(cc (notmuch-show-get-cc))
(date (notmuch-show-get-date))
(tags (notmuch-show-get-tags))
(depth (notmuch-show-get-depth))
(date (notmuch-show-get-date))
(tags (notmuch-show-get-tags))
(depth (notmuch-show-get-depth))
(header (concat
"Subject: " subject "\n"
"To: " to "\n"
(header (concat
"Subject: " subject "\n"
"To: " to "\n"
'message-header-subject)
(t
'message-header-other))))
'message-header-subject)
(t
'message-header-other))))
(overlay-put (make-overlay (point) (re-search-forward ":"))
'face 'message-header-name)
(overlay-put (make-overlay (point) (re-search-forward ".*$"))
(overlay-put (make-overlay (point) (re-search-forward ":"))
'face 'message-header-name)
(overlay-put (make-overlay (point) (re-search-forward ".*$"))
((string-match "\\(.*\\) <\\(.*\\)>" address)
(setq p-name (match-string 1 address)
p-address (match-string 2 address)))
((string-match "\\(.*\\) <\\(.*\\)>" address)
(setq p-name (match-string 1 address)
p-address (match-string 2 address)))
;; "<user@dom.ain>" style.
((string-match "<\\(.*\\)>" address)
(setq p-address (match-string 1 address)))
;; "<user@dom.ain>" style.
((string-match "<\\(.*\\)>" address)
(setq p-address (match-string 1 address)))
;; Everything else.
(t
(setq p-address address)))
;; Everything else.
(t
(setq p-address address)))
(when p-name
;; Remove elements of the mailbox part that are not relevant for
;; display, even if they are required during transport:
;;
;; Backslashes.
(setq p-name (replace-regexp-in-string "\\\\" "" p-name))
(when p-name
;; Remove elements of the mailbox part that are not relevant for
;; display, even if they are required during transport:
;;
;; Backslashes.
(setq p-name (replace-regexp-in-string "\\\\" "" p-name))
;; Outer single and double quotes, which might be nested.
(cl-loop with start-of-loop
;; Outer single and double quotes, which might be nested.
(cl-loop with start-of-loop
- do (setq start-of-loop p-name)
-
+ do (setq start-of-loop p-name)
when (string-match "^\"\\(.*\\)\"$" p-name)
when (string-match "^\"\\(.*\\)\"$" p-name)
- do (setq p-name (match-string 1 p-name))
-
+ do (setq p-name (match-string 1 p-name))
when (string-match "^'\\(.*\\)'$" p-name)
when (string-match "^'\\(.*\\)'$" p-name)
- do (setq p-name (match-string 1 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'.
(when (string= p-name p-address)
(setq p-name nil))
;; If the address is 'foo@bar.com <foo@bar.com>' then show just
;; 'foo@bar.com'.
(when (string= p-name p-address)
(setq p-name nil))
(cons p-address p-name))
(error (cons address nil))))
(cons p-address p-name))
(error (cons address nil))))
(unless (string-equal declared-type content-type)
(concat " (as " content-type ")"))
comment)))
(unless (string-equal declared-type content-type)
(concat " (as " content-type ")"))
comment)))
(setq button
(insert-button
(concat "[ " base-label " ]")
(setq button
(insert-button
(concat "[ " base-label " ]")
(defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth button)
(let ((inner-parts (plist-get part :content))
(start (point)))
(defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth button)
(let ((inner-parts (plist-get part :content))
(start (point)))
;; Render the primary part. FIXME: Support RFC 2387 Start header.
(notmuch-show-insert-bodypart msg (car inner-parts) depth)
;; Add hidden buttons for the rest
(mapc (lambda (inner-part)
(notmuch-show-insert-bodypart msg inner-part depth t))
(cdr inner-parts))
;; Render the primary part. FIXME: Support RFC 2387 Start header.
(notmuch-show-insert-bodypart msg (car inner-parts) depth)
;; Add hidden buttons for the rest
(mapc (lambda (inner-part)
(notmuch-show-insert-bodypart msg inner-part depth t))
(cdr inner-parts))
(when notmuch-show-indent-multipart
(indent-rigidly start (point) 1)))
t)
(when notmuch-show-indent-multipart
(indent-rigidly start (point) 1)))
t)
(defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth button)
(when button
(button-put button 'face 'notmuch-crypto-part-header))
(defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth button)
(when button
(button-put button 'face 'notmuch-crypto-part-header))
;; Insert a button detailing the signature status.
(notmuch-crypto-insert-sigstatus-button (car (plist-get part :sigstatus))
(notmuch-show-get-header :From msg))
;; Insert a button detailing the signature status.
(notmuch-crypto-insert-sigstatus-button (car (plist-get part :sigstatus))
(notmuch-show-get-header :From msg))
(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)
(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)
(when notmuch-show-indent-multipart
(indent-rigidly start (point) 1)))
t)
(defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth button)
(when button
(button-put button 'face 'notmuch-crypto-part-header))
(defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth button)
(when button
(button-put button 'face 'notmuch-crypto-part-header))
;; Insert a button detailing the encryption status.
(notmuch-crypto-insert-encstatus-button (car (plist-get part :encstatus)))
;; Insert a button detailing the encryption status.
(notmuch-crypto-insert-encstatus-button (car (plist-get part :encstatus)))
;; Insert a button detailing the signature status.
(notmuch-crypto-insert-sigstatus-button (car (plist-get part :sigstatus))
(notmuch-show-get-header :From msg))
;; Insert a button detailing the signature status.
(notmuch-crypto-insert-sigstatus-button (car (plist-get part :sigstatus))
(notmuch-show-get-header :From msg))
(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)
(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)
(when notmuch-show-indent-multipart
(indent-rigidly start (point) 1)))
t)
(mapc (lambda (inner-part)
(notmuch-show-insert-bodypart msg inner-part depth))
inner-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)
(when notmuch-show-indent-multipart
(indent-rigidly start (point) 1)))
t)
(let* ((message (car (plist-get part :content)))
(body (car (plist-get message :body)))
(start (point)))
(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)))
;; 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")
;; Blank line after headers to be compatible with the normal
;; message display.
(insert "\n")
;; Show the body
(notmuch-show-insert-bodypart msg body depth)
;; Show the body
(notmuch-show-insert-bodypart msg body depth)
(when notmuch-show-indent-multipart
(indent-rigidly start (point) 1)))
t)
(when notmuch-show-indent-multipart
(indent-rigidly start (point) 1)))
t)
;; It's easier to drive shr ourselves than to work around the
;; goofy things `mm-shr' does (like irreversibly taking over
;; content ID handling).
;; It's easier to drive shr ourselves than to work around the
;; goofy things `mm-shr' does (like irreversibly taking over
;; content ID handling).
;; FIXME: If we block an image, offer a button to load external
;; images.
(let ((shr-blocked-images notmuch-show-text/html-blocked-images))
;; FIXME: If we block an image, offer a button to load external
;; images.
(let ((shr-blocked-images notmuch-show-text/html-blocked-images))
(defun notmuch-show-create-part-overlays (button beg end)
"Add an overlay to the part between BEG and END."
(defun notmuch-show-create-part-overlays (button beg 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
;; toggleable.
;; 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
;; toggleable.
(defun notmuch-show-record-part-information (part beg end)
"Store PART as a text property from BEG to END."
(defun notmuch-show-record-part-information (part beg 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.
(notmuch-map-text-property beg end :notmuch-part
;; Record part information. Since we already inserted subparts,
;; don't override existing :notmuch-part properties.
(notmuch-map-text-property beg end :notmuch-part
HIDE determines whether to show or hide the part and the button
as follows: If HIDE is nil, show the part and the button. If HIDE
is t, hide the part initially and show the button."
HIDE determines whether to show or hide the part and the button
as follows: If HIDE is nil, show the part and the button. If HIDE
is t, hide the part initially and show the button."
(let* ((content-type (downcase (plist-get part :content-type)))
(mime-type (notmuch-show-mime-type part))
(nth (plist-get part :id))
(let* ((content-type (downcase (plist-get part :content-type)))
(mime-type (notmuch-show-mime-type part))
(nth (plist-get part :id))
(show-part (not (or (equal hide t)
(and long button))))
(content-beg (point)))
(show-part (not (or (equal hide t)
(and long button))))
(content-beg (point)))
;; Store the computed mime-type for later use (e.g. by attachment handlers).
(plist-put part :computed-type mime-type)
;; Store the computed mime-type for later use (e.g. by attachment handlers).
(plist-put part :computed-type mime-type)
(if show-part
(notmuch-show-insert-bodypart-internal msg part mime-type nth depth button)
(when button
(button-put button :notmuch-lazy-part
(list msg part mime-type nth depth button))))
(if show-part
(notmuch-show-insert-bodypart-internal msg part mime-type nth depth button)
(when button
(button-put button :notmuch-lazy-part
(list msg part mime-type nth depth button))))
;; Some of the body part handlers leave point somewhere up in the
;; part, so we make sure that we're down at the end.
(goto-char (point-max))
;; Some of the body part handlers leave point somewhere up in the
;; part, so we make sure that we're down at the end.
(goto-char (point-max))
(defun notmuch-show-insert-body (msg body depth)
"Insert the body BODY at depth DEPTH in the current thread."
(defun notmuch-show-insert-body (msg body depth)
"Insert the body BODY at depth DEPTH in the current thread."
;; 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 (car body))
;; 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 (car body))
(mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
(defun notmuch-show-make-symbol (type)
(mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
(defun notmuch-show-make-symbol (type)
content-start content-end
headers-start headers-end
(bare-subject (notmuch-show-strip-re (plist-get headers :Subject))))
content-start content-end
headers-start headers-end
(bare-subject (notmuch-show-strip-re (plist-get headers :Subject))))
(setq message-start (point-marker))
(setq message-start (point-marker))
(notmuch-show-insert-headerline headers
(or (if notmuch-show-relative-dates
(plist-get msg :date_relative)
nil)
(plist-get headers :Date))
(plist-get msg :tags) depth)
(notmuch-show-insert-headerline headers
(or (if notmuch-show-relative-dates
(plist-get msg :date_relative)
nil)
(plist-get headers :Date))
(plist-get msg :tags) depth)
(setq content-start (point-marker))
(setq content-start (point-marker))
;; Set `headers-start' to point after the 'Subject:' header to be
;; compatible with the existing implementation. This just sets it
;; to after the first header.
;; Set `headers-start' to point after the 'Subject:' header to be
;; compatible with the existing implementation. This just sets it
;; to after the first header.
(forward-line 1))
(setq headers-start (point-marker)))
(setq headers-end (point-marker))
(forward-line 1))
(setq headers-start (point-marker)))
(setq headers-end (point-marker))
(setq notmuch-show-previous-subject bare-subject)
(setq notmuch-show-previous-subject bare-subject)
;; A blank line between the headers and the body.
(insert "\n")
(notmuch-show-insert-body msg (plist-get msg :body)
;; A blank line between the headers and the body.
(insert "\n")
(notmuch-show-insert-body msg (plist-get msg :body)
(unless (bolp)
(insert "\n"))
(setq content-end (point-marker))
(unless (bolp)
(insert "\n"))
(setq content-end (point-marker))
;; Indent according to the depth in the thread.
(if notmuch-show-indent-content
(indent-rigidly content-start
content-end
(* notmuch-show-indent-messages-width depth)))
;; Indent according to the depth in the thread.
(if notmuch-show-indent-content
(indent-rigidly content-start
content-end
(* notmuch-show-indent-messages-width depth)))
(setq message-end (point-max-marker))
(setq message-end (point-max-marker))
;; Save the extents of this message over the whole text of the
;; message.
(put-text-property message-start message-end
:notmuch-message-extent
(cons message-start message-end))
;; Save the extents of this message over the whole text of the
;; message.
(put-text-property message-start message-end
:notmuch-message-extent
(cons message-start message-end))
;; Create overlays used to control visibility
(plist-put msg :headers-overlay (make-overlay headers-start headers-end))
(plist-put msg :message-overlay (make-overlay headers-start content-end))
;; Create overlays used to control visibility
(plist-put msg :headers-overlay (make-overlay headers-start headers-end))
(plist-put msg :message-overlay (make-overlay headers-start content-end))
(plist-put msg :depth depth)
(plist-put msg :depth depth)
;; Save the properties for this message. Currently this saves the
;; entire message (augmented it with other stuff), which seems
;; like overkill. We might save a reduced subset (for example, not
;; the content).
(notmuch-show-set-message-properties msg)
;; Save the properties for this message. Currently this saves the
;; entire message (augmented it with other stuff), which seems
;; like overkill. We might save a reduced subset (for example, not
;; the content).
(notmuch-show-set-message-properties msg)
;; Set header visibility.
(notmuch-show-headers-visible msg notmuch-message-headers-visible)
;; Set header visibility.
(notmuch-show-headers-visible msg notmuch-message-headers-visible)
;; Message visibility depends on whether it matched the search
;; criteria.
(notmuch-show-message-visible msg (and (plist-get msg :match)
;; Message visibility depends on whether it matched the search
;; criteria.
(notmuch-show-message-visible msg (and (plist-get msg :match)
(switch-to-buffer (get-buffer-create buffer-name))
;; No need to track undo information for this buffer.
(setq buffer-undo-list t)
(switch-to-buffer (get-buffer-create buffer-name))
;; No need to track undo information for this buffer.
(setq buffer-undo-list t)
;; Set various buffer local variables to their appropriate initial
;; state. Do this after enabling `notmuch-show-mode' so that they
;; aren't wiped out.
;; Set various buffer local variables to their appropriate initial
;; state. Do this after enabling `notmuch-show-mode' so that they
;; aren't wiped out.
notmuch-show-query-context (if (or (string= query-context "")
(string= query-context "*"))
nil 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.
notmuch-show-elide-non-matching-messages
(if elide-toggle
(not notmuch-show-only-matching-messages)
notmuch-show-only-matching-messages))
notmuch-show-process-crypto notmuch-crypto-process-mime
;; If `elide-toggle', invert the default value.
notmuch-show-elide-non-matching-messages
(if elide-toggle
(not notmuch-show-only-matching-messages)
notmuch-show-only-matching-messages))
(add-hook 'post-command-hook #'notmuch-show-command-hook nil t)
(jit-lock-register #'notmuch-show-buttonise-links)
(add-hook 'post-command-hook #'notmuch-show-command-hook nil t)
(jit-lock-register #'notmuch-show-buttonise-links)
(notmuch-tag-clear-cache)
(notmuch-tag-clear-cache)
(let ((inhibit-read-only t))
(if (notmuch-show--build-buffer)
;; Messages were inserted into the buffer.
(current-buffer)
(let ((inhibit-read-only t))
(if (notmuch-show--build-buffer)
;; Messages were inserted into the buffer.
(current-buffer)
;; No messages were inserted - presumably none matched the
;; query.
(kill-buffer (current-buffer))
;; No messages were inserted - presumably none matched the
;; query.
(kill-buffer (current-buffer))
(setq queries (cdr queries)))
(when forest
(notmuch-show-insert-forest forest)
(setq queries (cdr queries)))
(when forest
(notmuch-show-insert-forest forest)
;; Store the original tags for each message so that we can
;; display changes.
(notmuch-show-mapc
(lambda () (notmuch-show-set-prop :orig-tags (notmuch-show-get-tags))))
;; Store the original tags for each message so that we can
;; 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)))))
;; 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)))))
(run-hooks 'notmuch-show-hook)
(run-hooks 'notmuch-show-hook)
(if state
(notmuch-show-apply-state state)
;; With no state to apply, just go to the first message.
(notmuch-show-goto-first-wanted-message)))
(if state
(notmuch-show-apply-state state)
;; With no state to apply, just go to the first message.
(notmuch-show-goto-first-wanted-message)))
;; Report back to the caller whether any messages matched.
forest))
;; Report back to the caller whether any messages matched.
forest))
- moving to the correct current message in every displayed window."
(let ((win-msg-alist (car state))
(open (cadr state)))
- moving to the correct current message in every displayed window."
(let ((win-msg-alist (car state))
(open (cadr state)))
;; Open those that were open.
(goto-char (point-min))
(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)))
;; Open those that were open.
(goto-char (point-min))
(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)
;; Go to the previously open message in this window
(dolist (win-msg-pair win-msg-alist)
(with-selected-window (car win-msg-pair)
;; Go to the previously open message in this window
;; manually.
(remove-overlays)
(erase-buffer)
;; manually.
(remove-overlays)
(erase-buffer)
(unless (notmuch-show--build-buffer state)
;; No messages were inserted.
(kill-buffer (current-buffer))
(unless (notmuch-show--build-buffer state)
;; No messages were inserted.
(kill-buffer (current-buffer))
(> visible-end-of-this-message (window-end)))
;; The bottom of this message is not visible - scroll.
(scroll-up nil))
(> visible-end-of-this-message (window-end)))
;; The bottom of this message is not visible - scroll.
(scroll-up nil))
((not (= end-of-this-message (point-max)))
;; This is not the last message - move to the next visible one.
(notmuch-show-next-open-message))
((not (= end-of-this-message (point-max)))
;; This is not the last message - move to the next visible one.
(notmuch-show-next-open-message))
((not (= (point) (point-max)))
;; This is the last message, but the cursor is not at the end of
;; the buffer. Move it there.
(goto-char (point-max)))
((not (= (point) (point-max)))
;; This is the last message, but the cursor is not at the end of
;; the buffer. Move it there.
(goto-char (point-max)))
(t
;; This is the last message - change the return value
(setq ret t)))
(t
;; This is the last message - change the return value
(setq ret t)))
(interactive)
(notmuch-show-apply-to-current-part-handle #'mm-pipe-part))
(interactive)
(notmuch-show-apply-to-current-part-handle #'mm-pipe-part))
(defun notmuch-show--mm-display-part (handle)
"Use mm-display-part to display HANDLE in a new buffer.
(defun notmuch-show--mm-display-part (handle)
"Use mm-display-part to display HANDLE in a new buffer.
(otherwise nil))))
(setq formatted-tag (notmuch-tag--do-format tag tag base))
(setq formatted-tag (notmuch-tag--do-format tag formatted-tag over))
(otherwise nil))))
(setq formatted-tag (notmuch-tag--do-format tag tag base))
(setq formatted-tag (notmuch-tag--do-format tag formatted-tag over))
(puthash (cons tag tag-state) formatted-tag notmuch-tag--format-cache)))
formatted-tag))
(puthash (cons tag tag-state) formatted-tag notmuch-tag--format-cache)))
formatted-tag))
a list of strings of the form \"+TAG\" or \"-TAG\".
'query' will be a string containing the search query that determines
the messages that are about to be tagged."
a list of strings of the form \"+TAG\" or \"-TAG\".
'query' will be a string containing the search query that determines
the messages that are about to be tagged."
:type 'hook
:options '(notmuch-hl-line-mode)
:group 'notmuch-hooks)
:type 'hook
:options '(notmuch-hl-line-mode)
:group 'notmuch-hooks)
non-nil, is the query string to present in the minibuffer. It
defaults to \"Tags\". INITIAL-INPUT, if non-nil, will be the
initial input in the minibuffer."
non-nil, is the query string to present in the minibuffer. It
defaults to \"Tags\". INITIAL-INPUT, if non-nil, will be the
initial input in the minibuffer."
(let* ((all-tag-list (notmuch-tag-completions))
(add-tag-list (mapcar (apply-partially 'concat "+") all-tag-list))
(remove-tag-list (mapcar (apply-partially 'concat "-") current-tags))
(let* ((all-tag-list (notmuch-tag-completions))
(add-tag-list (mapcar (apply-partially 'concat "+") all-tag-list))
(remove-tag-list (mapcar (apply-partially 'concat "-") current-tags))
message together with all its descendents."
(let ((msg (car tree))
(replies (cadr tree)))
message together with all its descendents."
(let ((msg (car tree))
(replies (cadr tree)))
(cond
((and (< 0 depth) (not last))
(push "├" tree-status))
(cond
((and (< 0 depth) (not last))
(push "├" tree-status))
(push "╰" tree-status))
((and (eq 0 depth) (not first) (not last))
(push "├" tree-status)))
(push "╰" tree-status))
((and (eq 0 depth) (not first) (not last))
(push "├" tree-status)))
(push (concat (if replies "┬" "─") "►") tree-status)
(setq msg (plist-put msg :first (and first (eq 0 depth))))
(setq msg (plist-put msg :tree-status tree-status))
(push (concat (if replies "┬" "─") "►") tree-status)
(setq msg (plist-put msg :first (and first (eq 0 depth))))
(setq msg (plist-put msg :tree-status tree-status))
(notmuch-tree-goto-and-insert-msg msg)
(pop tree-status)
(pop tree-status)
(notmuch-tree-goto-and-insert-msg msg)
(pop tree-status)
(pop tree-status)
(if last
(push " " tree-status)
(push "│" tree-status))
(if last
(push " " tree-status)
(push "│" tree-status))
(notmuch-tree-insert-thread replies (1+ depth) tree-status)))
(defun notmuch-tree-insert-thread (thread depth tree-status)
(notmuch-tree-insert-thread replies (1+ depth) tree-status)))
(defun notmuch-tree-insert-thread (thread depth tree-status)
Complete list of currently available key bindings:
\\{notmuch-tree-mode-map}"
Complete list of currently available key bindings:
\\{notmuch-tree-mode-map}"
(setq notmuch-buffer-refresh-function #'notmuch-tree-refresh-view)
(hl-line-mode 1)
(setq buffer-read-only t
(setq notmuch-buffer-refresh-function #'notmuch-tree-refresh-view)
(hl-line-mode 1)
(setq buffer-read-only t
;; (such as reply) do. It is a buffer local variable so setting it
;; will not affect genuine show buffers.
(setq notmuch-show-process-crypto notmuch-crypto-process-mime)
;; (such as reply) do. It is a buffer local variable so setting it
;; will not affect genuine show buffers.
(setq notmuch-show-process-crypto notmuch-crypto-process-mime)
(erase-buffer)
(goto-char (point-min))
(let* ((search-args (concat basic-query
(erase-buffer)
(goto-char (point-min))
(let* ((search-args (concat basic-query
(if unthreaded "unthreaded-" "tree-")
query "*")))))
(inhibit-read-only t))
(if unthreaded "unthreaded-" "tree-")
query "*")))))
(inhibit-read-only t))
(switch-to-buffer buffer))
;; Don't track undo information for this buffer
(set 'buffer-undo-list t)
(switch-to-buffer buffer))
;; Don't track undo information for this buffer
(set 'buffer-undo-list t)
(notmuch-tree-worker query query-context target open-target unthreaded)
(notmuch-tree-worker query query-context target open-target unthreaded)
(setq truncate-lines t))
(defun notmuch-unthreaded (&optional query query-context target buffer-name open-target)
(setq truncate-lines t))
(defun notmuch-unthreaded (&optional query query-context target buffer-name open-target)
\"citation\" or \"signature\". Optional PREFIX is some arbitrary
text to insert before the button, probably for indentation. Note
that PREFIX should not include a newline."
\"citation\" or \"signature\". Optional PREFIX is some arbitrary
text to insert before the button, probably for indentation. Note
that PREFIX should not include a newline."
;; This uses some slightly tricky conversions between strings and
;; symbols because of the way the button code works. Note that
;; replacing intern-soft with make-symbol will cause this to fail,
;; since the newly created symbol has no plist.
;; This uses some slightly tricky conversions between strings and
;; symbols because of the way the button code works. Note that
;; replacing intern-soft with make-symbol will cause this to fail,
;; since the newly created symbol has no plist.
(let ((overlay (make-overlay beg end))
(button-type (intern-soft (concat "notmuch-wash-button-"
type "-toggle-type"))))
(let ((overlay (make-overlay beg end))
(button-type (intern-soft (concat "notmuch-wash-button-"
type "-toggle-type"))))
(defun notmuch-wash-elide-blank-lines (msg depth)
"Elide leading, trailing and successive blank lines."
(defun notmuch-wash-elide-blank-lines (msg depth)
"Elide leading, trailing and successive blank lines."
;; Algorithm derived from `article-strip-multiple-blank-lines' in
;; `gnus-art.el'.
;; Algorithm derived from `article-strip-multiple-blank-lines' in
;; `gnus-art.el'.
;; Make all blank lines empty.
(goto-char (point-min))
(while (re-search-forward "^[[:space:]\t]+$" nil t)
(replace-match "" nil t))
;; Make all blank lines empty.
(goto-char (point-min))
(while (re-search-forward "^[[:space:]\t]+$" nil t)
(replace-match "" nil t))
;; Replace multiple empty lines with a single empty line.
(goto-char (point-min))
(while (re-search-forward "^\n\\(\n+\\)" nil t)
(delete-region (match-beginning 1) (match-end 1)))
;; Replace multiple empty lines with a single empty line.
(goto-char (point-min))
(while (re-search-forward "^\n\\(\n+\\)" nil t)
(delete-region (match-beginning 1) (match-end 1)))
;; Remove a leading blank line.
(goto-char (point-min))
(if (looking-at "\n")
(delete-region (match-beginning 0) (match-end 0)))
;; Remove a leading blank line.
(goto-char (point-min))
(if (looking-at "\n")
(delete-region (match-beginning 0) (match-end 0)))
;; Remove a trailing blank line.
(goto-char (point-max))
(if (looking-at "\n")
;; Remove a trailing blank line.
(goto-char (point-max))
(if (looking-at "\n")
text,
- Remove citation trailers standing alone after a block of cited
text."
text,
- Remove citation trailers standing alone after a block of cited
text."
;; Remove lines of repeated citation leaders with no other content.
(goto-char (point-min))
(while (re-search-forward "\\(^>[> ]*\n\\)\\{2,\\}" nil t)
(replace-match "\\1"))
;; Remove lines of repeated citation leaders with no other content.
(goto-char (point-min))
(while (re-search-forward "\\(^>[> ]*\n\\)\\{2,\\}" nil t)
(replace-match "\\1"))
-
- ;; Remove citation leaders standing alone before a block of cited
- ;; text.
+ ;; Remove citation leaders standing alone before a block of cited text.
(goto-char (point-min))
(while (re-search-forward "\\(\n\\|^[^>].*\\)\n\\(^>[> ]*\n\\)" nil t)
(replace-match "\\1\n"))
(goto-char (point-min))
(while (re-search-forward "\\(\n\\|^[^>].*\\)\n\\(^>[> ]*\n\\)" nil t)
(replace-match "\\1\n"))
-
- ;; Remove citation trailers standing alone after a block of cited
- ;; text.
+ ;; Remove citation trailers standing alone after a block of cited text.
(goto-char (point-min))
(while (re-search-forward "\\(^>[> ]*\n\\)\\(^$\\|^[^>].*\\)" nil t)
(replace-match "\\2")))
(goto-char (point-min))
(while (re-search-forward "\\(^>[> ]*\n\\)\\(^$\\|^[^>].*\\)" nil t)
(replace-match "\\2")))
its value. Otherwise, this function will wrap long lines in the
message at the window width. When doing so, citation leaders in
the wrapped text are maintained."
its value. Otherwise, this function will wrap long lines in the
message at the window width. When doing so, citation leaders in
the wrapped text are maintained."
(let* ((coolj-wrap-follows-window-size nil)
(indent (* depth notmuch-show-indent-messages-width))
(limit (if (numberp notmuch-wash-wrap-lines-length)
(let* ((coolj-wrap-follows-window-size nil)
(indent (* depth notmuch-show-indent-messages-width))
(limit (if (numberp notmuch-wash-wrap-lines-length)
Given that this function guesses whether a buffer includes a
patch and then guesses the extent of the patch, there is scope
for error."
Given that this function guesses whether a buffer includes a
patch and then guesses the extent of the patch, there is scope
for error."
(goto-char (point-min))
(when (re-search-forward diff-file-header-re nil t)
(beginning-of-line -1)
(goto-char (point-min))
(when (re-search-forward diff-file-header-re nil t)
(beginning-of-line -1)
(visible-string formatted-authors)
(invisible-string "")
(padding ""))
(visible-string formatted-authors)
(invisible-string "")
(padding ""))
;; Truncate the author string to fit the specification.
(if (> (length formatted-authors)
(length formatted-sample))
;; Truncate the author string to fit the specification.
(if (> (length formatted-authors)
(length formatted-sample))
(length visible-string)
(length "..."))
? ))))
(length visible-string)
(length "..."))
? ))))
;; Use different faces to show matching and non-matching authors.
(if (string-match "\\(.*\\)|\\(.*\\)" visible-string)
;; The visible string contains both matching and
;; Use different faces to show matching and non-matching authors.
(if (string-match "\\(.*\\)|\\(.*\\)" visible-string)
;; The visible string contains both matching and
;; The invisible string may contain both matching and
;; non-matching authors.
invisible-string (notmuch-search-author-propertize invisible-string)))
;; The invisible string may contain both matching and
;; non-matching authors.
invisible-string (notmuch-search-author-propertize invisible-string)))
;; If there is any invisible text, add it as a tooltip to the
;; visible text.
(when (not (string= invisible-string ""))
(setq visible-string
(propertize visible-string
'help-echo (concat "..." invisible-string))))
;; If there is any invisible text, add it as a tooltip to the
;; visible text.
(when (not (string= invisible-string ""))
(setq visible-string
(propertize visible-string
'help-echo (concat "..." invisible-string))))
;; Insert the visible and, if present, invisible author strings.
(insert visible-string)
(when (not (string= invisible-string ""))
;; Insert the visible and, if present, invisible author strings.
(insert visible-string)
(when (not (string= invisible-string ""))
(insert (propertize (format format-string
(notmuch-sanitize (plist-get result :subject)))
'face 'notmuch-search-subject)))
(insert (propertize (format format-string
(notmuch-sanitize (plist-get result :subject)))
'face 'notmuch-search-subject)))
((string-equal field "authors")
(notmuch-search-insert-authors
format-string (notmuch-sanitize (plist-get result :authors))))
((string-equal field "authors")
(notmuch-search-insert-authors
format-string (notmuch-sanitize (plist-get result :authors))))
((string-equal field "tags")
(let ((tags (plist-get result :tags))
(orig-tags (plist-get result :orig-tags)))
((string-equal field "tags")
(let ((tags (plist-get result :tags))
(orig-tags (plist-get result :orig-tags)))
If the current buffer is the only notmuch buffer, bury it. If no
notmuch buffers exist, run `notmuch'."
(interactive)
If the current buffer is the only notmuch buffer, bury it. If no
notmuch buffers exist, run `notmuch'."
(interactive)
(let (start first)
;; If the current buffer is a notmuch buffer, remember it and then
;; bury it.
(let (start first)
;; If the current buffer is a notmuch buffer, remember it and then
;; bury it.