X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=contrib%2Fnotmuch-pick%2Fnotmuch-pick.el;h=755cbbce008bafb8aeae3ade71f3ef19c123caca;hb=0f066ece0f6aa7c02116f8ba3f06b5a005091678;hp=db2a7cb94f7622285cc5d716cb5df966bb28d349;hpb=96d9f54615b404011c11fecdea6135fe684c7235;p=notmuch diff --git a/contrib/notmuch-pick/notmuch-pick.el b/contrib/notmuch-pick/notmuch-pick.el index db2a7cb9..755cbbce 100644 --- a/contrib/notmuch-pick/notmuch-pick.el +++ b/contrib/notmuch-pick/notmuch-pick.el @@ -35,7 +35,6 @@ (declare-function notmuch-show "notmuch-show" (&rest args)) (declare-function notmuch-tag "notmuch" (query &rest tags)) (declare-function notmuch-show-strip-re "notmuch-show" (subject)) -(declare-function notmuch-show-clean-address "notmuch-show" (parsed-address)) (declare-function notmuch-show-spaces-n "notmuch-show" (n)) (declare-function notmuch-read-query "notmuch" (prompt)) (declare-function notmuch-read-tag-changes "notmuch" (&optional initial-input &rest search-terms)) @@ -438,7 +437,7 @@ Does NOT change the database." (unless (notmuch-pick-get-match) (notmuch-pick-next-matching-message)) (while (and (not (notmuch-pick-get-match)) - (not (eq notmuch-pick-process-state 'end))) + (get-buffer-process (current-buffer))) (message "waiting for message") (sit-for 0.1) (goto-char (point-min)) @@ -521,62 +520,16 @@ than only the current message." (message (format "Command '%s' exited abnormally with code %d" shell-command exit-code))))))) -;; Shamelessly stolen from notmuch-show.el: should be unified. (defun notmuch-pick-clean-address (address) - "Try to clean a single email ADDRESS for display. Return + "Try to clean a single email ADDRESS for display. Return +AUTHOR_NAME if present, otherwise return AUTHOR_EMAIL. Return unchanged ADDRESS if parsing fails." - (condition-case nil - (let (p-name p-address) - ;; It would be convenient to use `mail-header-parse-address', - ;; but that expects un-decoded mailbox parts, whereas our - ;; mailbox parts are already decoded (and hence may contain - ;; UTF-8). Given that notmuch should handle most of the awkward - ;; cases, some simple string deconstruction should be sufficient - ;; here. - (cond - ;; "User " style. - ((string-match "\\(.*\\) <\\(.*\\)>" address) - (setq p-name (match-string 1 address) - p-address (match-string 2 address))) - - ;; "" style. - ((string-match "<\\(.*\\)>" address) - (setq p-address (match-string 1 address))) - - ;; Everything else. - (t - (setq p-address address))) - - (when p-name - ;; Remove elements of the mailbox part that are not relevant for - ;; display, even if they are required during transport: - ;; - ;; Backslashes. - (setq p-name (replace-regexp-in-string "\\\\" "" p-name)) - - ;; Outer single and double quotes, which might be nested. - (loop - with start-of-loop - do (setq start-of-loop p-name) - - when (string-match "^\"\\(.*\\)\"$" p-name) - do (setq p-name (match-string 1 p-name)) - - when (string-match "^'\\(.*\\)'$" p-name) - do (setq p-name (match-string 1 p-name)) - - until (string= start-of-loop p-name))) - - ;; If the address is 'foo@bar.com ' then show just - ;; 'foo@bar.com'. - (when (string= p-name p-address) - (setq p-name nil)) - - ;; If we have a name return that otherwise return the address. - (if (not p-name) - p-address - p-name)) - (error address))) + (let* ((clean-address (notmuch-clean-address address)) + (p-address (car clean-address)) + (p-name (cdr clean-address))) + + ;; If we have a name return that otherwise return the address. + (or p-name p-address))) (defun notmuch-pick-insert-field (field format-string msg) (let* ((headers (plist-get msg :headers)) @@ -736,9 +689,6 @@ Complete list of currently available key bindings: (insert "\n"))) -(defvar notmuch-pick-json-parser nil - "Incremental JSON parser for the search process filter.") - (defun notmuch-pick-process-filter (proc string) "Process and filter the output of \"notmuch show\" (for pick)" (let ((results-buf (process-buffer proc)) @@ -751,46 +701,10 @@ Complete list of currently available key bindings: ;; Insert new data (save-excursion (goto-char (point-max)) - (insert string))) - (with-current-buffer results-buf - (save-excursion - (goto-char (point-max)) - (while (not done) - (condition-case nil - (case notmuch-pick-process-state - ((begin) - ;; Enter the results list - (if (eq (notmuch-json-begin-compound - notmuch-pick-json-parser) 'retry) - (setq done t) - (setq notmuch-pick-process-state 'result))) - ((result) - ;; Parse a result - (let ((result (notmuch-json-read notmuch-pick-json-parser))) - (case result - ((retry) (setq done t)) - ((end) (setq notmuch-pick-process-state 'end)) - (otherwise (notmuch-pick-insert-forest-thread result))))) - ((end) - ;; Any trailing data is unexpected - (with-current-buffer parse-buf - (skip-chars-forward " \t\r\n") - (if (eobp) - (setq done t) - (signal 'json-error nil))))) - (json-error - ;; Do our best to resynchronize and ensure forward - ;; progress - (notmuch-pick-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-json-parse-partial-list 'notmuch-pick-insert-forest-thread + 'notmuch-pick-show-error + results-buf))))) (defun notmuch-pick-worker (basic-query &optional query-context buffer) (interactive) @@ -807,8 +721,6 @@ Complete list of currently available key bindings: (message-arg "--entire-thread")) (if (equal (car (process-lines notmuch-command "count" search-args)) "0") (setq search-args basic-query)) - (message "starting parser %s" - (format-time-string "%r")) (if notmuch-pick-asynchronous-parser (let ((proc (start-process "notmuch-pick" buffer @@ -818,9 +730,6 @@ Complete list of currently available key bindings: ;; This buffer will be killed by the sentinel, which ;; should be called no matter how the process dies. (parse-buf (generate-new-buffer " *notmuch pick parse*"))) - (set (make-local-variable 'notmuch-pick-process-state) 'begin) - (set (make-local-variable 'notmuch-pick-json-parser) - (notmuch-json-create-parser parse-buf)) (process-put proc 'parse-buf parse-buf) (set-process-sentinel proc 'notmuch-pick-process-sentinel) (set-process-filter proc 'notmuch-pick-process-filter) @@ -831,9 +740,7 @@ Complete list of currently available key bindings: (list "--body=false" message-arg search-args))) (save-excursion (goto-char (point-max)) - (insert "End of search results.\n")) - (message "sync parser finished %s" - (format-time-string "%r")))))) + (insert "End of search results.\n")))))) (defun notmuch-pick (&optional query query-context buffer-name show-first-match)