debian/notmuch
1
0
Fork 0
mirror of https://git.notmuchmail.org/git/notmuch synced 2024-11-27 21:27:58 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

emacs: Remove excess empty lines

Browse source 
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.
This commit is contained in:
Jonas Bernoulli 2020-08-08 13:49:37 +02:00 committed by David Bremner
parent a4617f29ce
commit 6fb7d35069
14 changed files with 5 additions and 186 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
emacs/make-deps.el
View file

@ -23,7 +23,6 @@
(defun batch-make-deps () (defun batch-make-deps ()
"Invoke `make-deps' for each file on the command line." "Invoke `make-deps' for each file on the command line."
(setq debug-on-error t) (setq debug-on-error t)
(dolist (file command-line-args-left) (dolist (file command-line-args-left)
(let ((default-directory command-line-default-directory)) (let ((default-directory command-line-default-directory))
@ -37,7 +36,6 @@
This prints make dependencies to `standard-output' based on the This prints make dependencies to `standard-output' based on the
top-level `require' expressions in the current buffer. Paths in top-level `require' expressions in the current buffer. Paths in
rules will be given relative to DIR, or `default-directory'." rules will be given relative to DIR, or `default-directory'."
(setq dir (or dir default-directory)) (setq dir (or dir default-directory))
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))

2
emacs/notmuch-address.el
View file

@ -302,7 +302,6 @@ matching ADDR-PREFIX*' are queried.
Address harvesting may take some time so the address collection runs Address harvesting may take some time so the address collection runs
asynchronously unless SYNCHRONOUS is t. In case of asynchronous asynchronously unless SYNCHRONOUS is t. In case of asynchronous
execution, CALLBACK is called when harvesting finishes." execution, CALLBACK is called when harvesting finishes."
(let* ((sent (eq (car notmuch-address-internal-completion) 'sent)) (let* ((sent (eq (car notmuch-address-internal-completion) 'sent))
(config-query (cadr notmuch-address-internal-completion)) (config-query (cadr notmuch-address-internal-completion))
(prefix-query (when addr-prefix (prefix-query (when addr-prefix
@ -335,7 +334,6 @@ execution, CALLBACK is called when harvesting finishes."
;; Kill any existing process ;; Kill any existing process
(when current-proc (when current-proc
(kill-buffer (process-buffer current-proc))) ; this also kills the process (kill-buffer (process-buffer current-proc))) ; this also kills the process
(setq current-proc (setq current-proc
(apply 'notmuch-start-notmuch proc-name proc-buf (apply 'notmuch-start-notmuch proc-name proc-buf
callback ; process sentinel callback ; process sentinel

4
emacs/notmuch-crypto.el
View file

@ -123,17 +123,14 @@ by user FROM."
face 'notmuch-crypto-signature-good-key)) face 'notmuch-crypto-signature-good-key))
(setq button-action 'notmuch-crypto-sigstatus-good-callback (setq button-action 'notmuch-crypto-sigstatus-good-callback
help-msg (concat "Click to list key ID 0x" fingerprint ".")))) help-msg (concat "Click to list key ID 0x" fingerprint "."))))
((string= status "error") ((string= status "error")
(setq label (concat "Unknown key ID " keyid " or unsupported algorithm") (setq label (concat "Unknown key ID " keyid " or unsupported algorithm")
button-action 'notmuch-crypto-sigstatus-error-callback button-action 'notmuch-crypto-sigstatus-error-callback
help-msg (concat "Click to retrieve key ID " keyid help-msg (concat "Click to retrieve key ID " keyid
" from keyserver."))) " from keyserver.")))
((string= status "bad") ((string= status "bad")
(setq label (concat "Bad signature (claimed key ID " keyid ")") (setq label (concat "Bad signature (claimed key ID " keyid ")")
face 'notmuch-crypto-signature-bad)) face 'notmuch-crypto-signature-bad))
(status (status
(setq label (concat "Unknown signature status: " status))) (setq label (concat "Unknown signature status: " status)))
(t (t
@ -232,7 +229,6 @@ corresponding key when the status button is pressed."
(process-put p :notmuch-show-buffer (current-buffer)) (process-put p :notmuch-show-buffer (current-buffer))
(process-put p :notmuch-show-point (point)) (process-put p :notmuch-show-point (point))
(message "Getting the GPG key %s asynchronously..." keyid))) (message "Getting the GPG key %s asynchronously..." keyid)))
(let ((window (display-buffer buffer))) (let ((window (display-buffer buffer)))
(with-selected-window window (with-selected-window window
(with-current-buffer buffer (with-current-buffer buffer

18
emacs/notmuch-hello.el
View file

@ -150,7 +150,6 @@ or a list of the form (NAME QUERY COUNT-QUERY)."
;; The saved-search format is also used by the all-tags notmuch-hello ;; 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 ;; section. This section generates its own saved-search list in one of
;; the latter two forms. ;; the latter two forms.
:get 'notmuch-hello--saved-searches-to-plist :get 'notmuch-hello--saved-searches-to-plist
:type '(repeat notmuch-saved-search-plist) :type '(repeat notmuch-saved-search-plist)
:tag "List of Saved Searches" :tag "List of Saved Searches"
@ -482,20 +481,17 @@ should be. Returns a cons cell `(tags-per-line width)'."
;; Count is 9 wide (8 digits plus space), 1 for the space ;; Count is 9 wide (8 digits plus space), 1 for the space
;; after the name. ;; after the name.
(+ 9 1 (max notmuch-column-control widest))))) (+ 9 1 (max notmuch-column-control widest)))))
((floatp notmuch-column-control) ((floatp notmuch-column-control)
(let* ((available-width (- (window-width) notmuch-hello-indent)) (let* ((available-width (- (window-width) notmuch-hello-indent))
(proposed-width (max (* available-width notmuch-column-control) (proposed-width (max (* available-width notmuch-column-control)
widest))) widest)))
(floor available-width proposed-width))) (floor available-width proposed-width)))
(t (t
(max 1 (max 1
(/ (- (window-width) notmuch-hello-indent) (/ (- (window-width) notmuch-hello-indent)
;; Count is 9 wide (8 digits plus space), 1 for the space ;; Count is 9 wide (8 digits plus space), 1 for the space
;; after the name. ;; after the name.
(+ 9 1 widest))))))) (+ 9 1 widest)))))))
(cons tags-per-line (/ (max 1 (cons tags-per-line (/ (max 1
(- (window-width) notmuch-hello-indent (- (window-width) notmuch-hello-indent
;; Count is 9 wide (8 digits plus ;; Count is 9 wide (8 digits plus
@ -545,7 +541,6 @@ options will be handled as specified for
(or (plist-get options :filter-count) (or (plist-get options :filter-count)
(plist-get options :filter)))) (plist-get options :filter))))
"\n"))) "\n")))
(unless (= (call-process-region (point-min) (point-max) notmuch-command (unless (= (call-process-region (point-min) (point-max) notmuch-command
t t nil "count" "--batch") 0) t t nil "count" "--batch") 0)
(notmuch-logged-error (notmuch-logged-error
@ -553,9 +548,7 @@ options will be handled as specified for
"Please check that the notmuch CLI is new enough to support `count "Please check that the notmuch CLI is new enough to support `count
--batch'. In general we recommend running matching versions of --batch'. In general we recommend running matching versions of
the CLI and emacs interface.")) the CLI and emacs interface."))
(goto-char (point-min)) (goto-char (point-min))
(notmuch-remove-if-not (notmuch-remove-if-not
#'identity #'identity
(mapcar (mapcar
@ -621,7 +614,6 @@ with `notmuch-hello-query-counts'."
(setq column-indent 0) (setq column-indent 0)
(widget-insert "\n"))) (widget-insert "\n")))
reordered-list) reordered-list)
;; If the last line was not full (and hence did not include a ;; If the last line was not full (and hence did not include a
;; carriage return), insert one now. ;; carriage return), insert one now.
(unless (eq (% count tags-per-line) 0) (unless (eq (% count tags-per-line) 0)
@ -780,7 +772,6 @@ Complete list of currently available key bindings:
(car (process-lines notmuch-command "count"))))) (car (process-lines notmuch-command "count")))))
(widget-insert " messages.\n"))) (widget-insert " messages.\n")))
(defun notmuch-hello-insert-saved-searches () (defun notmuch-hello-insert-saved-searches ()
"Insert the saved-searches section." "Insert the saved-searches section."
(let ((searches (notmuch-hello-query-counts (let ((searches (notmuch-hello-query-counts
@ -977,7 +968,6 @@ following:
(defun notmuch-hello (&optional no-display) (defun notmuch-hello (&optional no-display)
"Run notmuch and display saved searches, known tags, etc." "Run notmuch and display saved searches, known tags, etc."
(interactive) (interactive)
(notmuch-assert-cli-sane) (notmuch-assert-cli-sane)
;; This may cause a window configuration change, so if the ;; This may cause a window configuration change, so if the
;; auto-refresh hook is already installed, avoid recursive refresh. ;; auto-refresh hook is already installed, avoid recursive refresh.
@ -985,32 +975,25 @@ following:
(if no-display (if no-display
(set-buffer "*notmuch-hello*") (set-buffer "*notmuch-hello*")
(switch-to-buffer "*notmuch-hello*"))) (switch-to-buffer "*notmuch-hello*")))
;; Install auto-refresh hook ;; Install auto-refresh hook
(when notmuch-hello-auto-refresh (when notmuch-hello-auto-refresh
(add-hook 'window-configuration-change-hook (add-hook 'window-configuration-change-hook
#'notmuch-hello-window-configuration-change)) #'notmuch-hello-window-configuration-change))
(let ((target-line (line-number-at-pos)) (let ((target-line (line-number-at-pos))
(target-column (current-column)) (target-column (current-column))
(inhibit-read-only t)) (inhibit-read-only t))
;; Delete all editable widget fields. Editable widget fields are ;; Delete all editable widget fields. Editable widget fields are
;; tracked in a buffer local variable `widget-field-list' (and ;; tracked in a buffer local variable `widget-field-list' (and
;; others). If we do `erase-buffer' without properly deleting the ;; others). If we do `erase-buffer' without properly deleting the
;; widgets, some widget-related functions are confused later. ;; widgets, some widget-related functions are confused later.
(mapc 'widget-delete widget-field-list) (mapc 'widget-delete widget-field-list)
(erase-buffer) (erase-buffer)
(unless (eq major-mode 'notmuch-hello-mode) (unless (eq major-mode 'notmuch-hello-mode)
(notmuch-hello-mode)) (notmuch-hello-mode))
(let ((all (overlay-lists))) (let ((all (overlay-lists)))
;; Delete all the overlays. ;; Delete all the overlays.
(mapc 'delete-overlay (car all)) (mapc 'delete-overlay (car all))
(mapc 'delete-overlay (cdr all))) (mapc 'delete-overlay (cdr all)))
(mapc (mapc
(lambda (section) (lambda (section)
(let ((point-before (point))) (let ((point-before (point)))
@ -1023,7 +1006,6 @@ following:
(widget-insert "\n")))) (widget-insert "\n"))))
notmuch-hello-sections) notmuch-hello-sections)
(widget-setup) (widget-setup)
;; Move point back to where it was before refresh. Use line and ;; Move point back to where it was before refresh. Use line and
;; column instead of point directly to be insensitive to additions ;; column instead of point directly to be insensitive to additions
;; and removals of text within earlier lines. ;; and removals of text within earlier lines.

5
emacs/notmuch-jump.el
View file

@ -43,7 +43,6 @@ keys configured in the :key property of `notmuch-saved-searches'.
Typically these shortcuts are a single key long, so this is a Typically these shortcuts are a single key long, so this is a
fast way to jump to a saved search from anywhere in Notmuch." fast way to jump to a saved search from anywhere in Notmuch."
(interactive) (interactive)
;; Build the action map ;; Build the action map
(let (action-map) (let (action-map)
(dolist (saved-search notmuch-saved-searches) (dolist (saved-search notmuch-saved-searches)
@ -67,7 +66,6 @@ fast way to jump to a saved search from anywhere in Notmuch."
`(lambda () (notmuch-search ',query ',oldest-first))))) `(lambda () (notmuch-search ',query ',oldest-first)))))
action-map))))) action-map)))))
(setq action-map (nreverse action-map)) (setq action-map (nreverse action-map))
(if action-map (if action-map
(notmuch-jump action-map "Search: ") (notmuch-jump action-map "Search: ")
(error "To use notmuch-jump, \ (error "To use notmuch-jump, \
@ -90,7 +88,6 @@ where KEY is a key binding, LABEL is a string label to display in
the buffer, and ACTION is a nullary function to call. LABEL may 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 be null, in which case the action will still be bound, but will
not appear in the pop-up buffer." not appear in the pop-up buffer."
(let* ((items (notmuch-jump--format-actions action-map)) (let* ((items (notmuch-jump--format-actions action-map))
;; Format the table of bindings and the full prompt ;; Format the table of bindings and the full prompt
(table (table
@ -115,7 +112,6 @@ not appear in the pop-up buffer."
(notmuch-jump--action nil)) (notmuch-jump--action nil))
;; Read the action ;; Read the action
(read-from-minibuffer full-prompt nil minibuffer-map) (read-from-minibuffer full-prompt nil minibuffer-map)
;; If we got an action, do it ;; If we got an action, do it
(when notmuch-jump--action (when notmuch-jump--action
(funcall notmuch-jump--action)))) (funcall notmuch-jump--action))))
@ -126,7 +122,6 @@ not appear in the pop-up buffer."
Returns a list of strings, one for each item with a label in Returns a list of strings, one for each item with a label in
ACTION-MAP. These strings can be inserted into a tabular ACTION-MAP. These strings can be inserted into a tabular
buffer." buffer."
;; Compute the maximum key description width ;; Compute the maximum key description width
(let ((key-width 1)) (let ((key-width 1))
(pcase-dolist (`(,key ,desc) action-map) (pcase-dolist (`(,key ,desc) action-map)

10
emacs/notmuch-lib.el
View file

@ -418,7 +418,6 @@ of its command symbol."
(while (< i (length prefix)) (while (< i (length prefix))
(aset prefix i (aref key i)) (aset prefix i (aref key i))
(setq i (1+ i))) (setq i (1+ i)))
(let* ((subkeymap (key-binding prefix)) (let* ((subkeymap (key-binding prefix))
(ua-keys (where-is-internal 'universal-argument nil t)) (ua-keys (where-is-internal 'universal-argument nil t))
(prefix-string (notmuch-prefix-key-description prefix)) (prefix-string (notmuch-prefix-key-description prefix))
@ -486,7 +485,6 @@ This includes newlines, tabs, and other funny characters."
The caller is responsible for prepending the term prefix and a The caller is responsible for prepending the term prefix and a
colon. This performs minimal escaping in order to produce colon. This performs minimal escaping in order to produce
user-friendly queries." user-friendly queries."
(save-match-data (save-match-data
(if (or (equal term "") (if (or (equal term "")
;; To be pessimistic, only pass through terms composed ;; To be pessimistic, only pass through terms composed
@ -731,7 +729,6 @@ must be a face name (a symbol or string), a property list of face
attributes, or a list of these. If START and/or END are omitted, attributes, or a list of these. If START and/or END are omitted,
they default to the beginning/end of OBJECT. For convenience they default to the beginning/end of OBJECT. For convenience
when applied to strings, this returns OBJECT." when applied to strings, this returns OBJECT."
;; A face property can have three forms: a face name (a string or ;; 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 ;; symbol), a property list, or a list of these two forms. In the
;; list case, the faces will be combined, with the earlier faces ;; list case, the faces will be combined, with the earlier faces
@ -774,7 +771,6 @@ This logs MSG and EXTRA to the *Notmuch errors* buffer and
signals MSG as an error. If EXTRA is non-nil, text referring the signals MSG as an error. If EXTRA is non-nil, text referring the
user to the *Notmuch errors* buffer will be appended to the user to the *Notmuch errors* buffer will be appended to the
signaled error. This function does not return." signaled error. This function does not return."
(with-current-buffer (get-buffer-create "*Notmuch errors*") (with-current-buffer (get-buffer-create "*Notmuch errors*")
(goto-char (point-max)) (goto-char (point-max))
(unless (bobp) (unless (bobp)
@ -819,7 +815,6 @@ command and its arguments. OUTPUT, if provided, is a string
giving the output of command. ERR, if provided, is the error giving the output of command. ERR, if provided, is the error
output of command. OUTPUT and ERR will be included in the error output of command. OUTPUT and ERR will be included in the error
message." message."
(cond (cond
((eq exit-status 0) t) ((eq exit-status 0) t)
((eq exit-status 20) ((eq exit-status 20)
@ -865,7 +860,6 @@ You may need to restart Emacs or upgrade your notmuch package."))
This wraps `call-process'. DESTINATION has the same meaning as This wraps `call-process'. DESTINATION has the same meaning as
for `call-process'. ARGS is as described for for `call-process'. ARGS is as described for
`notmuch-call-notmuch-process'." `notmuch-call-notmuch-process'."
(let (stdin-string) (let (stdin-string)
(while (keywordp (car args)) (while (keywordp (car args))
(cl-case (car args) (cl-case (car args)
@ -903,7 +897,6 @@ notmuch's output as an S-expression and returns the parsed value.
Like `notmuch-call-notmuch-process', if notmuch exits with a Like `notmuch-call-notmuch-process', if notmuch exits with a
non-zero status, this will report its output and signal an non-zero status, this will report its output and signal an
error." error."
(with-temp-buffer (with-temp-buffer
(let ((err-file (make-temp-file "nmerr"))) (let ((err-file (make-temp-file "nmerr")))
(unwind-protect (unwind-protect
@ -931,7 +924,6 @@ when the process exits, or nil for none. The caller must *not*
invoke `set-process-sentinel' directly on the returned process, invoke `set-process-sentinel' directly on the returned process,
as that will interfere with the handling of stderr and the exit as that will interfere with the handling of stderr and the exit
status." status."
(let (err-file err-buffer proc err-proc (let (err-file err-buffer proc err-proc
;; Find notmuch using Emacs' `exec-path' ;; Find notmuch using Emacs' `exec-path'
(command (or (executable-find notmuch-command) (command (or (executable-find notmuch-command)
@ -956,7 +948,6 @@ status."
(process-put err-proc 'err-file err-file) (process-put err-proc 'err-file err-file)
(process-put err-proc 'err-buffer err-buffer) (process-put err-proc 'err-buffer err-buffer)
(set-process-sentinel err-proc #'notmuch-start-notmuch-error-sentinel)) (set-process-sentinel err-proc #'notmuch-start-notmuch-error-sentinel))
;; On Emacs versions before 25, there is no way to capture ;; On Emacs versions before 25, there is no way to capture
;; stdout and stderr separately for asynchronous processes, or ;; stdout and stderr separately for asynchronous processes, or
;; even to redirect stderr to a file, so we use a trivial shell ;; even to redirect stderr to a file, so we use a trivial shell
@ -969,7 +960,6 @@ status."
"exec 2>\"$1\"; shift; exec \"$0\" \"$@\"" "exec 2>\"$1\"; shift; exec \"$0\" \"$@\""
command err-file args))) command err-file args)))
(process-put proc 'err-file err-file)) (process-put proc 'err-file err-file))
(process-put proc 'sub-sentinel sentinel) (process-put proc 'sub-sentinel sentinel)
(process-put proc 'real-command (cons notmuch-command args)) (process-put proc 'real-command (cons notmuch-command args))
(set-process-sentinel proc #'notmuch-start-notmuch-sentinel) (set-process-sentinel proc #'notmuch-start-notmuch-sentinel)

7
emacs/notmuch-maildir-fcc.el
View file

@ -94,22 +94,18 @@ Sets the Fcc header based on the values of `notmuch-fcc-dirs'.
Originally intended to be use a hook function, but now called directly Originally intended to be use a hook function, but now called directly
by notmuch-mua-mail." by notmuch-mua-mail."
(let ((subdir (let ((subdir
(cond (cond
((or (not notmuch-fcc-dirs) ((or (not notmuch-fcc-dirs)
(message-field-value "Fcc")) (message-field-value "Fcc"))
;; Nothing set or an existing header. ;; Nothing set or an existing header.
nil) nil)
((stringp notmuch-fcc-dirs) ((stringp notmuch-fcc-dirs)
notmuch-fcc-dirs) notmuch-fcc-dirs)
((and (listp notmuch-fcc-dirs) ((and (listp notmuch-fcc-dirs)
(stringp (car notmuch-fcc-dirs))) (stringp (car notmuch-fcc-dirs)))
;; Old style - no longer works. ;; Old style - no longer works.
(error "Invalid `notmuch-fcc-dirs' setting (old style)")) (error "Invalid `notmuch-fcc-dirs' setting (old style)"))
((listp notmuch-fcc-dirs) ((listp notmuch-fcc-dirs)
(let* ((from (message-field-value "From")) (let* ((from (message-field-value "From"))
(match (match
@ -121,10 +117,8 @@ by notmuch-mua-mail."
(cdr match) (cdr match)
(message "No Fcc header added.") (message "No Fcc header added.")
nil))) nil)))
(t (t
(error "Invalid `notmuch-fcc-dirs' setting (neither string nor list)"))))) (error "Invalid `notmuch-fcc-dirs' setting (neither string nor list)")))))
(when subdir (when subdir
(if notmuch-maildir-use-notmuch-insert (if notmuch-maildir-use-notmuch-insert
(notmuch-maildir-add-notmuch-insert-style-fcc-header subdir) (notmuch-maildir-add-notmuch-insert-style-fcc-header subdir)
@ -133,7 +127,6 @@ by notmuch-mua-mail."
(defun 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 ;; Notmuch insert does not accept absolute paths, so check the user
;; really want this header inserted. ;; really want this header inserted.
(when (or (not (= (elt subdir 0) ?/)) (when (or (not (= (elt subdir 0) ?/))
(y-or-n-p (y-or-n-p
(format "Fcc header %s is an absolute path and notmuch insert is requested. (format "Fcc header %s is an absolute path and notmuch insert is requested.

26
emacs/notmuch-mua.el
View file

@ -228,22 +228,17 @@ Typically this is added to `notmuch-mua-send-hook'."
original) original)
(when process-crypto (when process-crypto
(setq args (append args '("--decrypt=true")))) (setq args (append args '("--decrypt=true"))))
(if reply-all (if reply-all
(setq args (append args '("--reply-to=all"))) (setq args (append args '("--reply-to=all")))
(setq args (append args '("--reply-to=sender")))) (setq args (append args '("--reply-to=sender"))))
(setq args (append args (list query-string))) (setq args (append args (list query-string)))
;; Get the reply object as SEXP, and parse it into an elisp object. ;; Get the reply object as SEXP, and parse it into an elisp object.
(setq reply (apply #'notmuch-call-notmuch-sexp args)) (setq reply (apply #'notmuch-call-notmuch-sexp args))
;; Extract the original message to simplify the following code. ;; Extract the original message to simplify the following code.
(setq original (plist-get reply :original)) (setq original (plist-get reply :original))
;; Extract the headers of both the reply and the original message. ;; Extract the headers of both the reply and the original message.
(let* ((original-headers (plist-get original :headers)) (let* ((original-headers (plist-get original :headers))
(reply-headers (plist-get reply :reply-headers))) (reply-headers (plist-get reply :reply-headers)))
;; If sender is non-nil, set the From: header to its value. ;; If sender is non-nil, set the From: header to its value.
(when sender (when sender
(plist-put reply-headers :From sender)) (plist-put reply-headers :From sender))
@ -251,7 +246,6 @@ Typically this is added to `notmuch-mua-send-hook'."
;; Overlay the composition window on that being used to read ;; Overlay the composition window on that being used to read
;; the original message. ;; the original message.
((same-window-regexps '("\\*mail .*"))) ((same-window-regexps '("\\*mail .*")))
;; We modify message-header-format-alist to get around ;; We modify message-header-format-alist to get around
;; a bug in message.el. See the comment above on ;; a bug in message.el. See the comment above on
;; notmuch-mua-insert-references. ;; notmuch-mua-insert-references.
@ -268,13 +262,11 @@ Typically this is added to `notmuch-mua-send-hook'."
(notmuch-sanitize (plist-get reply-headers :Subject)) (notmuch-sanitize (plist-get reply-headers :Subject))
(notmuch-headers-plist-to-alist reply-headers) (notmuch-headers-plist-to-alist reply-headers)
nil (notmuch-mua-get-switch-function)))) nil (notmuch-mua-get-switch-function))))
;; Create a buffer-local queue for tag changes triggered when ;; Create a buffer-local queue for tag changes triggered when
;; sending the reply. ;; sending the reply.
(when notmuch-message-replied-tags (when notmuch-message-replied-tags
(setq-local notmuch-message-queued-tag-changes (setq-local notmuch-message-queued-tag-changes
(list (cons query-string notmuch-message-replied-tags)))) (list (cons query-string notmuch-message-replied-tags))))
;; Insert the message body - but put it in front of the signature ;; Insert the message body - but put it in front of the signature
;; if one is present, and after any other content ;; if one is present, and after any other content
;; message*setup-hooks may have added to the message body already. ;; message*setup-hooks may have added to the message body already.
@ -286,17 +278,14 @@ Typically this is added to `notmuch-mua-send-hook'."
(if message-signature-insert-empty-line (if message-signature-insert-empty-line
(forward-line -1)) (forward-line -1))
(goto-char (point-max)))) (goto-char (point-max))))
(let ((from (plist-get original-headers :From)) (let ((from (plist-get original-headers :From))
(date (plist-get original-headers :Date)) (date (plist-get original-headers :Date))
(start (point))) (start (point)))
;; notmuch-mua-cite-function constructs a citation line based ;; notmuch-mua-cite-function constructs a citation line based
;; on the From and Date headers of the original message, which ;; on the From and Date headers of the original message, which
;; are assumed to be in the buffer. ;; are assumed to be in the buffer.
(insert "From: " from "\n") (insert "From: " from "\n")
(insert "Date: " date "\n\n") (insert "Date: " date "\n\n")
(insert (insert
(with-temp-buffer (with-temp-buffer
(let (let
@ -320,22 +309,18 @@ Typically this is added to `notmuch-mua-send-hook'."
((symbol-function 'notmuch-crypto-insert-encstatus-button) #'ignore)) ((symbol-function 'notmuch-crypto-insert-encstatus-button) #'ignore))
(notmuch-show-insert-body original (plist-get original :body) 0) (notmuch-show-insert-body original (plist-get original :body) 0)
(buffer-substring-no-properties (point-min) (point-max)))))) (buffer-substring-no-properties (point-min) (point-max))))))
(set-mark (point)) (set-mark (point))
(goto-char start) (goto-char start)
;; Quote the original message according to the user's configured style. ;; Quote the original message according to the user's configured style.
(funcall notmuch-mua-cite-function))) (funcall notmuch-mua-cite-function)))
;; Crypto processing based crypto content of the original message ;; Crypto processing based crypto content of the original message
(when process-crypto (when process-crypto
(notmuch-mua-reply-crypto (plist-get original :body)))) (notmuch-mua-reply-crypto (plist-get original :body))))
;; Push mark right before signature, if any. ;; Push mark right before signature, if any.
(message-goto-signature) (message-goto-signature)
(unless (eobp) (unless (eobp)
(end-of-line -1)) (end-of-line -1))
(push-mark) (push-mark)
(message-goto-body) (message-goto-body)
(set-buffer-modified-p nil)) (set-buffer-modified-p nil))
@ -381,18 +366,15 @@ modified. This function is notmuch addaptation of
return-action &rest ignored) return-action &rest ignored)
"Invoke the notmuch mail composition window." "Invoke the notmuch mail composition window."
(interactive) (interactive)
(when notmuch-mua-user-agent-function (when notmuch-mua-user-agent-function
(let ((user-agent (funcall notmuch-mua-user-agent-function))) (let ((user-agent (funcall notmuch-mua-user-agent-function)))
(when (not (string= "" user-agent)) (when (not (string= "" user-agent))
(push (cons 'User-Agent user-agent) other-headers)))) (push (cons 'User-Agent user-agent) other-headers))))
(unless (assq 'From other-headers) (unless (assq 'From other-headers)
(push (cons 'From (message-make-from (push (cons 'From (message-make-from
(notmuch-user-name) (notmuch-user-name)
(notmuch-user-primary-email))) (notmuch-user-primary-email)))
other-headers)) other-headers))
(notmuch-mua-pop-to-buffer (message-buffer-name "mail" to) (notmuch-mua-pop-to-buffer (message-buffer-name "mail" to)
(or switch-function (or switch-function
(notmuch-mua-get-switch-function))) (notmuch-mua-get-switch-function)))
@ -422,7 +404,6 @@ modified. This function is notmuch addaptation of
(message-hide-headers) (message-hide-headers)
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
(notmuch-mua-maybe-set-window-dedicated) (notmuch-mua-maybe-set-window-dedicated)
(message-goto-to)) (message-goto-to))
(defcustom notmuch-identities nil (defcustom notmuch-identities nil
@ -495,10 +476,8 @@ the From: address."
;; applied later. ;; applied later.
forward-references ;; List of accumulated message-references of forwarded messages forward-references ;; List of accumulated message-references of forwarded messages
forward-queries) ;; List of corresponding message-query forward-queries) ;; List of corresponding message-query
;; Generate the template for the outgoing message. ;; Generate the template for the outgoing message.
(notmuch-mua-mail nil "" other-headers nil (notmuch-mua-get-switch-function)) (notmuch-mua-mail nil "" other-headers nil (notmuch-mua-get-switch-function))
(save-excursion (save-excursion
;; Insert all of the forwarded messages. ;; Insert all of the forwarded messages.
(mapc (lambda (id) (mapc (lambda (id)
@ -524,7 +503,6 @@ the From: address."
;; `message-forward-make-body' always puts the message at ;; `message-forward-make-body' always puts the message at
;; the top, so do them in reverse order. ;; the top, so do them in reverse order.
(reverse messages)) (reverse messages))
;; Add in the appropriate subject. ;; Add in the appropriate subject.
(save-restriction (save-restriction
(message-narrow-to-headers) (message-narrow-to-headers)
@ -533,7 +511,6 @@ the From: address."
(message-remove-header "References") (message-remove-header "References")
(message-add-header (concat "References: " (message-add-header (concat "References: "
(mapconcat 'identity forward-references " ")))) (mapconcat 'identity forward-references " "))))
;; Create a buffer-local queue for tag changes triggered when ;; Create a buffer-local queue for tag changes triggered when
;; sending the message. ;; sending the message.
(when notmuch-message-forwarded-tags (when notmuch-message-forwarded-tags
@ -541,7 +518,6 @@ the From: address."
(cl-loop for id in forward-queries (cl-loop for id in forward-queries
collect collect
(cons id notmuch-message-forwarded-tags)))) (cons id notmuch-message-forwarded-tags))))
;; `message-forward-make-body' shows the User-agent header. Hide ;; `message-forward-make-body' shows the User-agent header. Hide
;; it again. ;; it again.
(message-hide-headers) (message-hide-headers)
@ -553,7 +529,6 @@ the From: address."
If PROMPT-FOR-SENDER is non-nil, the user will be prompted for 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 the From: address first. If REPLY-ALL is non-nil, the message
will be addressed to all recipients of the source message." will be addressed to all recipients of the source message."
;; In current emacs (24.3) select-active-regions is set to t by ;; In current emacs (24.3) select-active-regions is set to t by
;; default. The reply insertion code sets the region to the quoted ;; 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 ;; message to make it easy to delete (kill-region or C-w). These two
@ -565,7 +540,6 @@ will be addressed to all recipients of the source message."
;; primary selection was previously in a non-emacs window but not if ;; 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 ;; it was in an emacs window. To avoid the problem in the latter case
;; we deactivate mark. ;; we deactivate mark.
(let ((sender (let ((sender
(when prompt-for-sender (when prompt-for-sender
(notmuch-mua-prompt-for-sender))) (notmuch-mua-prompt-for-sender)))

5
emacs/notmuch-parser.el
View file

@ -38,7 +38,6 @@ can return 'retry to indicate that not enough input is available.
The parser always consumes input from point in the current The parser always consumes input from point in the current
buffer. Hence, the caller is allowed to delete any data before buffer. Hence, the caller is allowed to delete any data before
point and may resynchronize after an error by moving point." point and may resynchronize after an error by moving point."
(vector 'notmuch-sexp-parser (vector 'notmuch-sexp-parser
;; List depth ;; List depth
0 0
@ -60,7 +59,6 @@ parser is currently inside a list and the next token ends the
list, this moves point just past the terminator and returns 'end. list, this moves point just past the terminator and returns 'end.
Otherwise, this moves point to just past the end of the value and Otherwise, this moves point to just past the end of the value and
returns the value." returns the value."
(skip-chars-forward " \n\r\t") (skip-chars-forward " \n\r\t")
(cond ((eobp) 'retry) (cond ((eobp) 'retry)
((= (char-after) ?\)) ((= (char-after) ?\))
@ -134,7 +132,6 @@ a list, it moves point past the token that opens the list and
returns t. Later calls to `notmuch-sexp-read' will return the returns t. Later calls to `notmuch-sexp-read' will return the
elements inside the list. If the input in buffer is not the elements inside the list. If the input in buffer is not the
beginning of a list, throw invalid-read-syntax." beginning of a list, throw invalid-read-syntax."
(skip-chars-forward " \n\r\t") (skip-chars-forward " \n\r\t")
(cond ((eobp) 'retry) (cond ((eobp) 'retry)
((= (char-after) ?\() ((= (char-after) ?\()
@ -151,7 +148,6 @@ beginning of a list, throw invalid-read-syntax."
Moves point to the beginning of any trailing data or to the end Moves point to the beginning of any trailing data or to the end
of the buffer if there is only trailing whitespace." of the buffer if there is only trailing whitespace."
(skip-chars-forward " \n\r\t") (skip-chars-forward " \n\r\t")
(unless (eobp) (unless (eobp)
(error "Trailing garbage following expression"))) (error "Trailing garbage following expression")))
@ -173,7 +169,6 @@ complete value in the list. It operates incrementally and should
be called whenever the input buffer has been extended with be called whenever the input buffer has been extended with
additional data. The caller just needs to ensure it does not additional data. The caller just needs to ensure it does not
move point in the input buffer." move point in the input buffer."
;; Set up the initial state ;; Set up the initial state
(unless (local-variable-p 'notmuch-sexp--parser) (unless (local-variable-p 'notmuch-sexp--parser)
(set (make-local-variable 'notmuch-sexp--parser) (set (make-local-variable 'notmuch-sexp--parser)

69
emacs/notmuch-show.el
View file

@ -320,7 +320,6 @@ position of the message in the thread."
FN is called with one argument, the message properties. It should FN is called with one argument, the message properties. It should
operation on the contents of the current buffer." operation on the contents of the current buffer."
;; Remake the header to ensure that all information is available. ;; Remake the header to ensure that all information is available.
(let* ((to (notmuch-show-get-to)) (let* ((to (notmuch-show-get-to))
(cc (notmuch-show-get-cc)) (cc (notmuch-show-get-cc))
@ -329,7 +328,6 @@ operation on the contents of the current buffer."
(date (notmuch-show-get-date)) (date (notmuch-show-get-date))
(tags (notmuch-show-get-tags)) (tags (notmuch-show-get-tags))
(depth (notmuch-show-get-depth)) (depth (notmuch-show-get-depth))
(header (concat (header (concat
"Subject: " subject "\n" "Subject: " subject "\n"
"To: " to "\n" "To: " to "\n"
@ -375,7 +373,6 @@ operation on the contents of the current buffer."
'message-header-subject) 'message-header-subject)
(t (t
'message-header-other)))) 'message-header-other))))
(overlay-put (make-overlay (point) (re-search-forward ":")) (overlay-put (make-overlay (point) (re-search-forward ":"))
'face 'message-header-name) 'face 'message-header-name)
(overlay-put (make-overlay (point) (re-search-forward ".*$")) (overlay-put (make-overlay (point) (re-search-forward ".*$"))
@ -421,39 +418,30 @@ parsing fails."
((string-match "\\(.*\\) <\\(.*\\)>" address) ((string-match "\\(.*\\) <\\(.*\\)>" address)
(setq p-name (match-string 1 address) (setq p-name (match-string 1 address)
p-address (match-string 2 address))) p-address (match-string 2 address)))
;; "<user@dom.ain>" style. ;; "<user@dom.ain>" style.
((string-match "<\\(.*\\)>" address) ((string-match "<\\(.*\\)>" address)
(setq p-address (match-string 1 address))) (setq p-address (match-string 1 address)))
;; Everything else. ;; Everything else.
(t (t
(setq p-address address))) (setq p-address address)))
(when p-name (when p-name
;; Remove elements of the mailbox part that are not relevant for ;; Remove elements of the mailbox part that are not relevant for
;; display, even if they are required during transport: ;; display, even if they are required during transport:
;; ;;
;; Backslashes. ;; Backslashes.
(setq p-name (replace-regexp-in-string "\\\\" "" p-name)) (setq p-name (replace-regexp-in-string "\\\\" "" p-name))
;; Outer single and double quotes, which might be nested. ;; Outer single and double quotes, which might be nested.
(cl-loop with start-of-loop (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 ;; If the address is 'foo@bar.com <foo@bar.com>' then show just
;; 'foo@bar.com'. ;; 'foo@bar.com'.
(when (string= p-name p-address) (when (string= p-name p-address)
(setq p-name nil)) (setq p-name nil))
(cons p-address p-name)) (cons p-address p-name))
(error (cons address nil)))) (error (cons address nil))))
@ -523,7 +511,6 @@ message at DEPTH in the current thread."
(unless (string-equal declared-type content-type) (unless (string-equal declared-type content-type)
(concat " (as " content-type ")")) (concat " (as " content-type ")"))
comment))) comment)))
(setq button (setq button
(insert-button (insert-button
(concat "[ " base-label " ]") (concat "[ " base-label " ]")
@ -664,14 +651,12 @@ will return nil if the CID is unknown or cannot be retrieved."
(defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth button) (defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth button)
(let ((inner-parts (plist-get part :content)) (let ((inner-parts (plist-get part :content))
(start (point))) (start (point)))
;; Render the primary part. FIXME: Support RFC 2387 Start header. ;; Render the primary part. FIXME: Support RFC 2387 Start header.
(notmuch-show-insert-bodypart msg (car inner-parts) depth) (notmuch-show-insert-bodypart msg (car inner-parts) depth)
;; Add hidden buttons for the rest ;; Add hidden buttons for the rest
(mapc (lambda (inner-part) (mapc (lambda (inner-part)
(notmuch-show-insert-bodypart msg inner-part depth t)) (notmuch-show-insert-bodypart msg inner-part depth t))
(cdr inner-parts)) (cdr inner-parts))
(when notmuch-show-indent-multipart (when notmuch-show-indent-multipart
(indent-rigidly start (point) 1))) (indent-rigidly start (point) 1)))
t) t)
@ -679,18 +664,15 @@ will return nil if the CID is unknown or cannot be retrieved."
(defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth button) (defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth button)
(when button (when button
(button-put button 'face 'notmuch-crypto-part-header)) (button-put button 'face 'notmuch-crypto-part-header))
;; Insert a button detailing the signature status. ;; Insert a button detailing the signature status.
(notmuch-crypto-insert-sigstatus-button (car (plist-get part :sigstatus)) (notmuch-crypto-insert-sigstatus-button (car (plist-get part :sigstatus))
(notmuch-show-get-header :From msg)) (notmuch-show-get-header :From msg))
(let ((inner-parts (plist-get part :content)) (let ((inner-parts (plist-get part :content))
(start (point))) (start (point)))
;; Show all of the parts. ;; Show all of the parts.
(mapc (lambda (inner-part) (mapc (lambda (inner-part)
(notmuch-show-insert-bodypart msg inner-part depth)) (notmuch-show-insert-bodypart msg inner-part depth))
inner-parts) inner-parts)
(when notmuch-show-indent-multipart (when notmuch-show-indent-multipart
(indent-rigidly start (point) 1))) (indent-rigidly start (point) 1)))
t) t)
@ -698,21 +680,17 @@ will return nil if the CID is unknown or cannot be retrieved."
(defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth button) (defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth button)
(when button (when button
(button-put button 'face 'notmuch-crypto-part-header)) (button-put button 'face 'notmuch-crypto-part-header))
;; Insert a button detailing the encryption status. ;; Insert a button detailing the encryption status.
(notmuch-crypto-insert-encstatus-button (car (plist-get part :encstatus))) (notmuch-crypto-insert-encstatus-button (car (plist-get part :encstatus)))
;; Insert a button detailing the signature status. ;; Insert a button detailing the signature status.
(notmuch-crypto-insert-sigstatus-button (car (plist-get part :sigstatus)) (notmuch-crypto-insert-sigstatus-button (car (plist-get part :sigstatus))
(notmuch-show-get-header :From msg)) (notmuch-show-get-header :From msg))
(let ((inner-parts (plist-get part :content)) (let ((inner-parts (plist-get part :content))
(start (point))) (start (point)))
;; Show all of the parts. ;; Show all of the parts.
(mapc (lambda (inner-part) (mapc (lambda (inner-part)
(notmuch-show-insert-bodypart msg inner-part depth)) (notmuch-show-insert-bodypart msg inner-part depth))
inner-parts) inner-parts)
(when notmuch-show-indent-multipart (when notmuch-show-indent-multipart
(indent-rigidly start (point) 1))) (indent-rigidly start (point) 1)))
t) t)
@ -727,7 +705,6 @@ will return nil if the CID is unknown or cannot be retrieved."
(mapc (lambda (inner-part) (mapc (lambda (inner-part)
(notmuch-show-insert-bodypart msg inner-part depth)) (notmuch-show-insert-bodypart msg inner-part depth))
inner-parts) inner-parts)
(when notmuch-show-indent-multipart (when notmuch-show-indent-multipart
(indent-rigidly start (point) 1))) (indent-rigidly start (point) 1)))
t) t)
@ -736,19 +713,15 @@ will return nil if the CID is unknown or cannot be retrieved."
(let* ((message (car (plist-get part :content))) (let* ((message (car (plist-get part :content)))
(body (car (plist-get message :body))) (body (car (plist-get message :body)))
(start (point))) (start (point)))
;; Override `notmuch-message-headers' to force `From' to be ;; Override `notmuch-message-headers' to force `From' to be
;; displayed. ;; displayed.
(let ((notmuch-message-headers '("From" "Subject" "To" "Cc" "Date"))) (let ((notmuch-message-headers '("From" "Subject" "To" "Cc" "Date")))
(notmuch-show-insert-headers (plist-get message :headers))) (notmuch-show-insert-headers (plist-get message :headers)))
;; Blank line after headers to be compatible with the normal ;; Blank line after headers to be compatible with the normal
;; message display. ;; message display.
(insert "\n") (insert "\n")
;; Show the body ;; Show the body
(notmuch-show-insert-bodypart msg body depth) (notmuch-show-insert-bodypart msg body depth)
(when notmuch-show-indent-multipart (when notmuch-show-indent-multipart
(indent-rigidly start (point) 1))) (indent-rigidly start (point) 1)))
t) t)
@ -832,7 +805,6 @@ will return nil if the CID is unknown or cannot be retrieved."
;; It's easier to drive shr ourselves than to work around the ;; It's easier to drive shr ourselves than to work around the
;; goofy things `mm-shr' does (like irreversibly taking over ;; goofy things `mm-shr' does (like irreversibly taking over
;; content ID handling). ;; content ID handling).
;; FIXME: If we block an image, offer a button to load external ;; FIXME: If we block an image, offer a button to load external
;; images. ;; images.
(let ((shr-blocked-images notmuch-show-text/html-blocked-images)) (let ((shr-blocked-images notmuch-show-text/html-blocked-images))
@ -908,7 +880,6 @@ will return nil if the CID is unknown or cannot be retrieved."
(defun notmuch-show-create-part-overlays (button beg end) (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 ;; 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 ;; part) or if the part has no content then we don't make the part
;; toggleable. ;; toggleable.
@ -919,7 +890,6 @@ will return nil if the CID is unknown or cannot be retrieved."
(defun notmuch-show-record-part-information (part beg end) (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, ;; Record part information. Since we already inserted subparts,
;; don't override existing :notmuch-part properties. ;; don't override existing :notmuch-part properties.
(notmuch-map-text-property beg end :notmuch-part (notmuch-map-text-property beg end :notmuch-part
@ -1017,7 +987,6 @@ this part.")
HIDE determines whether to show or hide the part and 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 as follows: If HIDE is nil, show the part and the button. If HIDE
is t, hide the part initially and show the button." is t, hide the part initially and show the button."
(let* ((content-type (downcase (plist-get part :content-type))) (let* ((content-type (downcase (plist-get part :content-type)))
(mime-type (notmuch-show-mime-type part)) (mime-type (notmuch-show-mime-type part))
(nth (plist-get part :id)) (nth (plist-get part :id))
@ -1036,16 +1005,13 @@ is t, hide the part initially and show the button."
(show-part (not (or (equal hide t) (show-part (not (or (equal hide t)
(and long button)))) (and long button))))
(content-beg (point))) (content-beg (point)))
;; Store the computed mime-type for later use (e.g. by attachment handlers). ;; Store the computed mime-type for later use (e.g. by attachment handlers).
(plist-put part :computed-type mime-type) (plist-put part :computed-type mime-type)
(if show-part (if show-part
(notmuch-show-insert-bodypart-internal msg part mime-type nth depth button) (notmuch-show-insert-bodypart-internal msg part mime-type nth depth button)
(when button (when button
(button-put button :notmuch-lazy-part (button-put button :notmuch-lazy-part
(list msg part mime-type nth depth button)))) (list msg part mime-type nth depth button))))
;; Some of the body part handlers leave point somewhere up in the ;; Some of the body part handlers leave point somewhere up in the
;; part, so we make sure that we're down at the end. ;; part, so we make sure that we're down at the end.
(goto-char (point-max)) (goto-char (point-max))
@ -1062,12 +1028,10 @@ is t, hide the part initially and show the button."
(defun notmuch-show-insert-body (msg body depth) (defun notmuch-show-insert-body (msg body depth)
"Insert the body BODY at depth DEPTH in the current thread." "Insert the body BODY at depth DEPTH in the current thread."
;; Register all content IDs for this message. According to RFC ;; Register all content IDs for this message. According to RFC
;; 2392, content IDs are *global*, but it's okay if an MUA treats ;; 2392, content IDs are *global*, but it's okay if an MUA treats
;; them as only global within a message. ;; them as only global within a message.
(notmuch-show--register-cids msg (car body)) (notmuch-show--register-cids msg (car body))
(mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body)) (mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
(defun notmuch-show-make-symbol (type) (defun notmuch-show-make-symbol (type)
@ -1088,18 +1052,14 @@ is t, hide the part initially and show the button."
content-start content-end content-start content-end
headers-start headers-end headers-start headers-end
(bare-subject (notmuch-show-strip-re (plist-get headers :Subject)))) (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 (notmuch-show-insert-headerline headers
(or (if notmuch-show-relative-dates (or (if notmuch-show-relative-dates
(plist-get msg :date_relative) (plist-get msg :date_relative)
nil) nil)
(plist-get headers :Date)) (plist-get headers :Date))
(plist-get msg :tags) depth) (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 ;; Set `headers-start' to point after the 'Subject:' header to be
;; compatible with the existing implementation. This just sets it ;; compatible with the existing implementation. This just sets it
;; to after the first header. ;; to after the first header.
@ -1114,9 +1074,7 @@ is t, hide the part initially and show the button."
(forward-line 1)) (forward-line 1))
(setq headers-start (point-marker))) (setq headers-start (point-marker)))
(setq headers-end (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. ;; A blank line between the headers and the body.
(insert "\n") (insert "\n")
(notmuch-show-insert-body msg (plist-get msg :body) (notmuch-show-insert-body msg (plist-get msg :body)
@ -1125,36 +1083,28 @@ is t, hide the part initially and show the button."
(unless (bolp) (unless (bolp)
(insert "\n")) (insert "\n"))
(setq content-end (point-marker)) (setq content-end (point-marker))
;; Indent according to the depth in the thread. ;; Indent according to the depth in the thread.
(if notmuch-show-indent-content (if notmuch-show-indent-content
(indent-rigidly content-start (indent-rigidly content-start
content-end content-end
(* notmuch-show-indent-messages-width depth))) (* 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 ;; Save the extents of this message over the whole text of the
;; message. ;; message.
(put-text-property message-start message-end (put-text-property message-start message-end
:notmuch-message-extent :notmuch-message-extent
(cons message-start message-end)) (cons message-start message-end))
;; Create overlays used to control visibility ;; Create overlays used to control visibility
(plist-put msg :headers-overlay (make-overlay headers-start headers-end)) (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 :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 ;; Save the properties for this message. Currently this saves the
;; entire message (augmented it with other stuff), which seems ;; entire message (augmented it with other stuff), which seems
;; like overkill. We might save a reduced subset (for example, not ;; like overkill. We might save a reduced subset (for example, not
;; the content). ;; the content).
(notmuch-show-set-message-properties msg) (notmuch-show-set-message-properties msg)
;; Set header visibility. ;; Set header visibility.
(notmuch-show-headers-visible msg notmuch-message-headers-visible) (notmuch-show-headers-visible msg notmuch-message-headers-visible)
;; Message visibility depends on whether it matched the search ;; Message visibility depends on whether it matched the search
;; criteria. ;; criteria.
(notmuch-show-message-visible msg (and (plist-get msg :match) (notmuch-show-message-visible msg (and (plist-get msg :match)
@ -1302,9 +1252,7 @@ matched."
(switch-to-buffer (get-buffer-create buffer-name)) (switch-to-buffer (get-buffer-create buffer-name))
;; No need to track undo information for this buffer. ;; No need to track undo information for this buffer.
(setq buffer-undo-list t) (setq buffer-undo-list t)
(notmuch-show-mode) (notmuch-show-mode)
;; Set various buffer local variables to their appropriate initial ;; Set various buffer local variables to their appropriate initial
;; state. Do this after enabling `notmuch-show-mode' so that they ;; state. Do this after enabling `notmuch-show-mode' so that they
;; aren't wiped out. ;; aren't wiped out.
@ -1313,24 +1261,19 @@ matched."
notmuch-show-query-context (if (or (string= query-context "") notmuch-show-query-context (if (or (string= query-context "")
(string= query-context "*")) (string= query-context "*"))
nil query-context) nil query-context)
notmuch-show-process-crypto notmuch-crypto-process-mime notmuch-show-process-crypto notmuch-crypto-process-mime
;; If `elide-toggle', invert the default value. ;; If `elide-toggle', invert the default value.
notmuch-show-elide-non-matching-messages notmuch-show-elide-non-matching-messages
(if elide-toggle (if elide-toggle
(not notmuch-show-only-matching-messages) (not notmuch-show-only-matching-messages)
notmuch-show-only-matching-messages)) notmuch-show-only-matching-messages))
(add-hook 'post-command-hook #'notmuch-show-command-hook nil t) (add-hook 'post-command-hook #'notmuch-show-command-hook nil t)
(jit-lock-register #'notmuch-show-buttonise-links) (jit-lock-register #'notmuch-show-buttonise-links)
(notmuch-tag-clear-cache) (notmuch-tag-clear-cache)
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(if (notmuch-show--build-buffer) (if (notmuch-show--build-buffer)
;; Messages were inserted into the buffer. ;; Messages were inserted into the buffer.
(current-buffer) (current-buffer)
;; No messages were inserted - presumably none matched the ;; No messages were inserted - presumably none matched the
;; query. ;; query.
(kill-buffer (current-buffer)) (kill-buffer (current-buffer))
@ -1373,26 +1316,21 @@ If no messages match the query return NIL."
(setq queries (cdr queries))) (setq queries (cdr queries)))
(when forest (when forest
(notmuch-show-insert-forest forest) (notmuch-show-insert-forest forest)
;; Store the original tags for each message so that we can ;; Store the original tags for each message so that we can
;; display changes. ;; display changes.
(notmuch-show-mapc (notmuch-show-mapc
(lambda () (notmuch-show-set-prop :orig-tags (notmuch-show-get-tags)))) (lambda () (notmuch-show-set-prop :orig-tags (notmuch-show-get-tags))))
;; Set the header line to the subject of the first message. ;; Set the header line to the subject of the first message.
(setq header-line-format (setq header-line-format
(replace-regexp-in-string "%" "%%" (replace-regexp-in-string "%" "%%"
(notmuch-sanitize (notmuch-sanitize
(notmuch-show-strip-re (notmuch-show-strip-re
(notmuch-show-get-subject))))) (notmuch-show-get-subject)))))
(run-hooks 'notmuch-show-hook) (run-hooks 'notmuch-show-hook)
(if state (if state
(notmuch-show-apply-state state) (notmuch-show-apply-state state)
;; With no state to apply, just go to the first message. ;; With no state to apply, just go to the first message.
(notmuch-show-goto-first-wanted-message))) (notmuch-show-goto-first-wanted-message)))
;; Report back to the caller whether any messages matched. ;; Report back to the caller whether any messages matched.
forest)) forest))
@ -1437,14 +1375,12 @@ This includes:
- moving to the correct current message in every displayed window." - moving to the correct current message in every displayed window."
(let ((win-msg-alist (car state)) (let ((win-msg-alist (car state))
(open (cadr state))) (open (cadr state)))
;; Open those that were open. ;; Open those that were open.
(goto-char (point-min)) (goto-char (point-min))
(cl-loop do (notmuch-show-message-visible (cl-loop do (notmuch-show-message-visible
(notmuch-show-get-message-properties) (notmuch-show-get-message-properties)
(member (notmuch-show-get-message-id) open)) (member (notmuch-show-get-message-id) open))
until (not (notmuch-show-goto-message-next))) until (not (notmuch-show-goto-message-next)))
(dolist (win-msg-pair win-msg-alist) (dolist (win-msg-pair win-msg-alist)
(with-selected-window (car win-msg-pair) (with-selected-window (car win-msg-pair)
;; Go to the previously open message in this window ;; Go to the previously open message in this window
@ -1466,7 +1402,6 @@ reset based on the original query."
;; manually. ;; manually.
(remove-overlays) (remove-overlays)
(erase-buffer) (erase-buffer)
(unless (notmuch-show--build-buffer state) (unless (notmuch-show--build-buffer state)
;; No messages were inserted. ;; No messages were inserted.
(kill-buffer (current-buffer)) (kill-buffer (current-buffer))
@ -1887,16 +1822,13 @@ current window), advance to the next open message."
(> visible-end-of-this-message (window-end))) (> visible-end-of-this-message (window-end)))
;; The bottom of this message is not visible - scroll. ;; The bottom of this message is not visible - scroll.
(scroll-up nil)) (scroll-up nil))
((not (= end-of-this-message (point-max))) ((not (= end-of-this-message (point-max)))
;; This is not the last message - move to the next visible one. ;; This is not the last message - move to the next visible one.
(notmuch-show-next-open-message)) (notmuch-show-next-open-message))
((not (= (point) (point-max))) ((not (= (point) (point-max)))
;; This is the last message, but the cursor is not at the end of ;; This is the last message, but the cursor is not at the end of
;; the buffer. Move it there. ;; the buffer. Move it there.
(goto-char (point-max))) (goto-char (point-max)))
(t (t
;; This is the last message - change the return value ;; This is the last message - change the return value
(setq ret t))) (setq ret t)))
@ -2533,7 +2465,6 @@ part to be treated as if it had that mime-type."
(interactive) (interactive)
(notmuch-show-apply-to-current-part-handle #'mm-pipe-part)) (notmuch-show-apply-to-current-part-handle #'mm-pipe-part))
(defun notmuch-show--mm-display-part (handle) (defun notmuch-show--mm-display-part (handle)
"Use mm-display-part to display HANDLE in a new buffer. "Use mm-display-part to display HANDLE in a new buffer.

3
emacs/notmuch-tag.el
View file

@ -331,7 +331,6 @@ changed (the normal case) are shown using formats from
(otherwise nil)))) (otherwise nil))))
(setq formatted-tag (notmuch-tag--do-format tag tag base)) (setq formatted-tag (notmuch-tag--do-format tag tag base))
(setq formatted-tag (notmuch-tag--do-format tag formatted-tag over)) (setq formatted-tag (notmuch-tag--do-format tag formatted-tag over))
(puthash (cons tag tag-state) formatted-tag notmuch-tag--format-cache))) (puthash (cons tag tag-state) formatted-tag notmuch-tag--format-cache)))
formatted-tag)) formatted-tag))
@ -356,7 +355,6 @@ changed (the normal case) are shown using formats from
a list of strings of the form \"+TAG\" or \"-TAG\". a list of strings of the form \"+TAG\" or \"-TAG\".
'query' will be a string containing the search query that determines 'query' will be a string containing the search query that determines
the messages that are about to be tagged." the messages that are about to be tagged."
:type 'hook :type 'hook
:options '(notmuch-hl-line-mode) :options '(notmuch-hl-line-mode)
:group 'notmuch-hooks) :group 'notmuch-hooks)
@ -406,7 +404,6 @@ completions. CURRENT-TAGS may contain duplicates. PROMPT, if
non-nil, is the query string to present in the minibuffer. It non-nil, is the query string to present in the minibuffer. It
defaults to \"Tags\". INITIAL-INPUT, if non-nil, will be the defaults to \"Tags\". INITIAL-INPUT, if non-nil, will be the
initial input in the minibuffer." initial input in the minibuffer."
(let* ((all-tag-list (notmuch-tag-completions)) (let* ((all-tag-list (notmuch-tag-completions))
(add-tag-list (mapcar (apply-partially 'concat "+") all-tag-list)) (add-tag-list (mapcar (apply-partially 'concat "+") all-tag-list))
(remove-tag-list (mapcar (apply-partially 'concat "-") current-tags)) (remove-tag-list (mapcar (apply-partially 'concat "-") current-tags))

9
emacs/notmuch-tree.el
View file

@ -891,7 +891,6 @@ A message tree is another name for a single sub-thread: i.e., a
message together with all its descendents." message together with all its descendents."
(let ((msg (car tree)) (let ((msg (car tree))
(replies (cadr tree))) (replies (cadr tree)))
(cond (cond
((and (< 0 depth) (not last)) ((and (< 0 depth) (not last))
(push "├" tree-status)) (push "├" tree-status))
@ -907,7 +906,6 @@ message together with all its descendents."
(push "╰" tree-status)) (push "╰" tree-status))
((and (eq 0 depth) (not first) (not last)) ((and (eq 0 depth) (not first) (not last))
(push "├" tree-status))) (push "├" tree-status)))
(push (concat (if replies "┬" "─") "►") tree-status) (push (concat (if replies "┬" "─") "►") tree-status)
(setq msg (plist-put msg :first (and first (eq 0 depth)))) (setq msg (plist-put msg :first (and first (eq 0 depth))))
(setq msg (plist-put msg :tree-status tree-status)) (setq msg (plist-put msg :tree-status tree-status))
@ -915,11 +913,9 @@ message together with all its descendents."
(notmuch-tree-goto-and-insert-msg msg) (notmuch-tree-goto-and-insert-msg msg)
(pop tree-status) (pop tree-status)
(pop tree-status) (pop tree-status)
(if last (if last
(push " " tree-status) (push " " tree-status)
(push "│" tree-status)) (push "│" tree-status))
(notmuch-tree-insert-thread replies (1+ depth) tree-status))) (notmuch-tree-insert-thread replies (1+ depth) tree-status)))
(defun notmuch-tree-insert-thread (thread depth tree-status) (defun notmuch-tree-insert-thread (thread depth tree-status)
@ -958,7 +954,6 @@ Pressing \\[notmuch-tree-show-message] on any line displays that message.
Complete list of currently available key bindings: Complete list of currently available key bindings:
\\{notmuch-tree-mode-map}" \\{notmuch-tree-mode-map}"
(setq notmuch-buffer-refresh-function #'notmuch-tree-refresh-view) (setq notmuch-buffer-refresh-function #'notmuch-tree-refresh-view)
(hl-line-mode 1) (hl-line-mode 1)
(setq buffer-read-only t (setq buffer-read-only t
@ -1022,7 +1017,6 @@ the same as for the function notmuch-tree."
;; (such as reply) do. It is a buffer local variable so setting it ;; (such as reply) do. It is a buffer local variable so setting it
;; will not affect genuine show buffers. ;; will not affect genuine show buffers.
(setq notmuch-show-process-crypto notmuch-crypto-process-mime) (setq notmuch-show-process-crypto notmuch-crypto-process-mime)
(erase-buffer) (erase-buffer)
(goto-char (point-min)) (goto-char (point-min))
(let* ((search-args (concat basic-query (let* ((search-args (concat basic-query
@ -1079,13 +1073,10 @@ The arguments are:
(if unthreaded "unthreaded-" "tree-") (if unthreaded "unthreaded-" "tree-")
query "*"))))) query "*")))))
(inhibit-read-only t)) (inhibit-read-only t))
(switch-to-buffer buffer)) (switch-to-buffer buffer))
;; Don't track undo information for this buffer ;; Don't track undo information for this buffer
(set 'buffer-undo-list t) (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)) (setq truncate-lines t))
(defun notmuch-unthreaded (&optional query query-context target buffer-name open-target) (defun notmuch-unthreaded (&optional query query-context target buffer-name open-target)

18
emacs/notmuch-wash.el
View file

@ -203,12 +203,10 @@ BEG and END are buffer locations. TYPE should a string, either
\"citation\" or \"signature\". Optional PREFIX is some arbitrary \"citation\" or \"signature\". Optional PREFIX is some arbitrary
text to insert before the button, probably for indentation. Note text to insert before the button, probably for indentation. Note
that PREFIX should not include a newline." that PREFIX should not include a newline."
;; This uses some slightly tricky conversions between strings and ;; This uses some slightly tricky conversions between strings and
;; symbols because of the way the button code works. Note that ;; symbols because of the way the button code works. Note that
;; replacing intern-soft with make-symbol will cause this to fail, ;; replacing intern-soft with make-symbol will cause this to fail,
;; since the newly created symbol has no plist. ;; since the newly created symbol has no plist.
(let ((overlay (make-overlay beg end)) (let ((overlay (make-overlay beg end))
(button-type (intern-soft (concat "notmuch-wash-button-" (button-type (intern-soft (concat "notmuch-wash-button-"
type "-toggle-type")))) type "-toggle-type"))))
@ -276,25 +274,20 @@ that PREFIX should not include a newline."
(defun notmuch-wash-elide-blank-lines (msg depth) (defun notmuch-wash-elide-blank-lines (msg depth)
"Elide leading, trailing and successive blank lines." "Elide leading, trailing and successive blank lines."
;; Algorithm derived from `article-strip-multiple-blank-lines' in ;; Algorithm derived from `article-strip-multiple-blank-lines' in
;; `gnus-art.el'. ;; `gnus-art.el'.
;; Make all blank lines empty. ;; Make all blank lines empty.
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "^[[:space:]\t]+$" nil t) (while (re-search-forward "^[[:space:]\t]+$" nil t)
(replace-match "" nil t)) (replace-match "" nil t))
;; Replace multiple empty lines with a single empty line. ;; Replace multiple empty lines with a single empty line.
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "^\n\\(\n+\\)" nil t) (while (re-search-forward "^\n\\(\n+\\)" nil t)
(delete-region (match-beginning 1) (match-end 1))) (delete-region (match-beginning 1) (match-end 1)))
;; Remove a leading blank line. ;; Remove a leading blank line.
(goto-char (point-min)) (goto-char (point-min))
(if (looking-at "\n") (if (looking-at "\n")
(delete-region (match-beginning 0) (match-end 0))) (delete-region (match-beginning 0) (match-end 0)))
;; Remove a trailing blank line. ;; Remove a trailing blank line.
(goto-char (point-max)) (goto-char (point-max))
(if (looking-at "\n") (if (looking-at "\n")
@ -313,20 +306,15 @@ Perform several transformations on the message body:
text, text,
- Remove citation trailers standing alone after a block of cited - Remove citation trailers standing alone after a block of cited
text." text."
;; Remove lines of repeated citation leaders with no other content. ;; Remove lines of repeated citation leaders with no other content.
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "\\(^>[> ]*\n\\)\\{2,\\}" nil t) (while (re-search-forward "\\(^>[> ]*\n\\)\\{2,\\}" nil t)
(replace-match "\\1")) (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)) (goto-char (point-min))
(while (re-search-forward "\\(\n\\|^[^>].*\\)\n\\(^>[> ]*\n\\)" nil t) (while (re-search-forward "\\(\n\\|^[^>].*\\)\n\\(^>[> ]*\n\\)" nil t)
(replace-match "\\1\n")) (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)) (goto-char (point-min))
(while (re-search-forward "\\(^>[> ]*\n\\)\\(^$\\|^[^>].*\\)" nil t) (while (re-search-forward "\\(^>[> ]*\n\\)\\(^$\\|^[^>].*\\)" nil t)
(replace-match "\\2"))) (replace-match "\\2")))
@ -341,7 +329,6 @@ the message lines to the minimum of the width of the window or
its value. Otherwise, this function will wrap long lines in the its value. Otherwise, this function will wrap long lines in the
message at the window width. When doing so, citation leaders in message at the window width. When doing so, citation leaders in
the wrapped text are maintained." the wrapped text are maintained."
(let* ((coolj-wrap-follows-window-size nil) (let* ((coolj-wrap-follows-window-size nil)
(indent (* depth notmuch-show-indent-messages-width)) (indent (* depth notmuch-show-indent-messages-width))
(limit (if (numberp notmuch-wash-wrap-lines-length) (limit (if (numberp notmuch-wash-wrap-lines-length)
@ -405,7 +392,6 @@ original filename the sender had."
Given that this function guesses whether a buffer includes a Given that this function guesses whether a buffer includes a
patch and then guesses the extent of the patch, there is scope patch and then guesses the extent of the patch, there is scope
for error." for error."
(goto-char (point-min)) (goto-char (point-min))
(when (re-search-forward diff-file-header-re nil t) (when (re-search-forward diff-file-header-re nil t)
(beginning-of-line -1) (beginning-of-line -1)

7
emacs/notmuch.el
View file

@ -755,7 +755,6 @@ non-authors is found, assume that all of the authors match."
(visible-string formatted-authors) (visible-string formatted-authors)
(invisible-string "") (invisible-string "")
(padding "")) (padding ""))
;; Truncate the author string to fit the specification. ;; Truncate the author string to fit the specification.
(if (> (length formatted-authors) (if (> (length formatted-authors)
(length formatted-sample)) (length formatted-sample))
@ -782,7 +781,6 @@ non-authors is found, assume that all of the authors match."
(length visible-string) (length visible-string)
(length "...")) (length "..."))
? )))) ? ))))
;; Use different faces to show matching and non-matching authors. ;; Use different faces to show matching and non-matching authors.
(if (string-match "\\(.*\\)|\\(.*\\)" visible-string) (if (string-match "\\(.*\\)|\\(.*\\)" visible-string)
;; The visible string contains both matching and ;; The visible string contains both matching and
@ -798,14 +796,12 @@ non-authors is found, assume that all of the authors match."
;; The invisible string may contain both matching and ;; The invisible string may contain both matching and
;; non-matching authors. ;; non-matching authors.
invisible-string (notmuch-search-author-propertize invisible-string))) invisible-string (notmuch-search-author-propertize invisible-string)))
;; If there is any invisible text, add it as a tooltip to the ;; If there is any invisible text, add it as a tooltip to the
;; visible text. ;; visible text.
(when (not (string= invisible-string "")) (when (not (string= invisible-string ""))
(setq visible-string (setq visible-string
(propertize visible-string (propertize visible-string
'help-echo (concat "..." invisible-string)))) 'help-echo (concat "..." invisible-string))))
;; Insert the visible and, if present, invisible author strings. ;; Insert the visible and, if present, invisible author strings.
(insert visible-string) (insert visible-string)
(when (not (string= invisible-string "")) (when (not (string= invisible-string ""))
@ -831,11 +827,9 @@ non-authors is found, assume that all of the authors match."
(insert (propertize (format format-string (insert (propertize (format format-string
(notmuch-sanitize (plist-get result :subject))) (notmuch-sanitize (plist-get result :subject)))
'face 'notmuch-search-subject))) 'face 'notmuch-search-subject)))
((string-equal field "authors") ((string-equal field "authors")
(notmuch-search-insert-authors (notmuch-search-insert-authors
format-string (notmuch-sanitize (plist-get result :authors)))) format-string (notmuch-sanitize (plist-get result :authors))))
((string-equal field "tags") ((string-equal field "tags")
(let ((tags (plist-get result :tags)) (let ((tags (plist-get result :tags))
(orig-tags (plist-get result :orig-tags))) (orig-tags (plist-get result :orig-tags)))
@ -1118,7 +1112,6 @@ current search results AND that are tagged with the given tag."
If the current buffer is the only notmuch buffer, bury it. If no If the current buffer is the only notmuch buffer, bury it. If no
notmuch buffers exist, run `notmuch'." notmuch buffers exist, run `notmuch'."
(interactive) (interactive)
(let (start first) (let (start first)
;; If the current buffer is a notmuch buffer, remember it and then ;; If the current buffer is a notmuch buffer, remember it and then
;; bury it. ;; bury it.