X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch.el;h=00cf271a2126574a6425f06898fc0f189dadf164;hb=ecdfa9a6b0d92ebc9bb0a41b597ad7420883d9ca;hp=69954824ec959cd3cb471406c05918ceae4d8e56;hpb=2a91f636d8c3d478619c0a5040685aca1ac75842;p=notmuch diff --git a/emacs/notmuch.el b/emacs/notmuch.el index 69954824..00cf271a 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -58,6 +58,7 @@ (require 'notmuch-hello) (require 'notmuch-maildir-fcc) (require 'notmuch-message) +(require 'notmuch-parser) (defcustom notmuch-search-result-format `(("date" . "%12s ") @@ -69,7 +70,13 @@ 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) @@ -206,8 +213,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) + (define-key map "q" 'notmuch-kill-this-buffer) + (define-key map "x" 'notmuch-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) @@ -250,18 +257,9 @@ For a mouse binding, return nil." (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) @@ -287,18 +285,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." @@ -372,16 +377,22 @@ 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 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: @@ -392,7 +403,6 @@ Complete list of currently available key bindings: (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) (set (make-local-variable 'scroll-preserve-screen-position) t) (add-to-invisibility-spec (cons 'ellipsis t)) (use-local-map notmuch-search-mode-map) @@ -427,25 +437,52 @@ returns nil" (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" @@ -453,19 +490,19 @@ returns nil" (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." @@ -495,19 +532,13 @@ returns nil" (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)) - )))))) +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))) @@ -517,28 +548,21 @@ and will also appear in a buffer named \"*Notmuch errors*\"." (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))) + (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 (funcall '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 (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. @@ -547,7 +571,7 @@ 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))) + (notmuch-search-tag-region beg end tag-changes))) (defun notmuch-search-add-tag () "Same as `notmuch-search-tag' but sets initial input to '+'." @@ -559,12 +583,20 @@ See `notmuch-tag' for information on the format of TAG-CHANGES." (interactive) (notmuch-search-tag "-")) -(defun notmuch-search-archive-thread () - "Archive the currently selected thread (remove its \"inbox\" tag). +(defun notmuch-search-archive-thread (&optional unarchive) + "Archive the currently selected thread. + +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-tag '("-inbox")) + (interactive "P") + (when notmuch-archive-tags + (notmuch-search-tag + (notmuch-tag-change-list notmuch-archive-tags unarchive))) (notmuch-search-next-thread)) (defun notmuch-search-update-result (result &optional pos) @@ -602,6 +634,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 @@ -612,17 +645,19 @@ 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")) @@ -751,11 +786,8 @@ non-authors is found, assume that all of the authors match." (notmuch-search-insert-authors format-string (plist-get result :authors))) ((string-equal field "tags") - ;; Ignore format-string here because notmuch-search-set-tags - ;; depends on the format of this - (insert (concat "(" (propertize - (mapconcat 'identity (plist-get result :tags) " ") - 'font-lock-face 'notmuch-tag-face) ")"))))) + (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." @@ -768,77 +800,25 @@ non-authors is found, assume that all of the authors match." (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) - (put-text-property beg (point) 'notmuch-search-thread-id - (concat "thread:" (plist-get result :thread))) - (put-text-property beg (point) 'notmuch-search-authors - (plist-get result :authors)) - (put-text-property beg (point) 'notmuch-search-subject - (plist-get result :subject))) + (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"))) - -(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 ((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) + (when (buffer-live-p results-buf) (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))))))) + (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. @@ -883,7 +863,7 @@ PROMPT is the string to prompt with." (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 @@ -906,21 +886,30 @@ PROMPT is the string to prompt with." 'notmuch-search-history nil nil))))) ;;;###autoload -(defun notmuch-search (&optional query oldest-first target-thread target-line continuation) +(defun notmuch-search (&optional query oldest-first target-thread target-line) "Run \"notmuch search\" with the given `query' and display results. 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." - (interactive) - (if (null query) - (setq query (notmuch-read-query "Notmuch search: "))) - (let ((buffer (get-buffer-create (notmuch-search-buffer-title query)))) + 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 @@ -929,7 +918,6 @@ 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) (let ((proc (get-buffer-process (current-buffer))) (inhibit-read-only t)) (if proc @@ -938,10 +926,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=1" (if oldest-first "--sort=oldest-first" "--sort=newest-first") @@ -950,11 +937,7 @@ Other optional parameters are used as follows: ;; 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)))) (run-hooks 'notmuch-search-hook))) @@ -970,11 +953,10 @@ 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)) - (query notmuch-search-query-string) - (continuation notmuch-search-continuation)) + (target-thread (notmuch-search-find-thread-id 'bare)) + (query notmuch-search-query-string)) (notmuch-kill-this-buffer) - (notmuch-search query oldest-first target-thread target-line continuation) + (notmuch-search query oldest-first target-thread target-line) (goto-char (point-min)))) (defcustom notmuch-poll-script nil @@ -1024,17 +1006,8 @@ depending on the value of `notmuch-poll-script'." (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))