X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch.el;h=5cb7acd298ae64899d8f7fcf4513627fdcf556cb;hb=3a175ddffba61e49197190127621684c8f5b18a8;hp=04334c7647ce625d245ff9fb77c2b030d239e614;hpb=6fb7d35069c8770b872128156cb4f0511da6b6e9;p=notmuch
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 04334c76..5cb7acd2 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,14 +62,14 @@
;;
;; TL;DR: notmuch-emacs from MELPA and notmuch from distro packages is
;; NOT SUPPORTED.
-;;
-;;; Code:
-(eval-when-compile (require 'cl-lib))
+;;; Code:
(require 'mm-view)
(require 'message)
+(require 'hl-line)
+
(require 'notmuch-lib)
(require 'notmuch-tag)
(require 'notmuch-show)
@@ -80,24 +80,38 @@
(require 'notmuch-message)
(require 'notmuch-parser)
+;;; Options
+
(defcustom notmuch-search-result-format
`(("date" . "%12s ")
("count" . "%-7s ")
("authors" . "%-20s ")
("subject" . "%s ")
("tags" . "(%s)"))
- "Search result formatting. Supported fields are:
- date, count, authors, subject, tags
-For example:
- (setq notmuch-search-result-format \(\(\"authors\" . \"%-40s\"\)
- \(\"subject\" . \"%s\"\)\)\)
+ "Search result formatting.
+
+List of pairs of (field . format-string). Supported field
+strings are: \"date\", \"count\", \"authors\", \"subject\",
+\"tags\". It is also supported to pass a function in place of a
+field name. In this case the function is passed the thread
+object (plist) and format string.
+
Line breaks are permitted in format strings (though this is
currently experimental). Note that a line break at the end of an
\"authors\" field will get elided if the authors list is long;
place it instead at the beginning of the following field. To
enter a line break when setting this variable with setq, use \\n.
To enter a line break in customize, press \\[quoted-insert] C-j."
- :type '(alist :key-type (string) :value-type (string))
+ :type '(alist
+ :key-type
+ (choice
+ (const :tag "Date" "date")
+ (const :tag "Count" "count")
+ (const :tag "Authors" "authors")
+ (const :tag "Subject" "subject")
+ (const :tag "Tags" "tags")
+ function)
+ :value-type (string :tag "Format"))
:group 'notmuch-search)
;; The name of this variable `notmuch-init-file' is consistent with the
@@ -112,28 +126,34 @@ there will be called at other points of notmuch execution."
:type 'file
:group 'notmuch)
-(defvar notmuch-query-history nil
- "Variable to store minibuffer history for notmuch queries.")
+(defcustom notmuch-search-hook '(notmuch-hl-line-mode)
+ "List of functions to call when notmuch displays the search results."
+ :type 'hook
+ :options '(notmuch-hl-line-mode)
+ :group 'notmuch-search
+ :group 'notmuch-hooks)
+
+;;; Mime Utilities
(defun notmuch-foreach-mime-part (function mm-handle)
(cond ((stringp (car mm-handle))
- (dolist (part (cdr mm-handle))
- (notmuch-foreach-mime-part function part)))
- ((bufferp (car mm-handle))
- (funcall function mm-handle))
- (t (dolist (part mm-handle)
- (notmuch-foreach-mime-part function part)))))
+ (dolist (part (cdr mm-handle))
+ (notmuch-foreach-mime-part function part)))
+ ((bufferp (car mm-handle))
+ (funcall function mm-handle))
+ (t (dolist (part mm-handle)
+ (notmuch-foreach-mime-part function part)))))
(defun notmuch-count-attachments (mm-handle)
(let ((count 0))
(notmuch-foreach-mime-part
(lambda (p)
(let ((disposition (mm-handle-disposition p)))
- (and (listp disposition)
- (or (equal (car disposition) "attachment")
- (and (equal (car disposition) "inline")
- (assq 'filename disposition)))
- (cl-incf count))))
+ (and (listp disposition)
+ (or (equal (car disposition) "attachment")
+ (and (equal (car disposition) "inline")
+ (assq 'filename disposition)))
+ (cl-incf count))))
mm-handle)
count))
@@ -142,34 +162,22 @@ there will be called at other points of notmuch execution."
(lambda (p)
(let ((disposition (mm-handle-disposition p)))
(and (listp disposition)
- (or (equal (car disposition) "attachment")
- (and (equal (car disposition) "inline")
- (assq 'filename disposition)))
- (or (not queryp)
- (y-or-n-p
- (concat "Save '" (cdr (assq 'filename disposition)) "' ")))
- (mm-save-part p))))
+ (or (equal (car disposition) "attachment")
+ (and (equal (car disposition) "inline")
+ (assq 'filename disposition)))
+ (or (not queryp)
+ (y-or-n-p
+ (concat "Save '" (cdr (assq 'filename disposition)) "' ")))
+ (mm-save-part p))))
mm-handle))
-(require 'hl-line)
-
-(defun notmuch-hl-line-mode ()
- (prog1 (hl-line-mode)
- (when hl-line-overlay
- (overlay-put hl-line-overlay 'priority 1))))
-
-(defcustom notmuch-search-hook '(notmuch-hl-line-mode)
- "List of functions to call when notmuch displays the search results."
- :type 'hook
- :options '(notmuch-hl-line-mode)
- :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 +202,17 @@ 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)
+
+;;; Internal Variables
+
+(defvar notmuch-query-history nil
+ "Variable to store minibuffer history for notmuch queries.")
+
+(defvar-local notmuch-search-query-string nil)
+(defvar-local notmuch-search-target-thread nil)
+(defvar-local notmuch-search-target-line nil)
+
+;;; Stashing
(defvar notmuch-search-stash-map
(let ((map (make-sparse-keymap)))
@@ -213,13 +231,9 @@ there will be called at other points of notmuch execution."
(defun notmuch-stash-query ()
"Copy current query to kill-ring."
(interactive)
- (notmuch-common-do-stash (notmuch-search-get-query)))
-
-(defvar notmuch-search-query-string)
-(defvar notmuch-search-target-thread)
-(defvar notmuch-search-target-line)
+ (notmuch-common-do-stash notmuch-search-query-string))
-(defvar notmuch-search-disjunctive-regexp "\\<[oO][rR]\\>")
+;;; Movement
(defun notmuch-search-scroll-up ()
"Move forward through search results by one window's worth."
@@ -264,19 +278,26 @@ there will be called at other points of notmuch execution."
(goto-char (point-max))
(forward-line -2)
(let ((beg (notmuch-search-result-beginning)))
- (when beg (goto-char beg))))
+ (when beg
+ (goto-char beg))))
(defun notmuch-search-first-thread ()
"Select the first thread in the search results."
(interactive)
(goto-char (point-min)))
+;;; Faces
+
(defface notmuch-message-summary-face
- '((((class color) (background light)) (:background "#f0f0f0"))
- (((class color) (background dark)) (:background "#303030")))
- "Face for the single-line message summary in notmuch-show-mode."
- :group 'notmuch-show
- :group 'notmuch-faces)
+ `((((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)
(defface notmuch-search-date
'((t :inherit default))
@@ -338,7 +359,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)
@@ -348,10 +369,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.
@@ -382,19 +405,17 @@ new, global search.
Complete list of currently available key bindings:
\\{notmuch-search-mode-map}"
- (make-local-variable 'notmuch-search-query-string)
- (make-local-variable 'notmuch-search-oldest-first)
- (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)
(setq imenu-prev-index-position-function
- #'notmuch-search-imenu-prev-index-position-function)
+ #'notmuch-search-imenu-prev-index-position-function)
(setq imenu-extract-index-name-function
- #'notmuch-search-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).
@@ -406,11 +427,12 @@ If there is no thread at POS (or point), returns nil."
"Return the point at the beginning of the thread at POS (or point).
If there is no thread at POS (or point), returns nil."
- (when (notmuch-search-get-result pos)
- ;; We pass 1+point because previous-single-property-change starts
- ;; searching one before the position we give it.
- (previous-single-property-change (1+ (or pos (point)))
- 'notmuch-search-result nil (point-min))))
+ (and (notmuch-search-get-result pos)
+ ;; We pass 1+point because previous-single-property-change starts
+ ;; searching one before the position we give it.
+ (previous-single-property-change (1+ (or pos (point)))
+ 'notmuch-search-result nil
+ (point-min))))
(defun notmuch-search-result-end (&optional pos)
"Return the point at the end of the thread at POS (or point).
@@ -418,18 +440,18 @@ If there is no thread at POS (or point), returns nil."
The returned point will be just after the newline character that
ends the result line. If there is no thread at POS (or point),
returns nil."
- (when (notmuch-search-get-result pos)
- (next-single-property-change (or pos (point)) 'notmuch-search-result
- nil (point-max))))
+ (and (notmuch-search-get-result pos)
+ (next-single-property-change (or pos (point))
+ 'notmuch-search-result nil
+ (point-max))))
(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.
@@ -443,8 +465,8 @@ BEG."
(while (and pos (or (< pos end) first))
(when (notmuch-search-get-result pos)
(funcall fn pos))
- (setq pos (notmuch-search-result-end pos)
- first nil))))
+ (setq pos (notmuch-search-result-end pos))
+ (setq first nil))))
;; Unindent the function argument of notmuch-search-foreach-result so
;; the indentation of callers doesn't get out of hand.
(put 'notmuch-search-foreach-result 'lisp-indent-function 2)
@@ -461,12 +483,13 @@ BEG."
If BARE is set then do not prefix with \"thread:\"."
(let ((thread (plist-get (notmuch-search-get-result) :thread)))
- (when thread (concat (unless bare "thread:") thread))))
+ (when thread
+ (concat (and (not bare) "thread:") 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))
@@ -482,8 +505,8 @@ no messages in the region then return nil."
(push (car queries) query-list))
(when (and all (cadr queries))
(push (cadr queries) query-list)))
- (when query-list
- (concat "(" (mapconcat 'identity query-list ") or (") ")"))))
+ (and query-list
+ (concat "(" (mapconcat 'identity query-list ") or (") ")"))))
(defun notmuch-search-find-authors ()
"Return the authors for the current thread."
@@ -506,28 +529,30 @@ no messages in the region then return nil."
With a prefix argument, invert the default value of
`notmuch-show-only-matching-messages' when displaying the
-thread."
+thread.
+
+Return non-nil on success."
(interactive "P")
- (let ((thread-id (notmuch-search-find-thread-id))
- (subject (notmuch-search-find-subject)))
- (if (> (length thread-id) 0)
+ (let ((thread-id (notmuch-search-find-thread-id)))
+ (if thread-id
(notmuch-show thread-id
elide-toggle
(current-buffer)
notmuch-search-query-string
;; Name the buffer based on the subject.
- (concat "*"
- (truncate-string-to-width subject 30 nil nil t)
- "*"))
- (message "End of search results."))))
+ (format "*%s*" (truncate-string-to-width
+ (notmuch-search-find-subject)
+ 30 nil nil t)))
+ (message "End of search results.")
+ nil)))
(defun notmuch-tree-from-search-current-query ()
- "Call notmuch tree with the current query."
+ "Tree view of current query."
(interactive)
(notmuch-tree notmuch-search-query-string))
(defun notmuch-unthreaded-from-search-current-query ()
- "Call notmuch tree with the current query."
+ "Unthreaded view of current query."
(interactive)
(notmuch-unthreaded notmuch-search-query-string))
@@ -538,23 +563,26 @@ 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."
(interactive "P")
- (let ((message-id (notmuch-search-find-thread-id)))
- (notmuch-mua-new-reply message-id prompt-for-sender t)))
+ (notmuch-mua-new-reply (notmuch-search-find-thread-id)
+ prompt-for-sender t))
(defun notmuch-search-reply-to-thread-sender (&optional prompt-for-sender)
"Begin composing a reply to the entire current thread in a new buffer."
(interactive "P")
- (let ((message-id (notmuch-search-find-thread-id)))
- (notmuch-mua-new-reply message-id prompt-for-sender nil)))
+ (notmuch-mua-new-reply (notmuch-search-find-thread-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)))
+ (notmuch-search-update-result
+ (plist-put (notmuch-search-get-result pos) :tags tags)
+ pos))
(defun notmuch-search-get-tags (&optional pos)
(plist-get (notmuch-search-get-result pos) :tags))
@@ -564,12 +592,12 @@ thread."
(notmuch-search-foreach-result beg end
(lambda (pos)
(setq output (append output (notmuch-search-get-tags pos)))))
- output))
+ (delete-dups output)))
(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")
@@ -589,8 +617,8 @@ is inactive this applies to the thread at point.
If ONLY-MATCHED is non-nil, only tag matched messages."
(interactive (notmuch-search-interactive-tag-changes))
(unless (and beg end)
- (setq beg (car (notmuch-interactive-region))
- end (cadr (notmuch-interactive-region))))
+ (setq beg (car (notmuch-interactive-region)))
+ (setq end (cadr (notmuch-interactive-region))))
(let ((search-string (notmuch-search-find-stable-query-region
beg end only-matched)))
(notmuch-tag search-string tag-changes)
@@ -633,6 +661,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.
@@ -661,7 +691,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))
@@ -670,28 +700,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
+ (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)))))))))
+ (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"
@@ -711,7 +741,7 @@ Here is an example of how to color search results based on tags.
(the following text would be placed in your ~/.emacs file):
(setq notmuch-search-line-faces \\='((\"unread\" . (:foreground \"green\"))
- (\"deleted\" . (:foreground \"red\"
+ (\"deleted\" . (:foreground \"red\"
:background \"blue\"))))
The FACE must be a face name (a symbol or string), a property
@@ -722,7 +752,7 @@ the above settings would have a green foreground and blue
background."
:type '(alist :key-type (string)
:value-type (radio (face :tag "Face name")
- (notmuch--custom-face-edit)))
+ (notmuch--custom-face-edit)))
:group 'notmuch-search
:group 'notmuch-faces)
@@ -756,55 +786,56 @@ 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)
- 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)
- 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
;; non-matching authors.
- (setq visible-string (notmuch-search-author-propertize visible-string)
- ;; The invisible string must contain only non-matching
- ;; authors, as the visible-string contains both.
- invisible-string (propertize invisible-string
- 'face 'notmuch-search-non-matching-authors))
+ (progn
+ (setq visible-string (notmuch-search-author-propertize visible-string))
+ ;; The invisible string must contain only non-matching
+ ;; authors, as the visible-string contains both.
+ (setq invisible-string (propertize invisible-string
+ 'face 'notmuch-search-non-matching-authors)))
;; The visible string contains only matching authors.
(setq visible-string (propertize visible-string
- 'face 'notmuch-search-matching-authors)
- ;; The invisible string may contain both matching and
- ;; non-matching authors.
- invisible-string (notmuch-search-author-propertize invisible-string)))
+ 'face 'notmuch-search-matching-authors))
+ ;; The invisible string may contain both matching and
+ ;; non-matching authors.
+ (setq invisible-string (notmuch-search-author-propertize invisible-string)))
;; If there is any invisible text, add it as a tooltip to the
;; visible text.
- (when (not (string= invisible-string ""))
+ (unless (string-empty-p invisible-string)
(setq visible-string
(propertize visible-string
'help-echo (concat "..." invisible-string))))
;; Insert the visible and, if present, invisible author strings.
(insert visible-string)
- (when (not (string= invisible-string ""))
+ (unless (string-empty-p invisible-string)
(let ((start (point))
overlay)
(insert invisible-string)
@@ -814,26 +845,28 @@ non-authors is found, assume that all of the authors match."
(insert padding))))
(defun notmuch-search-insert-field (field format-string result)
- (cond
- ((string-equal field "date")
- (insert (propertize (format format-string (plist-get result :date_relative))
- 'face 'notmuch-search-date)))
- ((string-equal field "count")
- (insert (propertize (format format-string
- (format "[%s/%s]" (plist-get result :matched)
- (plist-get result :total)))
- 'face 'notmuch-search-count)))
- ((string-equal field "subject")
- (insert (propertize (format format-string
- (notmuch-sanitize (plist-get result :subject)))
- 'face 'notmuch-search-subject)))
- ((string-equal field "authors")
- (notmuch-search-insert-authors
- format-string (notmuch-sanitize (plist-get result :authors))))
- ((string-equal field "tags")
- (let ((tags (plist-get result :tags))
- (orig-tags (plist-get result :orig-tags)))
- (insert (format format-string (notmuch-tag-format-tags tags orig-tags)))))))
+ (pcase field
+ ((pred functionp)
+ (insert (funcall field format-string result)))
+ ("date"
+ (insert (propertize (format format-string (plist-get result :date_relative))
+ 'face 'notmuch-search-date)))
+ ("count"
+ (insert (propertize (format format-string
+ (format "[%s/%s]" (plist-get result :matched)
+ (plist-get result :total)))
+ 'face 'notmuch-search-count)))
+ ("subject"
+ (insert (propertize (format format-string
+ (notmuch-sanitize (plist-get result :subject)))
+ 'face 'notmuch-search-subject)))
+ ("authors"
+ (notmuch-search-insert-authors format-string
+ (notmuch-sanitize (plist-get result :authors))))
+ ("tags"
+ (let ((tags (plist-get result :tags))
+ (orig-tags (plist-get result :orig-tags)))
+ (insert (format format-string (notmuch-tag-format-tags tags orig-tags)))))))
(defun notmuch-search-show-result (result pos)
"Insert RESULT at POS."
@@ -859,12 +892,19 @@ sets the :orig-tag property."
(setq notmuch-search-target-thread "found")
(goto-char pos))))
+(defvar-local notmuch--search-hook-run nil
+ "Flag used to ensure the notmuch-search-hook is only run once per buffer")
+
+(defun notmuch--search-hook-wrapper ()
+ (unless notmuch--search-hook-run
+ (setq notmuch--search-hook-run t)
+ (run-hooks 'notmuch-search-hook)))
+
(defun notmuch-search-process-filter (proc string)
"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
@@ -872,7 +912,11 @@ sets the :orig-tag property."
(goto-char (point-max))
(insert string))
(notmuch-sexp-parse-partial-list 'notmuch-search-append-result
- results-buf)))))
+ results-buf))
+ (with-current-buffer results-buf
+ (notmuch--search-hook-wrapper)))))
+
+;;; 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.
@@ -883,7 +927,39 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
(notmuch-search-get-tags-region (point-min) (point-max)) "Tag all")))
(notmuch-search-tag tag-changes (point-min) (point-max) t))
-(defun notmuch-search-buffer-title (query)
+(defcustom notmuch-search-buffer-name-format "*notmuch-%t-%s*"
+ "Format for the name of search results buffers.
+
+In this spec, %s will be replaced by a description of the search
+query and %t by its type (search, tree or unthreaded). The
+buffer name is formatted using `format-spec': see its docstring
+for additional parameters for the s and t format specifiers.
+
+See also `notmuch-saved-search-buffer-name-format'"
+ :type 'string
+ :group 'notmuch-search)
+
+(defcustom notmuch-saved-search-buffer-name-format "*notmuch-saved-%t-%s*"
+ "Format for the name of search results buffers for saved searches.
+
+In this spec, %s will be replaced by the saved search name and %t
+by its type (search, tree or unthreaded). The buffer name is
+formatted using `format-spec': see its docstring for additional
+parameters for the s and t format specifiers.
+
+See also `notmuch-search-buffer-name-format'"
+ :type 'string
+ :group 'notmuch-search)
+
+(defun notmuch-search-format-buffer-name (query type saved)
+ "Compose a buffer name for the given QUERY, TYPE (search, tree,
+unthreaded) and whether it's SAVED (t or nil)."
+ (let ((fmt (if saved
+ notmuch-saved-search-buffer-name-format
+ notmuch-search-buffer-name-format)))
+ (format-spec fmt `((?t . ,(or type "search")) (?s . ,query)))))
+
+(defun notmuch-search-buffer-title (query &optional type)
"Returns the title for a buffer with notmuch search results."
(let* ((saved-search
(let (longest
@@ -898,59 +974,58 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
do (setq longest tuple))
longest))
(saved-search-name (notmuch-saved-search-get saved-search :name))
+ (saved-search-type (notmuch-saved-search-get saved-search :search-type))
(saved-search-query (notmuch-saved-search-get saved-search :query)))
(cond ((and saved-search (equal saved-search-query query))
;; Query is the same as saved search (ignoring case)
- (concat "*notmuch-saved-search-" saved-search-name "*"))
+ (notmuch-search-format-buffer-name saved-search-name
+ saved-search-type
+ t))
(saved-search
- (concat "*notmuch-search-"
- (replace-regexp-in-string
- (concat "^" (regexp-quote saved-search-query))
- (concat "[ " saved-search-name " ]")
- query)
- "*"))
- (t
- (concat "*notmuch-search-" query "*"))
- )))
+ (let ((query (replace-regexp-in-string
+ (concat "^" (regexp-quote saved-search-query))
+ (concat "[ " saved-search-name " ]")
+ query)))
+ (notmuch-search-format-buffer-name query saved-search-type t)))
+ (t (notmuch-search-format-buffer-name query type nil)))))
(defun notmuch-read-query (prompt)
"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))
+ (notmuch--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."
@@ -958,7 +1033,8 @@ PROMPT is the string to prompt with."
(put 'notmuch-search 'notmuch-doc "Search for messages.")
;;;###autoload
-(defun notmuch-search (&optional query oldest-first target-thread target-line no-display)
+(defun notmuch-search (&optional query oldest-first target-thread target-line
+ no-display)
"Display threads matching QUERY in a notmuch-search buffer.
If QUERY is nil, it is read interactively from the minibuffer.
@@ -987,42 +1063,35 @@ 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 (get-buffer-process buffer)
+ (error "notmuch search process already running for query `%s'" query))
+ (let ((inhibit-read-only t))
(erase-buffer)
(goto-char (point-min))
(save-excursion
(let ((proc (notmuch-start-notmuch
"notmuch-search" buffer #'notmuch-search-process-sentinel
- "search" "--format=sexp" "--format-version=4"
+ "search" "--format=sexp" "--format-version=5"
(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)))
+ (set-process-query-on-exit-flag proc nil))))))
(defun notmuch-search-refresh-view ()
"Refresh the current view.
@@ -1033,13 +1102,12 @@ the new search results, then point will be placed on the same
thread. Otherwise, point will be moved to attempt to be in the
same relative position within the new buffer."
(interactive)
- (let ((target-line (line-number-at-pos))
- (oldest-first notmuch-search-oldest-first)
- (target-thread (notmuch-search-find-thread-id 'bare))
- (query notmuch-search-query-string))
- ;; notmuch-search erases the current buffer.
- (notmuch-search query oldest-first target-thread target-line t)
- (goto-char (point-min))))
+ (notmuch-search notmuch-search-query-string
+ notmuch-search-oldest-first
+ (notmuch-search-find-thread-id 'bare)
+ (line-number-at-pos)
+ t)
+ (goto-char (point-min)))
(defun notmuch-search-toggle-order ()
"Toggle the current search order.
@@ -1047,15 +1115,13 @@ 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)
"Group query if it contains a complex expression.
-
-Enclose QUERY-STRING in parentheses if it matches
-`notmuch-search-disjunctive-regexp'."
- (if (string-match-p notmuch-search-disjunctive-regexp query-string)
+Enclose QUERY-STRING in parentheses if contains \"OR\" operators."
+ (if (string-match-p "\\<[oO][rR]\\>" query-string)
(concat "( " query-string " )")
query-string))
@@ -1074,10 +1140,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)))
@@ -1097,7 +1163,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
@@ -1109,8 +1175,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
@@ -1128,32 +1194,38 @@ 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))))
+;;; Integrations
+;;;; Hl-line Support
+
+(defun notmuch-hl-line-mode ()
+ (prog1 (hl-line-mode)
+ (when hl-line-overlay
+ (overlay-put hl-line-overlay 'priority 1))))
+
;;;; 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."
- (let ((subject (notmuch-search-find-subject))
- (author (notmuch-search-find-authors)))
- (format "%s (%s)" subject author)))
+Used as `imenu-extract-index-name-function' in notmuch buffers.
+Point should be at the beginning of the line."
+ (format "%s (%s)"
+ (notmuch-search-find-subject)
+ (notmuch-search-find-authors)))
-(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