;; required, but is available from http://notmuchmail.org).
(eval-when-compile (require 'cl))
-(require 'crm)
(require 'mm-view)
(require 'message)
(require 'notmuch-lib)
+(require 'notmuch-tag)
(require 'notmuch-show)
(require 'notmuch-mua)
(require 'notmuch-hello)
(require 'notmuch-maildir-fcc)
(require 'notmuch-message)
+(require 'notmuch-parser)
(defcustom notmuch-search-result-format
- `(("date" . "%s ")
+ `(("date" . "%12s ")
("count" . "%-7s ")
("authors" . "%-20s ")
("subject" . "%s ")
date, count, authors, subject, tags
For example:
(setq notmuch-search-result-format \(\(\"authors\" . \"%-40s\"\)
- \(\"subject\" . \"%s\"\)\)\)"
+ \(\"subject\" . \"%s\"\)\)\)
+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))
:group 'notmuch-search)
(defvar notmuch-query-history nil
"Variable to store minibuffer history for notmuch queries")
-(defun notmuch-tag-completions (&optional prefixes search-terms)
- (let ((tag-list
- (split-string
- (with-output-to-string
- (with-current-buffer standard-output
- (apply 'call-process notmuch-command nil t
- nil "search-tags" search-terms)))
- "\n+" t)))
- (if (null prefixes)
- tag-list
- (apply #'append
- (mapcar (lambda (tag)
- (mapcar (lambda (prefix)
- (concat prefix tag)) prefixes))
- tag-list)))))
-
-(defun notmuch-select-tag-with-completion (prompt &rest search-terms)
- (let ((tag-list (notmuch-tag-completions nil search-terms)))
- (completing-read prompt tag-list)))
-
-(defun notmuch-select-tags-with-completion (prompt &optional prefixes &rest search-terms)
- (let ((tag-list (notmuch-tag-completions prefixes search-terms))
- (crm-separator " ")
- ;; By default, space is bound to "complete word" function.
- ;; Re-bind it to insert a space instead. Note that <tab>
- ;; still does the completion.
- (crm-local-completion-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map crm-local-completion-map)
- (define-key map " " 'self-insert-command)
- map)))
- (delete "" (completing-read-multiple prompt tag-list))))
-
(defun notmuch-foreach-mime-part (function mm-handle)
(cond ((stringp (car mm-handle))
(dolist (part (cdr mm-handle))
(set-buffer-modified-p nil)
(view-buffer (current-buffer) 'kill-buffer-if-not-modified))))
-(defcustom notmuch-search-hook '(hl-line-mode)
+(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 '(hl-line-mode)
+ :options '(notmuch-hl-line-mode)
:group 'notmuch-search
:group 'notmuch-hooks)
(define-key map "t" 'notmuch-search-filter-by-tag)
(define-key map "f" 'notmuch-search-filter)
(define-key map [mouse-1] 'notmuch-search-show-thread)
- (define-key map "*" 'notmuch-search-operate-all)
+ (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)
(defun notmuch-search-next-thread ()
"Select the next thread in the search results."
(interactive)
- (forward-line 1))
+ (when (notmuch-search-get-result)
+ (goto-char (notmuch-search-result-end))))
(defun notmuch-search-previous-thread ()
"Select the previous thread in the search results."
(interactive)
- (forward-line -1))
+ (if (notmuch-search-get-result)
+ (unless (bobp)
+ (goto-char (notmuch-search-result-beginning (- (point) 1))))
+ ;; We must be past the end; jump to the last result
+ (notmuch-search-last-thread)))
(defun notmuch-search-last-thread ()
"Select the last thread in the search results."
(interactive)
(goto-char (point-max))
- (forward-line -2))
+ (forward-line -2)
+ (let ((beg (notmuch-search-result-beginning)))
+ (when beg (goto-char beg))))
(defun notmuch-search-first-thread ()
"Select the first thread in the search results."
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-operate-all]' key can be used to add or remove a tag from all
-threads in the current 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:
mode-name "notmuch-search")
(setq buffer-read-only t))
+(defun notmuch-search-get-result (&optional pos)
+ "Return the result object for the thread at POS (or point).
+
+If there is no thread at POS (or point), returns nil."
+ (get-text-property (or pos (point)) 'notmuch-search-result))
+
+(defun notmuch-search-result-beginning (&optional pos)
+ "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))))
+
+(defun notmuch-search-result-end (&optional pos)
+ "Return the point at the end of the thread at POS (or point).
+
+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))))
+
+(defun notmuch-search-foreach-result (beg end function)
+ "Invoke FUNCTION for each result between BEG and END.
+
+FUNCTION 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), FUNCTION will be applied to the result containing point
+BEG."
+
+ (lexical-let ((pos (notmuch-search-result-beginning beg))
+ ;; End must be a marker in case function changes the
+ ;; text.
+ (end (copy-marker end))
+ ;; Make sure we examine at least one result, even if
+ ;; (= beg end).
+ (first t))
+ ;; We have to be careful if the region extends beyond the results.
+ ;; In this case, pos could be null or there could be no result at
+ ;; pos.
+ (while (and pos (or (< pos end) first))
+ (when (notmuch-search-get-result pos)
+ (funcall function pos))
+ (setq pos (notmuch-search-result-end pos)
+ 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)
+
(defun notmuch-search-properties-in-region (property beg end)
- (save-excursion
- (let ((output nil)
- (last-line (line-number-at-pos end))
- (max-line (- (line-number-at-pos (point-max)) 2)))
- (goto-char beg)
- (beginning-of-line)
- (while (<= (line-number-at-pos) (min last-line max-line))
- (setq output (cons (get-text-property (point) property) output))
- (forward-line 1))
- output)))
-
-(defun notmuch-search-find-thread-id ()
- "Return the thread for the current thread"
- (get-text-property (point) 'notmuch-search-thread-id))
+ (let (output)
+ (notmuch-search-foreach-result beg end
+ (lambda (pos)
+ (push (plist-get (notmuch-search-get-result pos) property) output)))
+ output))
+
+(defun notmuch-search-find-thread-id (&optional bare)
+ "Return the thread for the current thread
+
+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"
- (notmuch-search-properties-in-region 'notmuch-search-thread-id beg end))
+ (mapcar (lambda (thread) (concat "thread:" thread))
+ (notmuch-search-properties-in-region :thread beg end)))
+
+(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-authors ()
"Return the authors for the current thread"
- (get-text-property (point) 'notmuch-search-authors))
+ (plist-get (notmuch-search-get-result) :authors))
(defun notmuch-search-find-authors-region (beg end)
"Return a list of authors for the current region"
- (notmuch-search-properties-in-region 'notmuch-search-authors beg end))
+ (notmuch-search-properties-in-region :authors beg end))
(defun notmuch-search-find-subject ()
"Return the subject for the current thread"
- (get-text-property (point) 'notmuch-search-subject))
+ (plist-get (notmuch-search-get-result) :subject))
(defun notmuch-search-find-subject-region (beg end)
"Return a list of authors for the current region"
- (notmuch-search-properties-in-region 'notmuch-search-subject beg end))
+ (notmuch-search-properties-in-region :subject beg end))
-(defun notmuch-search-show-thread (&optional crypto-switch)
+(defun notmuch-search-show-thread ()
"Display the currently selected thread."
- (interactive "P")
+ (interactive)
(let ((thread-id (notmuch-search-find-thread-id))
- (subject (notmuch-prettify-subject (notmuch-search-find-subject))))
+ (subject (notmuch-search-find-subject)))
(if (> (length thread-id) 0)
(notmuch-show thread-id
(current-buffer)
notmuch-search-query-string
;; Name the buffer based on the subject.
- (concat "*" (truncate-string-to-width subject 30 nil nil t) "*")
- crypto-switch)
+ (concat "*" (truncate-string-to-width subject 30 nil nil t) "*"))
(message "End of search results."))))
(defun notmuch-search-reply-to-thread (&optional prompt-for-sender)
(defun notmuch-call-notmuch-process (&rest args)
"Synchronously invoke \"notmuch\" with the given list of arguments.
-Output from the process will be presented to the user as an error
-and will also appear in a buffer named \"*Notmuch errors*\"."
- (let ((error-buffer (get-buffer-create "*Notmuch errors*")))
- (with-current-buffer error-buffer
- (erase-buffer))
- (if (eq (apply 'call-process notmuch-command nil error-buffer nil args) 0)
- (point)
- (progn
- (with-current-buffer error-buffer
- (let ((beg (point-min))
- (end (- (point-max) 1)))
- (error (buffer-substring beg end))
- ))))))
-
-(defun notmuch-tag (query &rest tags)
- "Add/remove tags in TAGS to messages matching QUERY.
-
-TAGS should be a list of strings of the form \"+TAG\" or \"-TAG\" and
-QUERY should be a string containing the search-query.
-
-Note: Other code should always use this function alter tags of
-messages instead of running (notmuch-call-notmuch-process \"tag\" ..)
-directly, so that hooks specified in notmuch-before-tag-hook and
-notmuch-after-tag-hook will be run."
- ;; Perform some validation
- (when (null tags) (error "No tags given"))
- (mapc (lambda (tag)
- (unless (string-match-p "^[-+][-+_.[:word:]]+$" tag)
- (error "Tag must be of the form `+this_tag' or `-that_tag'")))
- tags)
- (run-hooks 'notmuch-before-tag-hook)
- (apply 'notmuch-call-notmuch-process
- (append (list "tag") tags (list "--" query)))
- (run-hooks 'notmuch-after-tag-hook))
-
-(defcustom notmuch-before-tag-hook nil
- "Hooks that are run before tags of a message are modified.
-
-'tags' will contain the tags that are about to be added or removed as
-a list of strings of the form \"+TAG\" or \"-TAG\".
-'query' will be a string containing the search query that determines
-the messages that are about to be tagged"
+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)))))
- :type 'hook
- :options '(hl-line-mode)
- :group 'notmuch-hooks)
+(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)))
-(defcustom notmuch-after-tag-hook nil
- "Hooks that are run after tags of a message are modified.
+(defun notmuch-search-get-tags (&optional pos)
+ (plist-get (notmuch-search-get-result pos) :tags))
-'tags' will contain the tags that were added or removed as
-a list of strings of the form \"+TAG\" or \"-TAG\".
-'query' will be a string containing the search query that determines
-the messages that were tagged"
- :type 'hook
- :options '(hl-line-mode)
- :group 'notmuch-hooks)
+(defun notmuch-search-get-tags-region (beg end)
+ (let (output)
+ (notmuch-search-foreach-result beg end
+ (lambda (pos)
+ (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 (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.
+
+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))))
+ (notmuch-search-tag-region beg end tag-changes)))
-(defun notmuch-search-set-tags (tags)
- (save-excursion
- (end-of-line)
- (re-search-backward "(")
- (forward-char)
- (let ((beg (point))
- (inhibit-read-only t))
- (re-search-forward ")")
- (backward-char)
- (let ((end (point)))
- (delete-region beg end)
- (insert (propertize (mapconcat 'identity tags " ")
- 'face 'notmuch-tag-face))))))
-
-(defun notmuch-search-get-tags ()
- (save-excursion
- (end-of-line)
- (re-search-backward "(")
- (let ((beg (+ (point) 1)))
- (re-search-forward ")")
- (let ((end (- (point) 1)))
- (split-string (buffer-substring-no-properties beg end))))))
+(defun notmuch-search-add-tag ()
+ "Same as `notmuch-search-tag' but sets initial input to '+'."
+ (interactive)
+ (notmuch-search-tag "+"))
-(defun notmuch-search-get-tags-region (beg end)
- (save-excursion
- (let ((output nil)
- (last-line (line-number-at-pos end))
- (max-line (- (line-number-at-pos (point-max)) 2)))
- (goto-char beg)
- (while (<= (line-number-at-pos) (min last-line max-line))
- (setq output (append output (notmuch-search-get-tags)))
- (forward-line 1))
- output)))
-
-(defun notmuch-search-add-tag-thread (tag)
- (notmuch-search-add-tag-region tag (point) (point)))
-
-(defun notmuch-search-add-tag-region (tag beg end)
- (let ((search-id-string (mapconcat 'identity (notmuch-search-find-thread-id-region beg end) " or ")))
- (notmuch-tag search-id-string (concat "+" tag))
- (save-excursion
- (let ((last-line (line-number-at-pos end))
- (max-line (- (line-number-at-pos (point-max)) 2)))
- (goto-char beg)
- (while (<= (line-number-at-pos) (min last-line max-line))
- (notmuch-search-set-tags (delete-dups (sort (cons tag (notmuch-search-get-tags)) 'string<)))
- (forward-line))))))
-
-(defun notmuch-search-remove-tag-thread (tag)
- (notmuch-search-remove-tag-region tag (point) (point)))
-
-(defun notmuch-search-remove-tag-region (tag beg end)
- (let ((search-id-string (mapconcat 'identity (notmuch-search-find-thread-id-region beg end) " or ")))
- (notmuch-tag search-id-string (concat "-" tag))
- (save-excursion
- (let ((last-line (line-number-at-pos end))
- (max-line (- (line-number-at-pos (point-max)) 2)))
- (goto-char beg)
- (while (<= (line-number-at-pos) (min last-line max-line))
- (notmuch-search-set-tags (delete tag (notmuch-search-get-tags)))
- (forward-line))))))
+(defun notmuch-search-remove-tag ()
+ "Same as `notmuch-search-tag' but sets initial input to '-'."
+ (interactive)
+ (notmuch-search-tag "-"))
-(defun notmuch-search-add-tag (tag)
- "Add a tag to the currently selected thread or region.
+(defun notmuch-search-archive-thread (&optional unarchive)
+ "Archive the currently selected thread.
-The tag is added to all messages in the currently selected thread
-or threads in the current region."
- (interactive
- (list (notmuch-select-tag-with-completion "Tag to add: ")))
- (save-excursion
- (if (region-active-p)
- (let* ((beg (region-beginning))
- (end (region-end)))
- (notmuch-search-add-tag-region tag beg end))
- (notmuch-search-add-tag-thread tag))))
-
-(defun notmuch-search-remove-tag (tag)
- "Remove a tag from the currently selected thread or region.
-
-The tag is removed from all messages in the currently selected
-thread or threads in the current region."
- (interactive
- (list (notmuch-select-tag-with-completion
- "Tag to remove: "
- (if (region-active-p)
- (mapconcat 'identity
- (notmuch-search-find-thread-id-region (region-beginning) (region-end))
- " ")
- (notmuch-search-find-thread-id)))))
- (save-excursion
- (if (region-active-p)
- (let* ((beg (region-beginning))
- (end (region-end)))
- (notmuch-search-remove-tag-region tag beg end))
- (notmuch-search-remove-tag-thread tag))))
-
-(defun notmuch-search-archive-thread ()
- "Archive the currently selected thread (remove its \"inbox\" tag).
+Archive each message in the currently selected thread by applying
+the tag changes in `notmuch-archive-tags' to each (remove the
+\"inbox\" tag by default). If a prefix argument is given, the
+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)
- (notmuch-search-remove-tag-thread "inbox")
+ (interactive "P")
+ (when notmuch-archive-tags
+ (notmuch-search-tag
+ (notmuch-tag-change-list notmuch-archive-tags unarchive)))
(notmuch-search-next-thread))
-(defvar notmuch-search-process-filter-data nil
- "Data that has not yet been processed.")
-(make-variable-buffer-local 'notmuch-search-process-filter-data)
+(defun notmuch-search-update-result (result &optional pos)
+ "Replace the result object of the thread at POS (or point) by
+RESULT and redraw it.
+
+This will keep point in a reasonable location. However, if there
+are enclosing save-excursions and the saved point is in the
+result being updated, the point will be restored to the beginning
+of the result."
+ (let ((start (notmuch-search-result-beginning pos))
+ (end (notmuch-search-result-end pos))
+ (init-point (point))
+ (inhibit-read-only t))
+ ;; Delete the current thread
+ (delete-region start end)
+ ;; Insert the updated thread
+ (notmuch-search-show-result result start)
+ ;; If point was inside the old result, make an educated guess
+ ;; about where to place it now. Unfortunately, this won't work
+ ;; with save-excursion (or any other markers that would be nice to
+ ;; preserve, such as the window start), but there's nothing we can
+ ;; do about that without a way to retrieve markers in a region.
+ (when (and (>= init-point start) (<= init-point end))
+ (let* ((new-end (notmuch-search-result-end start))
+ (new-point (if (= init-point end)
+ new-end
+ (min init-point (- new-end 1)))))
+ (goto-char new-point)))))
(defun notmuch-search-process-sentinel (proc msg)
"Add a message to let user know when \"notmuch search\" exits"
(status (process-status proc))
(exit-status (process-exit-status proc))
(never-found-target-thread nil))
- (if (memq status '(exit signal))
+ (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
(if (eq status 'signal)
(insert "Incomplete search results (search process was killed).\n"))
(when (eq status 'exit)
- (if notmuch-search-process-filter-data
- (insert (concat "Error: Unexpected output from notmuch search:\n" notmuch-search-process-filter-data)))
- (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 nil
+(defcustom notmuch-search-line-faces '(("unread" :weight bold)
+ ("flagged" :foreground "blue"))
"Tag/face mapping for line highlighting in notmuch-search.
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 '((\"delete\" . (:foreground \"red\"
+ (setq notmuch-search-line-faces '((\"deleted\" . (:foreground \"red\"
:background \"blue\"))
(\"unread\" . (:foreground \"green\"))))
The attributes defined for matching tags are merged, with later
-attributes overriding earlier. A message having both \"delete\"
+attributes overriding earlier. 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))
(defun notmuch-search-color-line (start end line-tag-list)
"Colorize lines in `notmuch-show' based on tags."
- ;; Create the overlay only if the message has tags which match one
- ;; of those specified in `notmuch-search-line-faces'.
- (let (overlay)
- (mapc (lambda (elem)
- (let ((tag (car elem))
- (attributes (cdr elem)))
- (when (member tag line-tag-list)
- (when (not overlay)
- (setq overlay (make-overlay start end)))
- ;; Merge the specified properties with any already
- ;; applied from an earlier match.
- (overlay-put overlay 'face
- (append (overlay-get overlay 'face) attributes)))))
- notmuch-search-line-faces)))
+ (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)))
(defun notmuch-search-author-propertize (authors)
"Split `authors' into matching and non-matching authors and
(overlay-put overlay 'isearch-open-invisible #'delete-overlay)))
(insert padding))))
-(defun notmuch-search-insert-field (field date count authors subject tags)
+(defun notmuch-search-insert-field (field format-string result)
(cond
((string-equal field "date")
- (insert (propertize (format (cdr (assoc field notmuch-search-result-format)) date)
+ (insert (propertize (format format-string (plist-get result :date_relative))
'face 'notmuch-search-date)))
((string-equal field "count")
- (insert (propertize (format (cdr (assoc field notmuch-search-result-format)) 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 (cdr (assoc field notmuch-search-result-format)) subject)
+ (insert (propertize (format format-string (plist-get result :subject))
'face 'notmuch-search-subject)))
((string-equal field "authors")
- (notmuch-search-insert-authors (cdr (assoc field notmuch-search-result-format)) authors))
+ (notmuch-search-insert-authors format-string (plist-get result :authors)))
((string-equal field "tags")
- (insert (concat "(" (propertize tags 'font-lock-face 'notmuch-tag-face) ")")))))
-
-(defun notmuch-search-show-result (date count authors subject tags)
- (let ((fields) (field))
- (setq fields (mapcar 'car notmuch-search-result-format))
- (loop for field in fields
- do (notmuch-search-insert-field field date count authors subject tags)))
- (insert "\n"))
+ (let ((tags (plist-get result :tags)))
+ (insert (format format-string (notmuch-tag-format-tags tags)))))))
+
+(defun notmuch-search-show-result (result &optional pos)
+ "Insert RESULT at POS or the end of the buffer if POS is null."
+ ;; 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-process-filter (proc string)
"Process and filter the output of \"notmuch search\""
- (let ((buffer (process-buffer proc))
- (found-target nil))
- (if (buffer-live-p buffer)
- (with-current-buffer buffer
- (save-excursion
- (let ((line 0)
- (more t)
- (inhibit-read-only t)
- (string (concat notmuch-search-process-filter-data string)))
- (setq notmuch-search-process-filter-data nil)
- (while more
- (while (and (< line (length string)) (= (elt string line) ?\n))
- (setq line (1+ line)))
- (if (string-match "^\\(thread:[0-9A-Fa-f]*\\) \\([^][]*\\) \\(\\[[0-9/]*\\]\\) \\([^;]*\\); \\(.*\\) (\\([^()]*\\))$" string line)
- (let* ((thread-id (match-string 1 string))
- (date (match-string 2 string))
- (count (match-string 3 string))
- (authors (match-string 4 string))
- (subject (match-string 5 string))
- (tags (match-string 6 string))
- (tag-list (if tags (save-match-data (split-string tags)))))
- (goto-char (point-max))
- (if (/= (match-beginning 1) line)
- (insert (concat "Error: Unexpected output from notmuch search:\n" (substring string line (match-beginning 1)) "\n")))
- (let ((beg (point)))
- (notmuch-search-show-result date count authors
- (notmuch-prettify-subject subject) tags)
- (notmuch-search-color-line beg (point) tag-list)
- (put-text-property beg (point) 'notmuch-search-thread-id thread-id)
- (put-text-property beg (point) 'notmuch-search-authors authors)
- (put-text-property beg (point) 'notmuch-search-subject subject)
- (when (string= thread-id notmuch-search-target-thread)
- (set 'found-target beg)
- (set 'notmuch-search-target-thread "found")))
- (set 'line (match-end 0)))
- (set 'more nil)
- (while (and (< line (length string)) (= (elt string line) ?\n))
- (setq line (1+ line)))
- (if (< line (length string))
- (setq notmuch-search-process-filter-data (substring string line)))
- ))))
- (if found-target
- (goto-char found-target)))
- (delete-process proc))))
-
-(defun notmuch-search-operate-all (&rest actions)
- "Add/remove tags from all matching messages.
-
-This command adds or removes tags from all messages matching the
-current search terms. When called interactively, this command
-will prompt for tags to be added or removed. Tags prefixed with
-'+' will be added and tags prefixed with '-' will be removed.
-
-Each character of the tag name may consist of alphanumeric
-characters as well as `_.+-'.
-"
- (interactive (notmuch-select-tags-with-completion
- "Operations (+add -drop): notmuch tag "
- '("+" "-")))
- (apply 'notmuch-tag notmuch-search-query-string actions))
+ (let ((results-buf (process-buffer proc))
+ (parse-buf (process-get proc 'parse-buf))
+ (inhibit-read-only t)
+ done)
+ (when (buffer-live-p results-buf)
+ (with-current-buffer parse-buf
+ ;; Insert new data
+ (save-excursion
+ (goto-char (point-max))
+ (insert string))
+ (notmuch-sexp-parse-partial-list 'notmuch-search-show-result
+ results-buf)))))
+
+(defun notmuch-search-tag-all (&optional 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))
(defun notmuch-search-buffer-title (query)
"Returns the title for a buffer with notmuch search results."
(append (list "folder:" "thread:" "id:" "date:" "from:" "to:"
"subject:" "attachment:")
(mapcar (lambda (tag)
- (concat "tag:" tag))
+ (concat "tag:" (notmuch-escape-boolean-term tag)))
(process-lines notmuch-command "search" "--output=tags" "*")))))
(let ((keymap (copy-keymap minibuffer-local-map))
(minibuffer-completion-table
completions)))
(t (list string)))))))
;; this was simpler than convincing completing-read to accept spaces:
- (define-key keymap (kbd "<tab>") 'minibuffer-complete)
+ (define-key keymap (kbd "TAB") 'minibuffer-complete)
(let ((history-delete-duplicates t))
(read-from-minibuffer prompt nil keymap nil
'notmuch-search-history nil nil)))))
Other optional parameters are used as follows:
oldest-first: A Boolean controlling the sort order of returned threads
- target-thread: A thread ID (with the thread: prefix) that will be made
+ 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))))
+ (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
(erase-buffer)
(goto-char (point-min))
(save-excursion
- (let ((proc (start-process
- "notmuch-search" buffer
- notmuch-command "search"
+ (let ((proc (notmuch-start-notmuch
+ "notmuch-search" buffer #'notmuch-search-process-sentinel
+ "search" "--format=sexp" "--format-version=1"
(if oldest-first
"--sort=oldest-first"
"--sort=newest-first")
- query)))
- (set-process-sentinel proc 'notmuch-search-process-sentinel)
+ 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)
(set-process-filter proc 'notmuch-search-process-filter)
(set-process-query-on-exit-flag proc nil))))
(run-hooks 'notmuch-search-hook)))
(interactive)
(let ((target-line (line-number-at-pos))
(oldest-first notmuch-search-oldest-first)
- (target-thread (notmuch-search-find-thread-id))
+ (target-thread (notmuch-search-find-thread-id 'bare))
(query notmuch-search-query-string)
(continuation notmuch-search-continuation))
(notmuch-kill-this-buffer)
(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))