X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch.el;h=1c43d3ee19358fd9e891c53c9c60d3c6e818af4e;hp=a6724fabc032263df85a05665a034a3ad2053763;hb=c62126238b2ce6194b3c6511553951497aedf295;hpb=cbba1d1ba9781e79d1af39c165accd8d137a815f diff --git a/emacs/notmuch.el b/emacs/notmuch.el index a6724fab..1c43d3ee 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -48,11 +48,11 @@ ;; 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) @@ -60,7 +60,7 @@ (require 'notmuch-message) (defcustom notmuch-search-result-format - `(("date" . "%s ") + `(("date" . "%12s ") ("count" . "%-7s ") ("authors" . "%-20s ") ("subject" . "%s ") @@ -69,75 +69,19 @@ 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") -(defvar notmuch-select-tag-history nil - "Variable to store minibuffer history for -`notmuch-select-tag-with-completion' function.") - -(defvar notmuch-read-tag-changes-history nil - "Variable to store minibuffer history for -`notmuch-read-tag-changes' function.") - -(defun notmuch-tag-completions (&optional search-terms) - (if (null search-terms) - (setq search-terms (list "*"))) - (split-string - (with-output-to-string - (with-current-buffer standard-output - (apply 'call-process notmuch-command nil t - nil "search" "--output=tags" "--exclude=false" search-terms))) - "\n+" t)) - -(defun notmuch-select-tag-with-completion (prompt &rest search-terms) - (let ((tag-list (notmuch-tag-completions search-terms))) - (completing-read prompt tag-list nil nil nil 'notmuch-select-tag-history))) - -(defun notmuch-read-tag-changes (&optional initial-input &rest search-terms) - (let* ((all-tag-list (notmuch-tag-completions)) - (add-tag-list (mapcar (apply-partially 'concat "+") all-tag-list)) - (remove-tag-list (mapcar (apply-partially 'concat "-") - (if (null search-terms) - all-tag-list - (notmuch-tag-completions search-terms)))) - (tag-list (append add-tag-list remove-tag-list)) - (crm-separator " ") - ;; By default, space is bound to "complete word" function. - ;; Re-bind it to insert a space instead. Note that - ;; 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 "Tags (+add -drop): " - tag-list nil nil initial-input - 'notmuch-read-tag-changes-history)))) - -(defun notmuch-update-tags (tags tag-changes) - "Return a copy of TAGS with additions and removals from TAG-CHANGES. - -TAG-CHANGES must be a list of tags names, each prefixed with -either a \"+\" to indicate the tag should be added to TAGS if not -present or a \"-\" to indicate that the tag should be removed -from TAGS if present." - (let ((result-tags (copy-sequence tags))) - (dolist (tag-change tag-changes) - (let ((op (string-to-char tag-change)) - (tag (unless (string= tag-change "") (substring tag-change 1)))) - (case op - (?+ (unless (member tag result-tags) - (push tag result-tags))) - (?- (setq result-tags (delete tag result-tags))) - (otherwise - (error "Changed tag must be of the form `+this_tag' or `-that_tag'"))))) - (sort result-tags 'string<))) - (defun notmuch-foreach-mime-part (function mm-handle) (cond ((stringp (car mm-handle)) (dolist (part (cdr mm-handle)) @@ -349,18 +293,25 @@ For a mouse binding, return nil." (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." @@ -437,8 +388,9 @@ 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 or remove a tag from all -threads in the current buffer. +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 @@ -463,25 +415,78 @@ 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" @@ -489,19 +494,19 @@ Complete list of currently available key bindings: (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 () "Display the currently selected thread." @@ -545,115 +550,38 @@ and will also appear in a buffer named \"*Notmuch errors*\"." (error (buffer-substring beg end)) )))))) -(defun notmuch-tag (query &rest tag-changes) - "Add/remove tags in TAG-CHANGES to messages matching QUERY. - -TAG-CHANGES 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 - (mapc (lambda (tag-change) - (unless (string-match-p "^[-+]\\S-+$" tag-change) - (error "Tag must be of the form `+this_tag' or `-that_tag'"))) - tag-changes) - (unless (null tag-changes) - (run-hooks 'notmuch-before-tag-hook) - (apply 'notmuch-call-notmuch-process "tag" - (append tag-changes (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" - - :type 'hook - :options '(notmuch-hl-line-mode) - :group 'notmuch-hooks) - -(defcustom notmuch-after-tag-hook nil - "Hooks that are run after tags of a message are modified. - -'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 '(notmuch-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))) -(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-get-tags (&optional pos) + (plist-get (notmuch-search-get-result pos) :tags)) (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-tag-thread (&rest tag-changes) - "Change tags for the currently selected thread. - -See `notmuch-search-tag-region' for details." - (apply 'notmuch-search-tag-region (point) (point) tag-changes)) - -(defun notmuch-search-tag-region (beg end &rest tag-changes) - "Change tags for threads in the given region. - -TAGS is a list of tag operations for `notmuch-tag'. The tags are -added or removed for all threads in the region from BEG to 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))) - (apply 'notmuch-tag search-string tag-changes) - (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 - (notmuch-update-tags (notmuch-search-get-tags) tag-changes)) - (forward-line)))))) + (setq tag-changes (funcall '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-tag (&optional initial-input) - "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))) - (search-string (notmuch-search-find-thread-id-region-search beg end)) - (tags (notmuch-read-tag-changes initial-input search-string))) - (apply 'notmuch-search-tag-region beg end tags))) + (end (if (region-active-p) (region-end) (point)))) + (funcall 'notmuch-search-tag-region beg end tag-changes))) (defun notmuch-search-add-tag () "Same as `notmuch-search-tag' but sets initial input to '+'." @@ -670,12 +598,36 @@ added or removed for all threads in the region from BEG to END." This function advances the next thread when finished." (interactive) - (notmuch-search-tag-thread "-inbox") + (notmuch-search-tag '("-inbox")) (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" @@ -683,7 +635,8 @@ This function advances the next thread when finished." (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)) + (kill-buffer (process-get proc 'parse-buf)) (if (buffer-live-p buffer) (with-current-buffer buffer (save-excursion @@ -693,8 +646,6 @@ This function advances the next thread when finished." (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))) @@ -728,20 +679,13 @@ foreground and blue background." (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 @@ -823,91 +767,110 @@ non-authors is found, assume that all of the authors match." (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) ")"))))) + (let ((tags-str (mapconcat 'identity (plist-get result :tags) " "))) + (insert (propertize (format format-string tags-str) + 'face 'notmuch-tag-face)))))) + +(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-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"))) -(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")) +(defvar notmuch-search-process-state nil + "Parsing state of the search process filter.") + +(defvar notmuch-search-json-parser nil + "Incremental JSON parser for the search process filter.") (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"))) - ;; We currently just throw away excluded matches. - (unless (eq (aref count 1) ?0) - (let ((beg (point))) - (notmuch-search-show-result date count authors 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-tag-all (&rest tag-changes) - "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-read-tag-changes)) + (let ((results-buf (process-buffer proc)) + (parse-buf (process-get proc 'parse-buf)) + (inhibit-read-only t) + done) + (if (not (buffer-live-p results-buf)) + (delete-process proc) + (with-current-buffer parse-buf + ;; Insert new data + (save-excursion + (goto-char (point-max)) + (insert string))) + (with-current-buffer results-buf + (while (not done) + (condition-case nil + (case notmuch-search-process-state + ((begin) + ;; Enter the results list + (if (eq (notmuch-json-begin-compound + notmuch-search-json-parser) 'retry) + (setq done t) + (setq notmuch-search-process-state 'result))) + ((result) + ;; Parse a result + (let ((result (notmuch-json-read notmuch-search-json-parser))) + (case result + ((retry) (setq done t)) + ((end) (setq notmuch-search-process-state 'end)) + (otherwise (notmuch-search-show-result result))))) + ((end) + ;; Any trailing data is unexpected + (notmuch-json-eof notmuch-search-json-parser) + (setq done t))) + (json-error + ;; Do our best to resynchronize and ensure forward + ;; progress + (notmuch-search-show-error + "%s" + (with-current-buffer parse-buf + (let ((bad (buffer-substring (line-beginning-position) + (line-end-position)))) + (forward-line) + bad)))))) + ;; Clear out what we've parsed + (with-current-buffer parse-buf + (delete-region (point-min) (point))))))) + +(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) @@ -976,7 +939,7 @@ 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 (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." @@ -1004,10 +967,19 @@ Other optional parameters are used as follows: (let ((proc (start-process "notmuch-search" buffer notmuch-command "search" + "--format=json" (if oldest-first "--sort=oldest-first" "--sort=newest-first") - query))) + query)) + ;; Use a scratch buffer to accumulate partial output. + ;; This buffer will be killed by the sentinel, which + ;; should be called no matter how the process dies. + (parse-buf (generate-new-buffer " *notmuch search parse*"))) + (set (make-local-variable 'notmuch-search-process-state) 'begin) + (set (make-local-variable 'notmuch-search-json-parser) + (notmuch-json-create-parser parse-buf)) + (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)))) @@ -1024,7 +996,7 @@ 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)) + (target-thread (notmuch-search-find-thread-id 'bare)) (query notmuch-search-query-string) (continuation notmuch-search-continuation)) (notmuch-kill-this-buffer)