X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch.el;h=673811ce11eef791f846927095a706378d7500b3;hb=a9ab5e42af4464e37569221b8faaf5a7fec0cc8e;hp=9da8df4d377f31fb5b125a6a3de0774b417ed85e;hpb=0844af35eb9a4843fbf7053ca37f9f69bbafdcb1;p=notmuch
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 9da8df4d..673811ce 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
;;
;; Copyright © Carl Worth
;;
@@ -15,15 +15,18 @@
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with Notmuch. If not, see .
+;; along with Notmuch. If not, see .
;;
;; Authors: Carl Worth
+;; Homepage: https://notmuchmail.org/
+
+;;; Commentary:
;; This is an emacs-based interface to the notmuch mail system.
;;
;; You will first need to have the notmuch program installed and have a
;; notmuch database built in order to use this. See
-;; http://notmuchmail.org for details.
+;; https://notmuchmail.org for details.
;;
;; To install this software, copy it to a directory that is on the
;; `load-path' variable within emacs (a good candidate is
@@ -36,7 +39,7 @@
;;
;; Then, to actually run it, add:
;;
-;; (require 'notmuch)
+;; (autoload 'notmuch "notmuch" "Notmuch mail" t)
;;
;; to your ~/.emacs file, and then run "M-x notmuch" from within emacs,
;; or run:
@@ -45,7 +48,9 @@
;;
;; Have fun, and let us know if you have any comment, questions, or
;; kudos: Notmuch list (subscription is not
-;; required, but is available from http://notmuchmail.org).
+;; required, but is available from https://notmuchmail.org).
+
+;;; Code:
(eval-when-compile (require 'cl))
(require 'mm-view)
@@ -54,10 +59,12 @@
(require 'notmuch-lib)
(require 'notmuch-tag)
(require 'notmuch-show)
+(require 'notmuch-tree)
(require 'notmuch-mua)
(require 'notmuch-hello)
(require 'notmuch-maildir-fcc)
(require 'notmuch-message)
+(require 'notmuch-parser)
(defcustom notmuch-search-result-format
`(("date" . "%12s ")
@@ -79,6 +86,18 @@ To enter a line break in customize, press \\[quoted-insert] C-j."
:type '(alist :key-type (string) :value-type (string))
:group 'notmuch-search)
+;; The name of this variable `notmuch-init-file' is consistent with the
+;; convention used in e.g. emacs and gnus. The value, `notmuch-config[.el[c]]'
+;; is consistent with notmuch cli configuration file `~/.notmuch-config'.
+(defcustom notmuch-init-file (locate-user-emacs-file "notmuch-config")
+ "Your Notmuch Emacs-Lisp configuration file name.
+If a file with one of the suffixes defined by `get-load-suffixes' exists,
+it will be read instead.
+This file is read once when notmuch is loaded; the notmuch hooks added
+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")
@@ -118,83 +137,6 @@ To enter a line break in customize, press \\[quoted-insert] C-j."
(mm-save-part p))))
mm-handle))
-(defun notmuch-documentation-first-line (symbol)
- "Return the first line of the documentation string for SYMBOL."
- (let ((doc (documentation symbol)))
- (if doc
- (with-temp-buffer
- (insert (documentation symbol t))
- (goto-char (point-min))
- (let ((beg (point)))
- (end-of-line)
- (buffer-substring beg (point))))
- "")))
-
-(defun notmuch-prefix-key-description (key)
- "Given a prefix key code, return a human-readable string representation.
-
-This is basically just `format-kbd-macro' but we also convert ESC to M-."
- (let ((desc (format-kbd-macro (vector key))))
- (if (string= desc "ESC")
- "M-"
- (concat desc " "))))
-
-;; I would think that emacs would have code handy for walking a keymap
-;; and generating strings for each key, and I would prefer to just call
-;; that. But I couldn't find any (could be all implemented in C I
-;; suppose), so I wrote my own here.
-(defun notmuch-substitute-one-command-key-with-prefix (prefix binding)
- "For a key binding, return a string showing a human-readable
-representation of the prefixed key as well as the first line of
-documentation from the bound function.
-
-For a mouse binding, return nil."
- (let ((key (car binding))
- (action (cdr binding)))
- (if (mouse-event-p key)
- nil
- (if (keymapp action)
- (let ((substitute (apply-partially 'notmuch-substitute-one-command-key-with-prefix (notmuch-prefix-key-description key)))
- (as-list))
- (map-keymap (lambda (a b)
- (push (cons a b) as-list))
- action)
- (mapconcat substitute as-list "\n"))
- (concat prefix (format-kbd-macro (vector key))
- "\t"
- (notmuch-documentation-first-line action))))))
-
-(defun notmuch-substitute-command-keys-one (key)
- ;; A `keymap' key indicates inheritance from a parent keymap - the
- ;; inherited mappings follow, so there is nothing to print for
- ;; `keymap' itself.
- (when (not (eq key 'keymap))
- (notmuch-substitute-one-command-key-with-prefix nil key)))
-
-(defun notmuch-substitute-command-keys (doc)
- "Like `substitute-command-keys' but with documentation, not function names."
- (let ((beg 0))
- (while (string-match "\\\\{\\([^}[:space:]]*\\)}" doc beg)
- (let* ((keymap-name (substring doc (match-beginning 1) (match-end 1)))
- (keymap (symbol-value (intern keymap-name))))
- (setq doc (replace-match
- (mapconcat #'notmuch-substitute-command-keys-one
- (cdr keymap) "\n")
- 1 1 doc)))
- (setq beg (match-end 0)))
- doc))
-
-(defun notmuch-help ()
- "Display help for the current notmuch mode."
- (interactive)
- (let* ((mode major-mode)
- (doc (substitute-command-keys (notmuch-substitute-command-keys (documentation mode t)))))
- (with-current-buffer (generate-new-buffer "*notmuch-help*")
- (insert doc)
- (goto-char (point-min))
- (set-buffer-modified-p nil)
- (view-buffer (current-buffer) 'kill-buffer-if-not-modified))))
-
(require 'hl-line)
(defun notmuch-hl-line-mode ()
@@ -211,9 +153,8 @@ For a mouse binding, return nil."
(defvar notmuch-search-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "?" 'notmuch-help)
- (define-key map "q" 'notmuch-search-quit)
- (define-key map "x" 'notmuch-search-quit)
+ (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 "b" 'notmuch-search-scroll-down)
(define-key map " " 'notmuch-search-scroll-up)
@@ -223,20 +164,18 @@ For a mouse binding, return nil."
(define-key map "n" 'notmuch-search-next-thread)
(define-key map "r" 'notmuch-search-reply-to-thread-sender)
(define-key map "R" 'notmuch-search-reply-to-thread)
- (define-key map "m" 'notmuch-mua-new-mail)
- (define-key map "s" 'notmuch-search)
(define-key map "o" 'notmuch-search-toggle-order)
(define-key map "c" 'notmuch-search-stash-map)
- (define-key map "=" 'notmuch-search-refresh-view)
- (define-key map "G" 'notmuch-search-poll-and-refresh-view)
(define-key map "t" 'notmuch-search-filter-by-tag)
- (define-key map "f" 'notmuch-search-filter)
+ (define-key map "l" 'notmuch-search-filter)
(define-key map [mouse-1] 'notmuch-search-show-thread)
+ (define-key map "k" 'notmuch-tag-jump)
(define-key map "*" 'notmuch-search-tag-all)
(define-key map "a" 'notmuch-search-archive-thread)
(define-key map "-" 'notmuch-search-remove-tag)
(define-key map "+" 'notmuch-search-add-tag)
(define-key map (kbd "RET") 'notmuch-search-show-thread)
+ (define-key map "Z" 'notmuch-tree-from-search-current-query)
map)
"Keymap for \"notmuch search\" buffers.")
(fset 'notmuch-search-mode-map notmuch-search-mode-map)
@@ -244,6 +183,8 @@ For a mouse binding, return nil."
(defvar notmuch-search-stash-map
(let ((map (make-sparse-keymap)))
(define-key map "i" 'notmuch-search-stash-thread-id)
+ (define-key map "q" 'notmuch-stash-query)
+ (define-key map "?" 'notmuch-subkeymap-help)
map)
"Submap for stash commands")
(fset 'notmuch-search-stash-map notmuch-search-stash-map)
@@ -253,21 +194,17 @@ For a mouse binding, return nil."
(interactive)
(notmuch-common-do-stash (notmuch-search-find-thread-id)))
+(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)
-(defvar notmuch-search-continuation)
(defvar notmuch-search-disjunctive-regexp "\\<[oO][rR]\\>")
-(defun notmuch-search-quit ()
- "Exit the search buffer, calling any defined continuation function."
- (interactive)
- (let ((continuation notmuch-search-continuation))
- (notmuch-kill-this-buffer)
- (when continuation
- (funcall continuation))))
-
(defun notmuch-search-scroll-up ()
"Move forward through search results by one window's worth."
(interactive)
@@ -375,7 +312,27 @@ For a mouse binding, return nil."
:group 'notmuch-search
:group 'notmuch-faces)
-(defun notmuch-search-mode ()
+(defface notmuch-search-flagged-face
+ '((t
+ (:weight bold)))
+ "Face used in search mode face for flagged threads.
+
+This face is the default value for the \"flagged\" tag in
+`notmuch-search-line-faces`."
+ :group 'notmuch-search
+ :group 'notmuch-faces)
+
+(defface notmuch-search-unread-face
+ '((t
+ (:foreground "blue")))
+ "Face used in search mode for unread threads.
+
+This face is the default value for the \"unread\" tag in
+`notmuch-search-line-faces`."
+ :group 'notmuch-search
+ :group 'notmuch-faces)
+
+(define-derived-mode notmuch-search-mode fundamental-mode "notmuch-search"
"Major mode displaying results of a notmuch search.
This buffer contains the results of a \"notmuch search\" of your
@@ -385,34 +342,34 @@ number of matched messages and total messages in the thread,
participants in the thread, a representative subject line, and
any tags).
-Pressing \\[notmuch-search-show-thread] on any line displays that thread. The '\\[notmuch-search-add-tag]' and '\\[notmuch-search-remove-tag]'
-keys can be used to add or remove tags from a thread. The '\\[notmuch-search-archive-thread]' key
-is a convenience for archiving a thread (removing the \"inbox\"
-tag). The '\\[notmuch-search-tag-all]' key can be used to add and/or remove tags from all
-messages (as opposed to threads) that match the current query. Use with caution, as this
-will also tag matching messages that arrived *after* constructing the buffer.
-
-Other useful commands are '\\[notmuch-search-filter]' for filtering the current search
-based on an additional query string, '\\[notmuch-search-filter-by-tag]' for filtering to include
-only messages with a given tag, and '\\[notmuch-search]' to execute a new, global
-search.
+Pressing \\[notmuch-search-show-thread] on any line displays that
+thread. The '\\[notmuch-search-add-tag]' and
+'\\[notmuch-search-remove-tag]' keys can be used to add or remove
+tags from a thread. The '\\[notmuch-search-archive-thread]' key
+is a convenience for archiving a thread (applying changes in
+`notmuch-archive-tags'). The '\\[notmuch-search-tag-all]' key can
+be used to add and/or remove tags from all messages (as opposed
+to threads) that match the current query. Use with caution, as
+this will also tag matching messages that arrived *after*
+constructing the buffer.
+
+Other useful commands are '\\[notmuch-search-filter]' for
+filtering the current search based on an additional query string,
+'\\[notmuch-search-filter-by-tag]' for filtering to include only
+messages with a given tag, and '\\[notmuch-search]' to execute a
+new, global search.
Complete list of currently available key bindings:
\\{notmuch-search-mode-map}"
- (interactive)
- (kill-all-local-variables)
(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)
- (set (make-local-variable 'notmuch-search-continuation) nil)
+ (setq notmuch-buffer-refresh-function #'notmuch-search-refresh-view)
(set (make-local-variable 'scroll-preserve-screen-position) t)
(add-to-invisibility-spec (cons 'ellipsis t))
- (use-local-map notmuch-search-mode-map)
(setq truncate-lines t)
- (setq major-mode 'notmuch-search-mode
- mode-name "notmuch-search")
(setq buffer-read-only t))
(defun notmuch-search-get-result (&optional pos)
@@ -483,14 +440,27 @@ 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))))
-(defun notmuch-search-find-thread-id-region (beg end)
- "Return a list of threads for the current region"
- (mapcar (lambda (thread) (concat "thread:" thread))
- (notmuch-search-properties-in-region :thread beg end)))
+(defun notmuch-search-find-stable-query ()
+ "Return the stable queries for the current thread.
+
+This returns a list (MATCHED-QUERY UNMATCHED-QUERY) for the
+matched and unmatched messages in the current thread."
+ (plist-get (notmuch-search-get-result) :query))
-(defun notmuch-search-find-thread-id-region-search (beg end)
- "Return a search string for threads for the current region"
- (mapconcat 'identity (notmuch-search-find-thread-id-region beg end) " or "))
+(defun notmuch-search-find-stable-query-region (beg end &optional only-matched)
+ "Return the stable query for the current region.
+
+If ONLY-MATCHED is non-nil, include only matched messages. If it
+is nil, include both matched and unmatched messages. If there are
+no messages in the region then return nil."
+ (let ((query-list nil) (all (not only-matched)))
+ (dolist (queries (notmuch-search-properties-in-region :query beg end))
+ (when (first queries)
+ (push (first queries) query-list))
+ (when (and all (second queries))
+ (push (second queries) query-list)))
+ (when query-list
+ (concat "(" (mapconcat 'identity query-list ") or (") ")"))))
(defun notmuch-search-find-authors ()
"Return the authors for the current thread"
@@ -508,19 +478,38 @@ If BARE is set then do not prefix with \"thread:\""
"Return a list of authors for the current region"
(notmuch-search-properties-in-region :subject beg end))
-(defun notmuch-search-show-thread ()
- "Display the currently selected thread."
- (interactive)
+(defun notmuch-search-show-thread (&optional elide-toggle)
+ "Display the currently selected thread.
+
+With a prefix argument, invert the default value of
+`notmuch-show-only-matching-messages' when displaying the
+thread."
+ (interactive "P")
(let ((thread-id (notmuch-search-find-thread-id))
(subject (notmuch-search-find-subject)))
(if (> (length thread-id) 0)
(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."))))
+(defun notmuch-tree-from-search-current-query ()
+ "Call notmuch tree with the current query"
+ (interactive)
+ (notmuch-tree notmuch-search-query-string))
+
+(defun notmuch-tree-from-search-thread ()
+ "Show the selected thread with notmuch-tree"
+ (interactive)
+ (notmuch-tree (notmuch-search-find-thread-id)
+ notmuch-search-query-string
+ nil
+ (notmuch-prettify-subject (notmuch-search-find-subject))
+ t))
+
(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")
@@ -533,17 +522,6 @@ If BARE is set then do not prefix with \"thread:\""
(let ((message-id (notmuch-search-find-thread-id)))
(notmuch-mua-new-reply message-id prompt-for-sender nil)))
-(defun notmuch-call-notmuch-process (&rest args)
- "Synchronously invoke \"notmuch\" with the given list of arguments.
-
-If notmuch exits with a non-zero status, output from the process
-will appear in a buffer named \"*Notmuch errors*\" and an error
-will be signaled."
- (with-temp-buffer
- (let ((status (apply #'call-process notmuch-command nil t nil args)))
- (notmuch-check-exit-status status (cons notmuch-command args)
- (buffer-string)))))
-
(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)))
@@ -558,37 +536,65 @@ will be signaled."
(setq output (append output (notmuch-search-get-tags pos)))))
output))
-(defun notmuch-search-tag-region (beg end &optional tag-changes)
- "Change tags for threads in the given region."
- (let ((search-string (notmuch-search-find-thread-id-region-search beg end)))
- (setq tag-changes (funcall 'notmuch-tag search-string tag-changes))
+(defun notmuch-search-interactive-region ()
+ "Return the bounds of the current interactive region.
+
+This returns (BEG END), where BEG and END are the bounds of the
+region if the region is active, or both `point' otherwise."
+ (if (region-active-p)
+ (list (region-beginning) (region-end))
+ (list (point) (point))))
+
+(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)."
+ (let* ((region (notmuch-search-interactive-region))
+ (beg (first region)) (end (second region))
+ (prompt (if (= beg end) "Tag thread" "Tag region")))
+ (cons (notmuch-read-tag-changes
+ (notmuch-search-get-tags-region beg end) prompt initial-input)
+ region)))
+
+(defun notmuch-search-tag (tag-changes &optional beg end only-matched)
+ "Change tags for the currently selected thread or region.
+
+See `notmuch-tag' for information on the format of TAG-CHANGES.
+When called interactively, this uses the region if the region is
+active. When called directly, BEG and END provide the region.
+If these are nil or not provided, 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 (point) end (point)))
+ (let ((search-string (notmuch-search-find-stable-query-region
+ beg end only-matched)))
+ (notmuch-tag search-string tag-changes)
(notmuch-search-foreach-result beg end
(lambda (pos)
(notmuch-search-set-tags
(notmuch-update-tags (notmuch-search-get-tags pos) tag-changes)
pos)))))
-(defun notmuch-search-tag (&optional tag-changes)
- "Change tags for the currently selected thread or region.
+(defun notmuch-search-add-tag (tag-changes &optional beg end)
+ "Change tags for the current thread or region (defaulting to add).
-See `notmuch-tag' for information on the format of TAG-CHANGES."
- (interactive)
- (let* ((beg (if (region-active-p) (region-beginning) (point)))
- (end (if (region-active-p) (region-end) (point))))
- (funcall 'notmuch-search-tag-region beg end tag-changes)))
+Same as `notmuch-search-tag' but sets initial input to '+'."
+ (interactive (notmuch-search-interactive-tag-changes "+"))
+ (notmuch-search-tag tag-changes beg end))
-(defun notmuch-search-add-tag ()
- "Same as `notmuch-search-tag' but sets initial input to '+'."
- (interactive)
- (notmuch-search-tag "+"))
+(defun notmuch-search-remove-tag (tag-changes &optional beg end)
+ "Change tags for the current thread or region (defaulting to remove).
-(defun notmuch-search-remove-tag ()
- "Same as `notmuch-search-tag' but sets initial input to '-'."
- (interactive)
- (notmuch-search-tag "-"))
+Same as `notmuch-search-tag' but sets initial input to '-'."
+ (interactive (notmuch-search-interactive-tag-changes "-"))
+ (notmuch-search-tag tag-changes beg end))
-(defun notmuch-search-archive-thread (&optional unarchive)
- "Archive the currently selected thread.
+(put 'notmuch-search-archive-thread 'notmuch-prefix-doc
+ "Un-archive the currently selected thread.")
+(defun notmuch-search-archive-thread (&optional unarchive beg end)
+ "Archive the currently selected thread or region.
Archive each message in the currently selected thread by applying
the tag changes in `notmuch-archive-tags' to each (remove the
@@ -597,11 +603,12 @@ messages will be \"unarchived\" (i.e. the tag changes in
`notmuch-archive-tags' will be reversed).
This function advances the next thread when finished."
- (interactive "P")
+ (interactive (cons current-prefix-arg (notmuch-search-interactive-region)))
(when notmuch-archive-tags
(notmuch-search-tag
- (notmuch-tag-change-list notmuch-archive-tags unarchive)))
- (notmuch-search-next-thread))
+ (notmuch-tag-change-list notmuch-archive-tags unarchive) beg end))
+ (when (eq beg end)
+ (notmuch-search-next-thread)))
(defun notmuch-search-update-result (result &optional pos)
"Replace the result object of the thread at POS (or point) by
@@ -638,6 +645,7 @@ of the result."
(exit-status (process-exit-status proc))
(never-found-target-thread nil))
(when (memq status '(exit signal))
+ (catch 'return
(kill-buffer (process-get proc 'parse-buf))
(if (buffer-live-p buffer)
(with-current-buffer buffer
@@ -648,46 +656,52 @@ of the result."
(if (eq status 'signal)
(insert "Incomplete search results (search process was killed).\n"))
(when (eq status 'exit)
- (insert "End of search results.")
- (unless (= exit-status 0)
- (insert (format " (process returned %d)" exit-status)))
- (insert "\n")
+ (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
(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))))))))
+ (forward-line (1- notmuch-search-target-line)))))))))
-(defcustom notmuch-search-line-faces '(("unread" :weight bold)
- ("flagged" :foreground "blue"))
- "Tag/face mapping for line highlighting in notmuch-search.
+(defcustom notmuch-search-line-faces
+ '(("unread" 'notmuch-search-unread-face)
+ ("flagged" 'notmuch-search-flagged-face))
+ "Alist of tags to faces for line highlighting in notmuch-search.
+Each element looks like (TAG . FACE).
+A thread with TAG will have FACE applied.
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 '((\"deleted\" . (:foreground \"red\"
- :background \"blue\"))
- (\"unread\" . (:foreground \"green\"))))
+ (setq notmuch-search-line-faces '((\"unread\" . (:foreground \"green\"))
+ (\"deleted\" . (:foreground \"red\"
+ :background \"blue\"))))
-The attributes defined for matching tags are merged, with later
-attributes overriding earlier. A message having both \"deleted\"
-and \"unread\" tags with the above settings would have a green
-foreground and blue background."
+The FACE must be a face name (a symbol or string), a property
+list of face attributes, or a list of these. The faces for
+matching tags are merged, with earlier attributes overriding
+later. A message having both \"deleted\" and \"unread\" tags with
+the above settings would have a green foreground and blue
+background."
:type '(alist :key-type (string) :value-type (custom-face-edit))
:group 'notmuch-search
:group 'notmuch-faces)
(defun notmuch-search-color-line (start end line-tag-list)
"Colorize lines in `notmuch-show' based on tags."
- (mapc (lambda (elem)
- (let ((tag (car elem))
- (attributes (cdr elem)))
- (when (member tag line-tag-list)
- (notmuch-combine-face-text-property start end attributes))))
- ;; Reverse the list so earlier entries take precedence
- (reverse notmuch-search-line-faces)))
+ ;; Reverse the list so earlier entries take precedence
+ (dolist (elem (reverse notmuch-search-line-faces))
+ (let ((tag (car elem))
+ (face (cdr elem)))
+ (when (member tag line-tag-list)
+ (notmuch-apply-face nil face nil start end)))))
(defun notmuch-search-author-propertize (authors)
"Split `authors' into matching and non-matching authors and
@@ -780,39 +794,42 @@ non-authors is found, assume that all of the authors match."
(plist-get result :total)))
'face 'notmuch-search-count)))
((string-equal field "subject")
- (insert (propertize (format format-string (plist-get result :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 (plist-get result :authors)))
+ (notmuch-search-insert-authors
+ format-string (notmuch-sanitize (plist-get result :authors))))
((string-equal field "tags")
- (let ((tags-str (mapconcat 'identity (plist-get result :tags) " ")))
- (insert (propertize (format format-string tags-str)
- 'face 'notmuch-tag-face))))))
+ (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 &optional pos)
- "Insert RESULT at POS or the end of the buffer if POS is null."
+(defun notmuch-search-show-result (result pos)
+ "Insert RESULT at POS."
;; Ignore excluded matches
(unless (= (plist-get result :matched) 0)
- (let ((beg (or pos (point-max))))
- (save-excursion
- (goto-char beg)
- (dolist (spec notmuch-search-result-format)
- (notmuch-search-insert-field (car spec) (cdr spec) result))
- (insert "\n")
- (notmuch-search-color-line beg (point) (plist-get result :tags))
- (put-text-property beg (point) 'notmuch-search-result result))
- (when (string= (plist-get result :thread) notmuch-search-target-thread)
- (setq notmuch-search-target-thread "found")
- (goto-char beg)))))
-
-(defun notmuch-search-show-error (string &rest objects)
- (save-excursion
- (goto-char (point-max))
- (insert "Error: Unexpected output from notmuch search:\n")
- (insert (apply #'format string objects))
- (insert "\n")))
+ (save-excursion
+ (goto-char pos)
+ (dolist (spec notmuch-search-result-format)
+ (notmuch-search-insert-field (car spec) (cdr spec) result))
+ (insert "\n")
+ (notmuch-search-color-line pos (point) (plist-get result :tags))
+ (put-text-property pos (point) 'notmuch-search-result result))))
+
+(defun notmuch-search-append-result (result)
+ "Insert RESULT at the end of the buffer.
+
+This is only called when a result is first inserted so it also
+sets the :orig-tag property."
+ (let ((new-result (plist-put result :orig-tags (plist-get result :tags)))
+ (pos (point-max)))
+ (notmuch-search-show-result new-result pos)
+ (when (string= (plist-get result :thread) notmuch-search-target-thread)
+ (setq notmuch-search-target-thread "found")
+ (goto-char pos))))
(defun notmuch-search-process-filter (proc string)
"Process and filter the output of \"notmuch search\""
@@ -820,23 +837,23 @@ non-authors is found, assume that all of the authors match."
(parse-buf (process-get proc 'parse-buf))
(inhibit-read-only t)
done)
- (if (not (buffer-live-p results-buf))
- (delete-process proc)
+ (when (buffer-live-p results-buf)
(with-current-buffer parse-buf
;; Insert new data
(save-excursion
(goto-char (point-max))
(insert string))
- (notmuch-json-parse-partial-list 'notmuch-search-show-result
- 'notmuch-search-show-error
+ (notmuch-sexp-parse-partial-list 'notmuch-search-append-result
results-buf)))))
-(defun notmuch-search-tag-all (&optional tag-changes)
+(defun notmuch-search-tag-all (tag-changes)
"Add/remove tags from all messages in current search buffer.
See `notmuch-tag' for information on the format of TAG-CHANGES."
- (interactive)
- (apply 'notmuch-tag notmuch-search-query-string tag-changes))
+ (interactive
+ (list (notmuch-read-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)
"Returns the title for a buffer with notmuch search results."
@@ -844,14 +861,14 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
(let (longest
(longest-length 0))
(loop for tuple in notmuch-saved-searches
- if (let ((quoted-query (regexp-quote (cdr tuple))))
+ if (let ((quoted-query (regexp-quote (notmuch-saved-search-get tuple :query))))
(and (string-match (concat "^" quoted-query) query)
(> (length (match-string 0 query))
longest-length)))
do (setq longest tuple))
longest))
- (saved-search-name (car saved-search))
- (saved-search-query (cdr saved-search)))
+ (saved-search-name (notmuch-saved-search-get saved-search :name))
+ (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 "*"))
@@ -869,14 +886,21 @@ 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."
- (lexical-let
- ((completions
- (append (list "folder:" "thread:" "id:" "date:" "from:" "to:"
- "subject:" "attachment:")
- (mapcar (lambda (tag)
- (concat "tag:" (notmuch-escape-boolean-term tag)))
- (process-lines notmuch-command "search" "--output=tags" "*")))))
+ (lexical-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 (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)
@@ -894,24 +918,38 @@ PROMPT is the string to prompt with."
(define-key keymap (kbd "TAB") 'minibuffer-complete)
(let ((history-delete-duplicates t))
(read-from-minibuffer prompt nil keymap nil
- 'notmuch-search-history nil nil)))))
+ 'notmuch-search-history current-query nil)))))
+
+(defun notmuch-search-get-query ()
+ "Return the current query in this search buffer"
+ notmuch-search-query-string)
;;;###autoload
-(defun notmuch-search (&optional query oldest-first target-thread target-line continuation)
- "Run \"notmuch search\" with the given `query' and display results.
+(put 'notmuch-search 'notmuch-doc "Search for messages.")
+(defun notmuch-search (&optional query oldest-first target-thread target-line)
+ "Display threads matching QUERY in a notmuch-search buffer.
-If `query' is nil, it is read interactively from the minibuffer.
+If QUERY is nil, it is read interactively from the minibuffer.
Other optional parameters are used as follows:
- oldest-first: A Boolean controlling the sort order of returned threads
- target-thread: A thread ID (without the thread: prefix) that will be made
+ OLDEST-FIRST: A Boolean controlling the sort order of returned threads
+ TARGET-THREAD: A thread ID (without the thread: prefix) that will be made
current if it appears in the search results.
- target-line: The line number to move to if the target thread does not
- appear in the search results."
- (interactive)
- (if (null query)
- (setq query (notmuch-read-query "Notmuch search: ")))
- (let ((buffer (get-buffer-create (notmuch-search-buffer-title query))))
+ TARGET-LINE: The line number to move to if the target thread does not
+ appear in the search results.
+
+When called interactively, this will prompt for a query and use
+the configured default sort order."
+ (interactive
+ (list
+ ;; Prompt for a query
+ nil
+ ;; Use the default search order (if we're doing a search from a
+ ;; search buffer, ignore any buffer-local overrides)
+ (default-value 'notmuch-search-oldest-first)))
+
+ (let* ((query (or query (notmuch-read-query "Notmuch search: ")))
+ (buffer (get-buffer-create (notmuch-search-buffer-title query))))
(switch-to-buffer buffer)
(notmuch-search-mode)
;; Don't track undo information for this buffer
@@ -920,7 +958,7 @@ Other optional parameters are used as follows:
(set 'notmuch-search-oldest-first oldest-first)
(set 'notmuch-search-target-thread target-thread)
(set 'notmuch-search-target-line target-line)
- (set 'notmuch-search-continuation continuation)
+ (notmuch-tag-clear-cache)
(let ((proc (get-buffer-process (current-buffer)))
(inhibit-read-only t))
(if proc
@@ -929,10 +967,9 @@ Other optional parameters are used as follows:
(erase-buffer)
(goto-char (point-min))
(save-excursion
- (let ((proc (start-process
- "notmuch-search" buffer
- notmuch-command "search"
- "--format=json"
+ (let ((proc (notmuch-start-notmuch
+ "notmuch-search" buffer #'notmuch-search-process-sentinel
+ "search" "--format=sexp" "--format-version=2"
(if oldest-first
"--sort=oldest-first"
"--sort=newest-first")
@@ -942,7 +979,6 @@ Other optional parameters are used as follows:
;; should be called no matter how the process dies.
(parse-buf (generate-new-buffer " *notmuch search parse*")))
(process-put proc 'parse-buf parse-buf)
- (set-process-sentinel proc 'notmuch-search-process-sentinel)
(set-process-filter proc 'notmuch-search-process-filter)
(set-process-query-on-exit-flag proc nil))))
(run-hooks 'notmuch-search-hook)))
@@ -959,86 +995,42 @@ same relative position within the new buffer."
(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)
- (continuation notmuch-search-continuation))
- (notmuch-kill-this-buffer)
- (notmuch-search query oldest-first target-thread target-line continuation)
+ (query notmuch-search-query-string))
+ (notmuch-bury-or-kill-this-buffer)
+ (notmuch-search query oldest-first target-thread target-line)
(goto-char (point-min))))
-(defcustom notmuch-poll-script nil
- "An external script to incorporate new mail into the notmuch database.
-
-This variable controls the action invoked by
-`notmuch-search-poll-and-refresh-view' and
-`notmuch-hello-poll-and-update' (each have a default keybinding
-of 'G') to incorporate new mail into the notmuch database.
-
-If set to nil (the default), new mail is processed by invoking
-\"notmuch new\". Otherwise, this should be set to a string that
-gives the name of an external script that processes new mail. If
-set to the empty string, no command will be run.
-
-The external script could do any of the following depending on
-the user's needs:
-
-1. Invoke a program to transfer mail to the local mail store
-2. Invoke \"notmuch new\" to incorporate the new mail
-3. Invoke one or more \"notmuch tag\" commands to classify the mail
-
-Note that the recommended way of achieving the same is using
-\"notmuch new\" hooks."
- :type '(choice (const :tag "notmuch new" nil)
- (const :tag "Disabled" "")
- (string :tag "Custom script"))
- :group 'notmuch-external)
-
-(defun notmuch-poll ()
- "Run \"notmuch new\" or an external script to import mail.
-
-Invokes `notmuch-poll-script', \"notmuch new\", or does nothing
-depending on the value of `notmuch-poll-script'."
- (interactive)
- (if (stringp notmuch-poll-script)
- (unless (string= notmuch-poll-script "")
- (call-process notmuch-poll-script nil nil))
- (call-process notmuch-command nil nil nil "new")))
-
-(defun notmuch-search-poll-and-refresh-view ()
- "Invoke `notmuch-poll' to import mail, then refresh the current view."
- (interactive)
- (notmuch-poll)
- (notmuch-search-refresh-view))
-
(defun notmuch-search-toggle-order ()
"Toggle the current search order.
-By default, the \"inbox\" view created by `notmuch' is displayed
-in chronological order (oldest thread at the beginning of the
-buffer), while any global searches created by `notmuch-search'
-are displayed in reverse-chronological order (newest thread at
-the beginning of the buffer).
-
-This command toggles the sort order for the current search.
-
-Note that any filtered searches created by
-`notmuch-search-filter' retain the search order of the parent
-search."
+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))
(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)
+ (concat "( " query-string " )")
+ query-string))
+
(defun notmuch-search-filter (query)
- "Filter the current search results based on an additional query string.
+ "Filter or LIMIT the current search results based on an additional query string.
Runs a new search matching only messages that match both the
current search results AND the additional query string provided."
(interactive (list (notmuch-read-query "Filter search: ")))
- (let ((grouped-query (if (string-match-p notmuch-search-disjunctive-regexp query)
- (concat "( " query " )")
- query)))
- (notmuch-search (if (string= notmuch-search-query-string "*")
+ (let ((grouped-query (notmuch-group-disjunctive-query-string query))
+ (grouped-original-query (notmuch-group-disjunctive-query-string
+ notmuch-search-query-string)))
+ (notmuch-search (if (string= grouped-original-query "*")
grouped-query
- (concat notmuch-search-query-string " and " grouped-query)) notmuch-search-oldest-first)))
+ (concat grouped-original-query " and " grouped-query))
+ notmuch-search-oldest-first)))
(defun notmuch-search-filter-by-tag (tag)
"Filter the current search results based on a single tag.
@@ -1093,3 +1085,11 @@ notmuch buffers exist, run `notmuch'."
(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.
+ (let ((init-file (locate-file notmuch-init-file '("/")
+ (get-load-suffixes))))
+ (if init-file (load init-file nil t t))))
+
+;;; notmuch.el ends here