branch: externals/consult
commit 1710aec5a2714f4b4f18b013b7edaed2bbaf5653
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@daniel-mendler.de>
Extract async state indicator
---
consult.el | 72 +++++++++++++++++++++++++++++++++++++-------------------------
1 file changed, 43 insertions(+), 29 deletions(-)
diff --git a/consult.el b/consult.el
index 55bcf2b5aa..90854497ff 100644
--- a/consult.el
+++ b/consult.el
@@ -1953,29 +1953,42 @@ SPLIT is the splitting function."
""))))
(_ (funcall async action)))))
+(defun consult--async-indicator (async)
+ "Create async function with a state indicator overlay.
+ASYNC is the async sink."
+ (let (ov)
+ (lambda (action &optional state)
+ (pcase action
+ ('indicator
+ (overlay-put ov 'display
+ (pcase-exhaustive state
+ ('running #("*" 0 1 (face consult-async-running)))
+ ('finished #(":" 0 1 (face consult-async-finished)))
+ ('killed #(";" 0 1 (face consult-async-failed)))
+ ('failed #("!" 0 1 (face consult-async-failed))))))
+ ('setup
+ (setq ov (make-overlay (- (minibuffer-prompt-end) 2)
+ (- (minibuffer-prompt-end) 1)))
+ (funcall async 'setup))
+ ('destroy
+ (delete-overlay ov)
+ (funcall async 'destroy))
+ (_ (funcall async action))))))
+
(defun consult--async-log (formatted &rest args)
"Log FORMATTED ARGS to variable `consult--async-log'."
(with-current-buffer (get-buffer-create consult--async-log)
(goto-char (point-max))
(insert (apply #'format formatted args))))
-(defun consult--process-indicator (event)
- "Return the process indicator character for EVENT."
- (cond
- ((string-prefix-p "killed" event)
- #(";" 0 1 (face consult-async-failed)))
- ((string-prefix-p "finished" event)
- #(":" 0 1 (face consult-async-finished)))
- (t
- #("!" 0 1 (face consult-async-failed)))))
-
(defun consult--async-process (async builder &rest props)
"Create process source async function.
ASYNC is the async function which receives the candidates.
BUILDER is the command line builder function.
PROPS are optional properties passed to `make-process'."
- (let (proc proc-buf last-args indicator count)
+ (setq async (consult--async-indicator async))
+ (let (proc proc-buf last-args count)
(lambda (action)
(pcase action
("" ;; If no input is provided kill current process
@@ -2008,7 +2021,11 @@ PROPS are optional properties passed to `make-process'."
(when flush
(setq flush nil)
(funcall async 'flush))
- (overlay-put indicator 'display (consult--process-indicator
event))
+ (funcall async 'indicator
+ (cond
+ ((string-prefix-p "killed" event) 'killed)
+ ((string-prefix-p "finished" event) 'finished)
+ (t 'failed)))
(when (and (string-prefix-p "finished" event) (not (equal
rest "")))
(cl-incf count)
(funcall async (list rest)))
@@ -2034,7 +2051,7 @@ PROPS are optional properties passed to `make-process'."
(kill-buffer proc-buf)
(setq proc nil proc-buf nil))
(when args
- (overlay-put indicator 'display #("*" 0 1 (face
consult-async-running)))
+ (funcall async 'indicator 'running)
(consult--async-log "consult--async-process started %S\n" args)
(setq count 0
proc-buf (generate-new-buffer " *consult-async-stderr*")
@@ -2054,12 +2071,7 @@ PROPS are optional properties passed to `make-process'."
(delete-process proc)
(kill-buffer proc-buf)
(setq proc nil proc-buf nil))
- (delete-overlay indicator)
(funcall async 'destroy))
- ('setup
- (setq indicator (make-overlay (- (minibuffer-prompt-end) 2)
- (- (minibuffer-prompt-end) 1)))
- (funcall async 'setup))
(_ (funcall async action))))))
(defun consult--async-highlight (async builder)
@@ -2166,21 +2178,23 @@ The refresh happens after a DELAY, defaulting to
`consult-async-refresh-delay'."
"Dynamic collection source.
ASYNC is the sink.
FUN computes the candidates given the input."
- (let ((request "") current)
+ (setq async (consult--async-indicator async))
+ (let ((request ""))
(lambda (action)
(pcase action
('nil
- (if (or (equal request "") (equal request current))
+ (if (equal request "")
(funcall async nil)
- (unwind-protect
- (let ((response (funcall fun request)))
- (funcall async 'flush)
- (funcall async response)
- (setq current request))
- ;; Check if computation went through completely or if it was
- ;; interrupted. If an interrupt occurred, set request to the
empty
- ;; string, which signals a cancelled request.
- (unless (equal current request)
+ (let ((state 'killed))
+ (unwind-protect
+ (progn
+ (funcall async 'indicator 'running)
+ (redisplay)
+ (let ((response (funcall fun request)))
+ (funcall async 'flush)
+ (setq state 'finished)
+ (funcall async response)))
+ (funcall async 'indicator state)
(setq request "")))))
((pred stringp)
(setq request action)
