X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch.el;h=f8c97c5df85db83a382f5e6b0a259b9135e4ee2f;hb=692acdf9da2ca93d46259ca31780ed632c2975c4;hp=93e92b391fde9753ae6d15f4a869fc19f89fb995;hpb=09f6533c3781b61ea634790d4bad38aadf89115c;p=notmuch
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 93e92b39..f8c97c5d 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -1,4 +1,4 @@
-;;; notmuch.el --- run notmuch within emacs
+;;; notmuch.el --- run notmuch within emacs -*- lexical-binding: t -*-
;;
;; Copyright © Carl Worth
;;
@@ -18,7 +18,7 @@
;; along with Notmuch. If not, see .
;;
;; Authors: Carl Worth
-;; Homepage: https://notmuchmail.org/
+;; Homepage: https://notmuchmail.org
;;; Commentary:
@@ -62,7 +62,7 @@
;;
;; TL;DR: notmuch-emacs from MELPA and notmuch from distro packages is
;; NOT SUPPORTED.
-;;
+
;;; Code:
(eval-when-compile (require 'cl-lib))
@@ -80,6 +80,8 @@
(require 'notmuch-message)
(require 'notmuch-parser)
+;;; Options
+
(defcustom notmuch-search-result-format
`(("date" . "%12s ")
("count" . "%-7s ")
@@ -115,6 +117,8 @@ there will be called at other points of notmuch execution."
(defvar notmuch-query-history nil
"Variable to store minibuffer history for notmuch queries.")
+;;; Mime Utilities
+
(defun notmuch-foreach-mime-part (function mm-handle)
(cond ((stringp (car mm-handle))
(dolist (part (cdr mm-handle))
@@ -151,6 +155,8 @@ there will be called at other points of notmuch execution."
(mm-save-part p))))
mm-handle))
+;;; Integrations
+
(require 'hl-line)
(defun notmuch-hl-line-mode ()
@@ -158,6 +164,8 @@ there will be called at other points of notmuch execution."
(when hl-line-overlay
(overlay-put hl-line-overlay 'priority 1))))
+;;; Options
+
(defcustom notmuch-search-hook '(notmuch-hl-line-mode)
"List of functions to call when notmuch displays the search results."
:type 'hook
@@ -165,11 +173,13 @@ there will be called at other points of notmuch execution."
:group 'notmuch-search
:group 'notmuch-hooks)
+;;; Keymap
+
(defvar notmuch-search-mode-map
(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 "") '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)
@@ -194,7 +204,8 @@ there will be called at other points of notmuch execution."
(define-key map "U" 'notmuch-unthreaded-from-search-current-query)
map)
"Keymap for \"notmuch search\" buffers.")
-(fset 'notmuch-search-mode-map notmuch-search-mode-map)
+
+;;; Stashing
(defvar notmuch-search-stash-map
(let ((map (make-sparse-keymap)))
@@ -215,11 +226,15 @@ there will be called at other points of notmuch execution."
(interactive)
(notmuch-common-do-stash (notmuch-search-get-query)))
+;;; Variables
+
(defvar notmuch-search-query-string)
(defvar notmuch-search-target-thread)
(defvar notmuch-search-target-line)
-(defvar notmuch-search-disjunctive-regexp "\\<[oO][rR]\\>")
+(defvar notmuch-search-disjunctive-regexp "\\<[oO][rR]\\>")
+
+;;; Movement
(defun notmuch-search-scroll-up ()
"Move forward through search results by one window's worth."
@@ -272,9 +287,15 @@ there will be called at other points of notmuch execution."
(interactive)
(goto-char (point-min)))
+;;; Faces
+
(defface notmuch-message-summary-face
- '((((class color) (background light)) (:background "#f0f0f0"))
- (((class color) (background dark)) (:background "#303030")))
+ `((((class color) (background light))
+ ,@(and (>= emacs-major-version 27) '(:extend t))
+ :background "#f0f0f0")
+ (((class color) (background dark))
+ ,@(and (>= emacs-major-version 27) '(:extend t))
+ :background "#303030"))
"Face for the single-line message summary in notmuch-show-mode."
:group 'notmuch-show
:group 'notmuch-faces)
@@ -339,7 +360,7 @@ there will be called at other points of notmuch execution."
"Face used in search mode face for flagged threads.
This face is the default value for the \"flagged\" tag in
-`notmuch-search-line-faces`."
+`notmuch-search-line-faces'."
:group 'notmuch-search
:group 'notmuch-faces)
@@ -349,10 +370,12 @@ This face is the default value for the \"flagged\" tag in
"Face used in search mode for unread threads.
This face is the default value for the \"unread\" tag in
-`notmuch-search-line-faces`."
+`notmuch-search-line-faces'."
:group 'notmuch-search
:group 'notmuch-faces)
+;;; Mode
+
(define-derived-mode notmuch-search-mode fundamental-mode "notmuch-search"
"Major mode displaying results of a notmuch search.
@@ -388,7 +411,7 @@ Complete list of currently available key bindings:
(make-local-variable 'notmuch-search-target-thread)
(make-local-variable 'notmuch-search-target-line)
(setq notmuch-buffer-refresh-function #'notmuch-search-refresh-view)
- (set (make-local-variable 'scroll-preserve-screen-position) t)
+ (setq-local scroll-preserve-screen-position t)
(add-to-invisibility-spec (cons 'ellipsis t))
(setq truncate-lines t)
(setq buffer-read-only t)
@@ -397,6 +420,8 @@ Complete list of currently available key bindings:
(setq imenu-extract-index-name-function
#'notmuch-search-imenu-extract-index-name-function))
+;;; Search Results
+
(defun notmuch-search-get-result (&optional pos)
"Return the result object for the thread at POS (or point).
@@ -428,11 +453,10 @@ returns nil."
(defun notmuch-search-foreach-result (beg end fn)
"Invoke FN for each result between BEG and END.
-FN should take one argument. It will be applied to the
-character position of the beginning of each result that overlaps
-the region between points BEG and END. As a special case, if (=
-BEG END), FN will be applied to the result containing point
-BEG."
+FN should take one argument. It will be applied to the character
+position of the beginning of each result that overlaps the region
+between points BEG and END. As a special case, if (= BEG END),
+FN will be applied to the result containing point BEG."
(let ((pos (notmuch-search-result-beginning beg))
;; End must be a marker in case fn changes the
;; text.
@@ -470,7 +494,7 @@ If BARE is set then do not prefix with \"thread:\"."
(defun notmuch-search-find-stable-query ()
"Return the stable queries for the current thread.
-This returns a list (MATCHED-QUERY UNMATCHED-QUERY) for the
+Return a list (MATCHED-QUERY UNMATCHED-QUERY) for the
matched and unmatched messages in the current thread."
(plist-get (notmuch-search-get-result) :query))
@@ -542,7 +566,7 @@ thread."
notmuch-search-query-string
nil
(notmuch-prettify-subject (notmuch-search-find-subject))
- t))
+ t nil (current-buffer)))
(defun notmuch-search-reply-to-thread (&optional prompt-for-sender)
"Begin composing a reply-all to the entire current thread in a new buffer."
@@ -556,6 +580,8 @@ thread."
(let ((message-id (notmuch-search-find-thread-id)))
(notmuch-mua-new-reply message-id prompt-for-sender nil)))
+;;; Tags
+
(defun notmuch-search-set-tags (tags &optional pos)
(let ((new-result (plist-put (notmuch-search-get-result pos) :tags tags)))
(notmuch-search-update-result new-result pos)))
@@ -573,7 +599,7 @@ thread."
(defun notmuch-search-interactive-tag-changes (&optional initial-input)
"Prompt for tag changes for the current thread or region.
-Returns (TAG-CHANGES REGION-BEGIN REGION-END)."
+Return (TAG-CHANGES REGION-BEGIN REGION-END)."
(pcase-let ((`(,beg ,end) (notmuch-interactive-region)))
(list (notmuch-read-tag-changes (notmuch-search-get-tags-region beg end)
(if (= beg end) "Tag thread" "Tag region")
@@ -637,6 +663,8 @@ This function advances the next thread when finished."
(when (eq beg end)
(notmuch-search-next-thread)))
+;;; Search Results
+
(defun notmuch-search-update-result (result &optional pos)
"Replace the result object of the thread at POS (or point) by
RESULT and redraw it.
@@ -665,7 +693,7 @@ of the result."
(min init-point (- new-end 1)))))
(goto-char new-point)))))
-(defun notmuch-search-process-sentinel (proc msg)
+(defun notmuch-search-process-sentinel (proc _msg)
"Add a message to let user know when \"notmuch search\" exits."
(let ((buffer (process-buffer proc))
(status (process-status proc))
@@ -674,28 +702,28 @@ of the result."
(when (memq status '(exit signal))
(catch 'return
(kill-buffer (process-get proc 'parse-buf))
- (if (buffer-live-p buffer)
- (with-current-buffer buffer
- (save-excursion
- (let ((inhibit-read-only t)
- (atbob (bobp)))
- (goto-char (point-max))
- (if (eq status 'signal)
- (insert "Incomplete search results (search process was killed).\n"))
- (when (eq status 'exit)
- (insert "End of search results.\n")
- ;; For version mismatch, there's no point in
- ;; showing the search buffer
- (when (or (= exit-status 20) (= exit-status 21))
- (kill-buffer)
- (throw 'return nil))
- (if (and atbob
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (save-excursion
+ (let ((inhibit-read-only t)
+ (atbob (bobp)))
+ (goto-char (point-max))
+ (when (eq status 'signal)
+ (insert "Incomplete search results (search process was killed).\n"))
+ (when (eq status 'exit)
+ (insert "End of search results.\n")
+ ;; For version mismatch, there's no point in
+ ;; showing the search buffer
+ (when (or (= exit-status 20) (= exit-status 21))
+ (kill-buffer)
+ (throw 'return nil))
+ (when (and atbob
(not (string= notmuch-search-target-thread "found")))
- (set 'never-found-target-thread t)))))
- (when (and never-found-target-thread
- notmuch-search-target-line)
- (goto-char (point-min))
- (forward-line (1- notmuch-search-target-line)))))))))
+ (setq never-found-target-thread t)))))
+ (when (and never-found-target-thread
+ notmuch-search-target-line)
+ (goto-char (point-min))
+ (forward-line (1- notmuch-search-target-line)))))))))
(define-widget 'notmuch--custom-face-edit 'lazy
"Custom face edit with a tag Edit Face"
@@ -760,31 +788,31 @@ non-authors is found, assume that all of the authors match."
(invisible-string "")
(padding ""))
;; Truncate the author string to fit the specification.
- (if (> (length formatted-authors)
- (length formatted-sample))
- (let ((visible-length (- (length formatted-sample)
- (length "... "))))
- ;; Truncate the visible string according to the width of
- ;; the display string.
- (setq visible-string (substring formatted-authors 0 visible-length))
- (setq invisible-string (substring formatted-authors visible-length))
- ;; If possible, truncate the visible string at a natural
- ;; break (comma or pipe), as incremental search doesn't
- ;; match across the visible/invisible border.
- (when (string-match "\\(.*\\)\\([,|] \\)\\([^,|]*\\)" visible-string)
- ;; Second clause is destructive on `visible-string', so
- ;; order is important.
- (setq invisible-string (concat (match-string 3 visible-string)
- invisible-string))
- (setq visible-string (concat (match-string 1 visible-string)
- (match-string 2 visible-string))))
- ;; `visible-string' may be shorter than the space allowed
- ;; by `format-string'. If so we must insert some padding
- ;; after `invisible-string'.
- (setq padding (make-string (- (length formatted-sample)
- (length visible-string)
- (length "..."))
- ? ))))
+ (when (> (length formatted-authors)
+ (length formatted-sample))
+ (let ((visible-length (- (length formatted-sample)
+ (length "... "))))
+ ;; Truncate the visible string according to the width of
+ ;; the display string.
+ (setq visible-string (substring formatted-authors 0 visible-length))
+ (setq invisible-string (substring formatted-authors visible-length))
+ ;; If possible, truncate the visible string at a natural
+ ;; break (comma or pipe), as incremental search doesn't
+ ;; match across the visible/invisible border.
+ (when (string-match "\\(.*\\)\\([,|] \\)\\([^,|]*\\)" visible-string)
+ ;; Second clause is destructive on `visible-string', so
+ ;; order is important.
+ (setq invisible-string (concat (match-string 3 visible-string)
+ invisible-string))
+ (setq visible-string (concat (match-string 1 visible-string)
+ (match-string 2 visible-string))))
+ ;; `visible-string' may be shorter than the space allowed
+ ;; by `format-string'. If so we must insert some padding
+ ;; after `invisible-string'.
+ (setq padding (make-string (- (length formatted-sample)
+ (length visible-string)
+ (length "..."))
+ ? ))))
;; Use different faces to show matching and non-matching authors.
(if (string-match "\\(.*\\)|\\(.*\\)" visible-string)
;; The visible string contains both matching and
@@ -868,8 +896,7 @@ sets the :orig-tag property."
"Process and filter the output of \"notmuch search\"."
(let ((results-buf (process-buffer proc))
(parse-buf (process-get proc 'parse-buf))
- (inhibit-read-only t)
- done)
+ (inhibit-read-only t))
(when (buffer-live-p results-buf)
(with-current-buffer parse-buf
;; Insert new data
@@ -879,6 +906,8 @@ sets the :orig-tag property."
(notmuch-sexp-parse-partial-list 'notmuch-search-append-result
results-buf)))))
+;;; Commands (and some helper functions used by them)
+
(defun notmuch-search-tag-all (tag-changes)
"Add/remove tags from all messages in current search buffer.
@@ -921,40 +950,39 @@ 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
- (mapcar (lambda (tag) (notmuch-escape-boolean-term tag))
- (process-lines notmuch-command "search" "--output=tags" "*")))
- (completions
- (append (list "folder:" "path:" "thread:" "id:" "date:" "from:" "to:"
- "subject:" "attachment:")
- (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))
- (current-query (cl-case major-mode
- (notmuch-search-mode (notmuch-search-get-query))
- (notmuch-show-mode (notmuch-show-get-query))
- (notmuch-tree-mode (notmuch-tree-get-query))))
- (minibuffer-completion-table
- (completion-table-dynamic
- (lambda (string)
- ;; 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 '('
- ((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:
- (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)))))
+ (let* ((all-tags
+ (mapcar (lambda (tag) (notmuch-escape-boolean-term tag))
+ (process-lines notmuch-command "search" "--output=tags" "*")))
+ (completions
+ (append (list "folder:" "path:" "thread:" "id:" "date:" "from:" "to:"
+ "subject:" "attachment:")
+ (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))))
+ (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))
+ (notmuch-tree-mode (notmuch-tree-get-query))))
+ (minibuffer-completion-table
+ (completion-table-dynamic
+ (lambda (string)
+ ;; 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 '('.
+ ((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:
+ (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))))
(defun notmuch-search-get-query ()
"Return the current query in this search buffer."
@@ -991,23 +1019,19 @@ the configured default sort order."
(buffer (get-buffer-create (notmuch-search-buffer-title query))))
(if no-display
(set-buffer buffer)
- (switch-to-buffer buffer))
- ;; avoid wiping out third party buffer-local variables in the case
- ;; where we're just refreshing or changing the sort order of an
- ;; existing search results buffer
- (unless (eq major-mode 'notmuch-search-mode)
- (notmuch-search-mode))
+ (pop-to-buffer-same-window buffer))
+ (notmuch-search-mode)
;; Don't track undo information for this buffer
- (set 'buffer-undo-list t)
- (set 'notmuch-search-query-string query)
- (set 'notmuch-search-oldest-first oldest-first)
- (set 'notmuch-search-target-thread target-thread)
- (set 'notmuch-search-target-line target-line)
+ (setq buffer-undo-list t)
+ (setq notmuch-search-query-string query)
+ (setq notmuch-search-oldest-first oldest-first)
+ (setq notmuch-search-target-thread target-thread)
+ (setq notmuch-search-target-line target-line)
(notmuch-tag-clear-cache)
(let ((proc (get-buffer-process (current-buffer)))
(inhibit-read-only t))
- (if proc
- (error "notmuch search process already running for query `%s'" query))
+ (when proc
+ (error "notmuch search process already running for query `%s'" query))
(erase-buffer)
(goto-char (point-min))
(save-excursion
@@ -1017,12 +1041,12 @@ the configured default sort order."
(if oldest-first
"--sort=oldest-first"
"--sort=newest-first")
- 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)
+ 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.
+ (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)))
@@ -1050,7 +1074,7 @@ same relative position within the new buffer."
This command toggles the sort order for the current search. The
default sort order is defined by `notmuch-search-oldest-first'."
(interactive)
- (set 'notmuch-search-oldest-first (not notmuch-search-oldest-first))
+ (setq notmuch-search-oldest-first (not notmuch-search-oldest-first))
(notmuch-search-refresh-view))
(defun notmuch-group-disjunctive-query-string (query-string)
@@ -1077,10 +1101,10 @@ current search results AND the additional query string provided."
notmuch-search-oldest-first)))
(defun notmuch-search-filter-by-tag (tag)
- "Filter the current search results based on a single tag.
+ "Filter the current search results based on a single TAG.
-Runs a new search matching only messages that match both the
-current search results AND that are tagged with the given tag."
+Run a new search matching only messages that match the current
+search results and that are also tagged with the given TAG."
(interactive
(list (notmuch-select-tag-with-completion "Filter by tag: "
notmuch-search-query-string)))
@@ -1100,7 +1124,7 @@ current search results AND that are tagged with the given tag."
(notmuch-hello))
(defun notmuch-interesting-buffer (b)
- "Is the current buffer of interest to a notmuch user?"
+ "Whether the current buffer's major-mode is a notmuch mode."
(with-current-buffer b
(memq major-mode '(notmuch-show-mode
notmuch-search-mode
@@ -1112,8 +1136,8 @@ current search results AND that are tagged with the given tag."
(defun notmuch-cycle-notmuch-buffers ()
"Cycle through any existing notmuch buffers (search, show or hello).
-If the current buffer is the only notmuch buffer, bury it. If no
-notmuch buffers exist, run `notmuch'."
+If the current buffer is the only notmuch buffer, bury it.
+If no notmuch buffers exist, run `notmuch'."
(interactive)
(let (start first)
;; If the current buffer is a notmuch buffer, remember it and then
@@ -1131,32 +1155,32 @@ notmuch buffers exist, run `notmuch'."
;; If the first one we found is any other than the starting
;; buffer, switch to it.
(unless (eq first start)
- (switch-to-buffer first))
+ (pop-to-buffer-same-window first))
(notmuch))))
-;;;; Imenu Support
+;;; Imenu Support
(defun notmuch-search-imenu-prev-index-position-function ()
"Move point to previous message in notmuch-search buffer.
-This function is used as a value for
-`imenu-prev-index-position-function'."
+Used as`imenu-prev-index-position-function' in notmuch buffers."
(notmuch-search-previous-thread))
(defun notmuch-search-imenu-extract-index-name-function ()
"Return imenu name for line at point.
-This function is used as a value for
-`imenu-extract-index-name-function'. Point should be at the
-beginning of the line."
+Used as `imenu-extract-index-name-function' in notmuch buffers.
+Point should be at the beginning of the line."
(let ((subject (notmuch-search-find-subject))
(author (notmuch-search-find-authors)))
(format "%s (%s)" subject author)))
+;;; _
+
(setq mail-user-agent 'notmuch-user-agent)
(provide 'notmuch)
;; After provide to avoid loops if notmuch was require'd via notmuch-init-file.
-(if init-file-user ; don't load init file if the -q option was used.
- (load notmuch-init-file t t nil t))
+(when init-file-user ; don't load init file if the -q option was used.
+ (load notmuch-init-file t t nil t))
;;; notmuch.el ends here