mirror of
https://git.notmuchmail.org/git/notmuch
synced 2024-11-22 02:48:08 +01:00
emacs: various cosmetic improvements
This commit is contained in:
Jonas Bernoulli
David Bremner
parent
1bbbde4a0c
commit
16b2db0986
9 changed files with 125 additions and 148 deletions
|
|
@ -21,6 +21,8 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
(require 'message)
|
||||
(require 'notmuch-parser)
|
||||
(require 'notmuch-lib)
|
||||
|
|
@ -160,15 +162,12 @@ matching `notmuch-address-completion-headers-regexp'."
|
|||
(message "calling notmuch-address-message-insinuate is no longer needed"))
|
||||
|
||||
(defun notmuch-address-setup ()
|
||||
(let* ((setup-company (and notmuch-address-use-company
|
||||
(require 'company nil t)))
|
||||
(pair (cons notmuch-address-completion-headers-regexp
|
||||
#'notmuch-address-expand-name)))
|
||||
(when setup-company
|
||||
(when (and notmuch-address-use-company
|
||||
(require 'company nil t))
|
||||
(notmuch-company-setup))
|
||||
(unless (member pair message-completion-alist)
|
||||
(setq message-completion-alist
|
||||
(push pair message-completion-alist)))))
|
||||
(cl-pushnew (cons notmuch-address-completion-headers-regexp
|
||||
#'notmuch-address-expand-name)
|
||||
message-completion-alist :test #'equal))
|
||||
|
||||
(defun notmuch-address-toggle-internal-completion ()
|
||||
"Toggle use of internal completion for current buffer.
|
||||
|
|
@ -264,9 +263,6 @@ requiring external commands."
|
|||
(let ((name-addr (plist-get result :name-addr)))
|
||||
(puthash name-addr t notmuch-address-completions)))
|
||||
|
||||
(defun notmuch-address-harvest-handle-result (obj)
|
||||
(notmuch-address-harvest-addr obj))
|
||||
|
||||
(defun notmuch-address-harvest-filter (proc string)
|
||||
(when (buffer-live-p (process-buffer proc))
|
||||
(with-current-buffer (process-buffer proc)
|
||||
|
|
@ -274,7 +270,7 @@ requiring external commands."
|
|||
(goto-char (point-max))
|
||||
(insert string))
|
||||
(notmuch-sexp-parse-partial-list
|
||||
'notmuch-address-harvest-handle-result (process-buffer proc)))))
|
||||
'notmuch-address-harvest-addr (process-buffer proc)))))
|
||||
|
||||
(defvar notmuch-address-harvest-procs '(nil . nil)
|
||||
"The currently running harvests.
|
||||
|
|
|
|||
|
|
@ -432,8 +432,7 @@ supported for \"Customized queries section\" items."
|
|||
;; If an existing saved search with this name exists, remove it.
|
||||
(setq notmuch-saved-searches
|
||||
(cl-loop for elem in notmuch-saved-searches
|
||||
if (not (equal name
|
||||
(notmuch-saved-search-get elem :name)))
|
||||
unless (equal name (notmuch-saved-search-get elem :name))
|
||||
collect elem))
|
||||
;; Add the new one.
|
||||
(customize-save-variable 'notmuch-saved-searches
|
||||
|
|
@ -481,18 +480,14 @@ diagonal."
|
|||
append (notmuch-hello-reflect-generate-row ncols nrows row list))))
|
||||
|
||||
(defun notmuch-hello-widget-search (widget &rest _ignore)
|
||||
(cond
|
||||
((eq (widget-get widget :notmuch-search-type) 'tree)
|
||||
(notmuch-tree (widget-get widget
|
||||
:notmuch-search-terms)))
|
||||
((eq (widget-get widget :notmuch-search-type) 'unthreaded)
|
||||
(notmuch-unthreaded (widget-get widget
|
||||
:notmuch-search-terms)))
|
||||
(cl-case (widget-get widget :notmuch-search-type)
|
||||
(tree
|
||||
(notmuch-tree (widget-get widget :notmuch-search-terms)))
|
||||
(unthreaded
|
||||
(notmuch-unthreaded (widget-get widget :notmuch-search-terms)))
|
||||
(t
|
||||
(notmuch-search (widget-get widget
|
||||
:notmuch-search-terms)
|
||||
(widget-get widget
|
||||
:notmuch-search-oldest-first)))))
|
||||
(notmuch-search (widget-get widget :notmuch-search-terms)
|
||||
(widget-get widget :notmuch-search-oldest-first)))))
|
||||
|
||||
(defun notmuch-saved-search-count (search)
|
||||
(car (process-lines notmuch-command "count" search)))
|
||||
|
|
@ -823,8 +818,7 @@ Complete list of currently available key bindings:
|
|||
;; instead of a space to make `show-trailing-whitespace'
|
||||
;; happy, i.e. avoid it marking the whole line as trailing
|
||||
;; spaces.
|
||||
(widget-insert ".")
|
||||
(put-text-property (1- (point)) (point) 'invisible t)
|
||||
(widget-insert (propertize "." 'invisible t))
|
||||
(widget-insert "\n"))
|
||||
|
||||
(defun notmuch-hello-insert-recent-searches ()
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ fast way to jump to a saved search from anywhere in Notmuch."
|
|||
(setq action-map (nreverse action-map))
|
||||
(if action-map
|
||||
(notmuch-jump action-map "Search: ")
|
||||
(error "To use notmuch-jump, \
|
||||
please customize shortcut keys in notmuch-saved-searches."))))
|
||||
(error "To use notmuch-jump, %s"
|
||||
"please customize shortcut keys in notmuch-saved-searches."))))
|
||||
|
||||
(defvar notmuch-jump--action nil)
|
||||
|
||||
|
|
|
|||
|
|
@ -192,7 +192,7 @@ will be signaled.
|
|||
|
||||
Otherwise the output will be returned."
|
||||
(with-temp-buffer
|
||||
(let* ((status (apply #'call-process notmuch-command nil t nil args))
|
||||
(let ((status (apply #'call-process notmuch-command nil t nil args))
|
||||
(output (buffer-string)))
|
||||
(notmuch-check-exit-status status (cons notmuch-command args) output)
|
||||
output)))
|
||||
|
|
@ -248,7 +248,8 @@ displays both values separately."
|
|||
(len (length val)))
|
||||
;; Trim off the trailing newline (if the value is empty or not
|
||||
;; configured, there will be no newline)
|
||||
(if (and (> len 0) (= (aref val (- len 1)) ?\n))
|
||||
(if (and (> len 0)
|
||||
(= (aref val (- len 1)) ?\n))
|
||||
(substring val 0 -1)
|
||||
val)))
|
||||
|
||||
|
|
@ -538,13 +539,12 @@ This replaces spaces, percents, and double quotes in STR with
|
|||
;;; Generic Utilities
|
||||
|
||||
(defun notmuch-plist-delete (plist property)
|
||||
(let* ((xplist (cons nil plist))
|
||||
(pred xplist))
|
||||
(while (cdr pred)
|
||||
(when (eq (cadr pred) property)
|
||||
(setcdr pred (cdddr pred)))
|
||||
(setq pred (cddr pred)))
|
||||
(cdr xplist)))
|
||||
(let (p)
|
||||
(while plist
|
||||
(unless (eq property (car plist))
|
||||
(setq p (plist-put p (car plist) (cadr plist))))
|
||||
(setq plist (cddr plist)))
|
||||
p))
|
||||
|
||||
;;; MML Utilities
|
||||
|
||||
|
|
@ -555,8 +555,10 @@ This replaces spaces, percents, and double quotes in STR with
|
|||
(if (or (string= (cadr st1) "*")
|
||||
(string= (cadr st2) "*"))
|
||||
;; Comparison of content types should be case insensitive.
|
||||
(string= (downcase (car st1)) (downcase (car st2)))
|
||||
(string= (downcase t1) (downcase t2)))))
|
||||
(string= (downcase (car st1))
|
||||
(downcase (car st2)))
|
||||
(string= (downcase t1)
|
||||
(downcase t2)))))
|
||||
|
||||
(defvar notmuch-multipart/alternative-discouraged
|
||||
'(;; Avoid HTML parts.
|
||||
|
|
|
|||
|
|
@ -107,15 +107,12 @@ by notmuch-mua-mail."
|
|||
;; Old style - no longer works.
|
||||
(error "Invalid `notmuch-fcc-dirs' setting (old style)"))
|
||||
((listp notmuch-fcc-dirs)
|
||||
(let* ((from (message-field-value "From"))
|
||||
(match
|
||||
(catch 'first-match
|
||||
(dolist (re-folder notmuch-fcc-dirs)
|
||||
(when (string-match-p (car re-folder) from)
|
||||
(throw 'first-match re-folder))))))
|
||||
(if match
|
||||
(cdr match)
|
||||
(message "No Fcc header added.")
|
||||
(or (seq-some (let ((from (message-field-value "From")))
|
||||
(pcase-lambda (`(,regexp . ,folder))
|
||||
(and (string-match-p regexp from)
|
||||
folder)))
|
||||
notmuch-fcc-dirs)
|
||||
(progn (message "No Fcc header added.")
|
||||
nil)))
|
||||
(t
|
||||
(error "Invalid `notmuch-fcc-dirs' setting (neither string nor list)")))))
|
||||
|
|
@ -128,9 +125,9 @@ by notmuch-mua-mail."
|
|||
;; 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.
|
||||
Insert header anyway? " subdir)))
|
||||
(y-or-n-p (format "Fcc header %s is an absolute path %s %s" subdir
|
||||
"and notmuch insert is requested."
|
||||
"Insert header anyway? ")))
|
||||
(message-add-header (concat "Fcc: " subdir))))
|
||||
|
||||
(defun notmuch-maildir-add-file-style-fcc-header (subdir)
|
||||
|
|
@ -173,7 +170,7 @@ This is taken from the function message-do-fcc."
|
|||
"Process Fcc headers in the current buffer.
|
||||
|
||||
This is a rearranged version of message mode's message-do-fcc."
|
||||
(let (list file)
|
||||
(let (files file)
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(message-narrow-to-headers)
|
||||
|
|
@ -183,13 +180,11 @@ This is a rearranged version of message mode's message-do-fcc."
|
|||
(save-restriction
|
||||
(message-narrow-to-headers)
|
||||
(while (setq file (message-fetch-field "fcc" t))
|
||||
(push file list)
|
||||
(push file files)
|
||||
(message-remove-header "fcc" nil t)))
|
||||
(notmuch-maildir-setup-message-for-saving)
|
||||
;; Process FCC operations.
|
||||
(while list
|
||||
(setq file (pop list))
|
||||
(notmuch-fcc-handler file))
|
||||
(mapc #'notmuch-fcc-handler files)
|
||||
(kill-buffer (current-buffer)))))))
|
||||
|
||||
(defun notmuch-fcc-handler (fcc-header)
|
||||
|
|
@ -201,7 +196,8 @@ normal fcc."
|
|||
(message "Doing Fcc...")
|
||||
(if notmuch-maildir-use-notmuch-insert
|
||||
(notmuch-maildir-fcc-with-notmuch-insert fcc-header)
|
||||
(notmuch-maildir-fcc-file-fcc fcc-header)))
|
||||
(notmuch-maildir-fcc-file-fcc fcc-header))
|
||||
(message "Doing Fcc...done"))
|
||||
|
||||
;;; Functions for saving a message using notmuch insert.
|
||||
|
||||
|
|
@ -230,9 +226,8 @@ quoting each space with an immediately preceding backslash
|
|||
or surrounding the entire folder name in double quotes.
|
||||
|
||||
If CREATE is non-nil then create the folder if necessary."
|
||||
(let* ((args (split-string-and-unquote fcc-header))
|
||||
(folder (car args))
|
||||
(tags (cdr args)))
|
||||
(pcase-let ((`(,folder . ,tags)
|
||||
(split-string-and-unquote fcc-header)))
|
||||
(condition-case nil
|
||||
(notmuch-maildir-notmuch-insert-current-buffer folder create tags)
|
||||
;; Since there are many reasons notmuch insert could fail, e.g.,
|
||||
|
|
@ -265,7 +260,7 @@ If CREATE is non-nil then create the folder if necessary."
|
|||
(let* ((ftime (float-time))
|
||||
(microseconds (mod (* 1000000 ftime) 1000000))
|
||||
(hostname (notmuch-maildir-fcc-host-fixer (system-name))))
|
||||
(setq notmuch-maildir-fcc-count (+ notmuch-maildir-fcc-count 1))
|
||||
(cl-incf notmuch-maildir-fcc-count)
|
||||
(format "%d.%d_%d_%d.%s"
|
||||
ftime
|
||||
(emacs-pid)
|
||||
|
|
@ -298,9 +293,7 @@ if successful, nil if not."
|
|||
(write-file (concat destdir "/tmp/" msg-id))
|
||||
msg-id)
|
||||
(t
|
||||
(error (format "Can't write to %s. Not a maildir."
|
||||
destdir))
|
||||
nil))))
|
||||
(error "Can't write to %s. Not a maildir." destdir)))))
|
||||
|
||||
(defun notmuch-maildir-fcc-move-tmp-to-new (destdir msg-id)
|
||||
(add-name-to-file
|
||||
|
|
@ -345,16 +338,12 @@ return t if successful, and nil otherwise."
|
|||
(catch 'link-error
|
||||
(let ((msg-id (notmuch-maildir-fcc-save-buffer-to-tmp destdir)))
|
||||
(when msg-id
|
||||
(cond (mark-seen
|
||||
(condition-case nil
|
||||
(if mark-seen
|
||||
(notmuch-maildir-fcc-move-tmp-to-cur destdir msg-id t)
|
||||
(notmuch-maildir-fcc-move-tmp-to-new destdir msg-id))
|
||||
(file-already-exists
|
||||
(throw 'link-error nil))))
|
||||
(t
|
||||
(condition-case nil
|
||||
(notmuch-maildir-fcc-move-tmp-to-new destdir msg-id)
|
||||
(file-already-exists
|
||||
(throw 'link-error nil))))))
|
||||
(delete-file (concat destdir "/tmp/" msg-id))))
|
||||
t)))
|
||||
|
||||
|
|
|
|||
|
|
@ -179,13 +179,11 @@ Typically this is added to `notmuch-mua-send-hook'."
|
|||
|
||||
(defun notmuch-mua-get-switch-function ()
|
||||
"Get a switch function according to `notmuch-mua-compose-in'."
|
||||
(cond ((eq notmuch-mua-compose-in 'current-window)
|
||||
'switch-to-buffer)
|
||||
((eq notmuch-mua-compose-in 'new-window)
|
||||
'switch-to-buffer-other-window)
|
||||
((eq notmuch-mua-compose-in 'new-frame)
|
||||
'switch-to-buffer-other-frame)
|
||||
(t (error "Invalid value for `notmuch-mua-compose-in'"))))
|
||||
(pcase notmuch-mua-compose-in
|
||||
('current-window 'switch-to-buffer)
|
||||
('new-window 'switch-to-buffer-other-window)
|
||||
('new-frame 'switch-to-buffer-other-frame)
|
||||
(_ (error "Invalid value for `notmuch-mua-compose-in'"))))
|
||||
|
||||
(defun notmuch-mua-maybe-set-window-dedicated ()
|
||||
"Set the selected window as dedicated according to `notmuch-mua-compose-in'."
|
||||
|
|
@ -375,12 +373,10 @@ instead of `message-mode' and SWITCH-FUNCTION is mandatory."
|
|||
(select-window window))
|
||||
(funcall switch-function buffer)
|
||||
(set-buffer buffer))
|
||||
(when (and (buffer-modified-p)
|
||||
(not (prog1
|
||||
(y-or-n-p
|
||||
"Message already being composed; erase? ")
|
||||
(message nil))))
|
||||
(error "Message being composed")))
|
||||
(when (buffer-modified-p)
|
||||
(if (y-or-n-p "Message already being composed; erase? ")
|
||||
(message nil)
|
||||
(error "Message being composed"))))
|
||||
(funcall switch-function name)
|
||||
(set-buffer name))
|
||||
(erase-buffer)
|
||||
|
|
@ -611,8 +607,10 @@ unencrypted. Really send? "))))
|
|||
;;; _
|
||||
|
||||
(define-mail-user-agent 'notmuch-user-agent
|
||||
'notmuch-mua-mail 'notmuch-mua-send-and-exit
|
||||
'notmuch-mua-kill-buffer 'notmuch-mua-send-hook)
|
||||
'notmuch-mua-mail
|
||||
'notmuch-mua-send-and-exit
|
||||
'notmuch-mua-kill-buffer
|
||||
'notmuch-mua-send-hook)
|
||||
|
||||
;; Add some more headers to the list that `message-mode' hides when
|
||||
;; composing a message.
|
||||
|
|
|
|||
|
|
@ -41,11 +41,9 @@ is a possibly empty forest of replies."
|
|||
|
||||
(defun notmuch-query-map-aux (mapper function seq)
|
||||
"Private function to do the actual mapping and flattening."
|
||||
(apply 'append
|
||||
(mapcar
|
||||
(lambda (tree)
|
||||
(cl-mapcan (lambda (tree)
|
||||
(funcall mapper function tree))
|
||||
seq)))
|
||||
seq))
|
||||
|
||||
(defun notmuch-query-map-threads (fn threads)
|
||||
"Apply function FN to every thread in THREADS.
|
||||
|
|
@ -63,7 +61,8 @@ Flatten results to a list. See the function
|
|||
"Apply function FN to every message in TREE.
|
||||
Flatten results to a list. See the function
|
||||
`notmuch-query-get-threads' for more information."
|
||||
(cons (funcall fn (car tree)) (notmuch-query-map-forest fn (cadr tree))))
|
||||
(cons (funcall fn (car tree))
|
||||
(notmuch-query-map-forest fn (cadr tree))))
|
||||
|
||||
;;; Predefined queries
|
||||
|
||||
|
|
|
|||
|
|
@ -454,8 +454,9 @@ present or a \"-\" to indicate that the tag should be removed
|
|||
from TAGS if present."
|
||||
(let ((result-tags (copy-sequence tags)))
|
||||
(dolist (tag-change tag-changes)
|
||||
(let ((op (string-to-char tag-change))
|
||||
(tag (unless (string= tag-change "") (substring tag-change 1))))
|
||||
(let ((op (aref tag-change 0))
|
||||
(tag (and (not (string= tag-change ""))
|
||||
(substring tag-change 1))))
|
||||
(cl-case op
|
||||
(?+ (unless (member tag result-tags)
|
||||
(push tag result-tags)))
|
||||
|
|
@ -482,13 +483,12 @@ messages instead of running (notmuch-call-notmuch-process \"tag\" ..)
|
|||
directly, so that hooks specified in notmuch-before-tag-hook and
|
||||
notmuch-after-tag-hook will be run."
|
||||
;; Perform some validation
|
||||
(mapc (lambda (tag-change)
|
||||
(dolist (tag-change tag-changes)
|
||||
(unless (string-match-p "^[-+]\\S-+$" tag-change)
|
||||
(error "Tag must be of the form `+this_tag' or `-that_tag'")))
|
||||
tag-changes)
|
||||
(unless query
|
||||
(error "Nothing to tag!"))
|
||||
(unless (null tag-changes)
|
||||
(when tag-changes
|
||||
(run-hooks 'notmuch-before-tag-hook)
|
||||
(if (<= (length query) notmuch-tag-argument-limit)
|
||||
(apply 'notmuch-call-notmuch-process "tag"
|
||||
|
|
|
|||
|
|
@ -179,7 +179,7 @@ there will be called at other points of notmuch execution."
|
|||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map notmuch-common-keymap)
|
||||
(define-key map "x" 'notmuch-bury-or-kill-this-buffer)
|
||||
(define-key map (kbd "<DEL>") 'notmuch-search-scroll-down)
|
||||
(define-key map (kbd "DEL") 'notmuch-search-scroll-down)
|
||||
(define-key map "b" 'notmuch-search-scroll-down)
|
||||
(define-key map " " 'notmuch-search-scroll-up)
|
||||
(define-key map "<" 'notmuch-search-first-thread)
|
||||
|
|
@ -950,8 +950,7 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
|
|||
"Read a notmuch-query from the minibuffer with completion.
|
||||
|
||||
PROMPT is the string to prompt with."
|
||||
(let*
|
||||
((all-tags
|
||||
(let* ((all-tags
|
||||
(mapcar (lambda (tag) (notmuch-escape-boolean-term tag))
|
||||
(process-lines notmuch-command "search" "--output=tags" "*")))
|
||||
(completions
|
||||
|
|
@ -960,8 +959,8 @@ PROMPT is the string to prompt with."
|
|||
(mapcar (lambda (tag) (concat "tag:" tag)) all-tags)
|
||||
(mapcar (lambda (tag) (concat "is:" tag)) all-tags)
|
||||
(mapcar (lambda (mimetype) (concat "mimetype:" mimetype))
|
||||
(mailcap-mime-types)))))
|
||||
(let ((keymap (copy-keymap minibuffer-local-map))
|
||||
(mailcap-mime-types))))
|
||||
(keymap (copy-keymap minibuffer-local-map))
|
||||
(current-query (cl-case major-mode
|
||||
(notmuch-search-mode (notmuch-search-get-query))
|
||||
(notmuch-show-mode (notmuch-show-get-query))
|
||||
|
|
@ -969,21 +968,21 @@ PROMPT is the string to prompt with."
|
|||
(minibuffer-completion-table
|
||||
(completion-table-dynamic
|
||||
(lambda (string)
|
||||
;; generate a list of possible completions for the current input
|
||||
;; Generate a list of possible completions for the current input.
|
||||
(cond
|
||||
;; this ugly regexp is used to get the last word of the input
|
||||
;; possibly preceded by a '('
|
||||
;; This ugly regexp is used to get the last word of the input
|
||||
;; possibly preceded by a '('.
|
||||
((string-match "\\(^\\|.* (?\\)\\([^ ]*\\)$" string)
|
||||
(mapcar (lambda (compl)
|
||||
(concat (match-string-no-properties 1 string) compl))
|
||||
(all-completions (match-string-no-properties 2 string)
|
||||
completions)))
|
||||
(t (list string)))))))
|
||||
;; this was simpler than convincing completing-read to accept spaces:
|
||||
;; This was simpler than convincing completing-read to accept spaces:
|
||||
(define-key keymap (kbd "TAB") 'minibuffer-complete)
|
||||
(let ((history-delete-duplicates t))
|
||||
(read-from-minibuffer prompt nil keymap nil
|
||||
'notmuch-search-history current-query nil)))))
|
||||
'notmuch-search-history current-query nil))))
|
||||
|
||||
(defun notmuch-search-get-query ()
|
||||
"Return the current query in this search buffer."
|
||||
|
|
@ -1042,12 +1041,12 @@ the configured default sort order."
|
|||
(if oldest-first
|
||||
"--sort=oldest-first"
|
||||
"--sort=newest-first")
|
||||
query))
|
||||
query)))
|
||||
;; Use a scratch buffer to accumulate partial output.
|
||||
;; This buffer will be killed by the sentinel, which
|
||||
;; should be called no matter how the process dies.
|
||||
(parse-buf (generate-new-buffer " *notmuch search parse*")))
|
||||
(process-put proc 'parse-buf parse-buf)
|
||||
(process-put proc 'parse-buf
|
||||
(generate-new-buffer " *notmuch search parse*"))
|
||||
(set-process-filter proc 'notmuch-search-process-filter)
|
||||
(set-process-query-on-exit-flag proc nil))))
|
||||
(run-hooks 'notmuch-search-hook)))
|
||||
|
|
|
|||
Loading…
Reference in a new issue