Function: consult--async-process

consult--async-process is a byte-compiled function defined in consult.el.

Signature

(consult--async-process BUILDER &rest PROPS)

Documentation

Async process function.

BUILDER is the command line builder function. PROPS are optional properties passed to make-process.

Source Code

;; Defined in ~/.emacs.d/elpa/consult-20260805.1130/consult.el
(defun consult--async-process (builder &rest props)
  "Async process function.
BUILDER is the command line builder function.
PROPS are optional properties passed to `make-process'."
  (lambda (sink)
    (let (proc proc-buf last-args count)
      (lambda (action)
        (pcase action
          ((pred stringp)
           (funcall sink action)
           (let ((args (funcall builder action)))
             (unless (stringp (car args))
               (setq args (car args)))
             (unless (equal args last-args)
               (setq last-args args)
               (when proc
                 (delete-process proc)
                 (kill-buffer proc-buf)
                 (setq proc nil proc-buf nil))
               (when args
                 (let* ((flush t)
                        (rest "")
                        (proc-filter
                         (lambda (_ out)
                           (when flush
                             (setq flush nil)
                             (funcall sink 'flush))
                           (let ((lines (split-string out "[\r\n]+")))
                             (if (not (cdr lines))
                                 (setq rest (concat rest (car lines)))
                               (setcar lines (concat rest (car lines)))
                               (let* ((len (length lines))
                                      (last (nthcdr (- len 2) lines)))
                                 (setq rest (cadr last)
                                       count (+ count len -1))
                                 (setcdr last nil)
                                 (funcall sink lines))))))
                        (proc-sentinel
                         (lambda (_ event)
                           (cond
                            (flush
                             (setq flush nil)
                             (funcall sink 'flush))
                            ((and (string-prefix-p "finished" event) (not (equal rest "")))
                             (incf count)
                             (funcall sink (list rest))))
                           (funcall sink `[indicator
                                           ,(cond
                                             ((string-prefix-p "killed" event)   'killed)
                                             ((string-prefix-p "finished" event) 'finished)
                                             (t 'failed))])
                           (consult--async-log
                            "consult--async-process sentinel: event=%s lines=%d\n"
                            (string-trim event) count)
                           (when (> (buffer-size proc-buf) 0)
                             (with-current-buffer (get-buffer-create consult--async-log)
                               (goto-char (point-max))
                               (insert ">>>>> stderr >>>>>\n")
                               (let ((beg (point)))
                                 (insert-buffer-substring proc-buf)
                                 (save-excursion
                                   (goto-char beg)
                                   (message #("%s" 0 2 (face error))
                                            (buffer-substring-no-properties (pos-bol) (pos-eol)))))
                               (insert "<<<<< stderr <<<<<\n")))))
                        (process-adaptive-read-buffering nil))
                   (funcall sink [indicator running])
                   (consult--async-log "consult--async-process started: args=%S default-directory=%S\n"
                                       args default-directory)
                   (setq count 0
                         proc-buf (generate-new-buffer " *consult-async-stderr*")
                         proc (apply #'make-process
                                     `(,@props
                                       :connection-type pipe
                                       :name ,(car args)
                                       ;;; XXX tramp bug, the stderr buffer must be empty
                                       :stderr ,proc-buf
                                       :noquery t
                                       :command ,args
                                       :filter ,proc-filter
                                       :sentinel ,proc-sentinel)))))))
           nil)
          ((or 'cancel 'destroy)
           (when proc
             (delete-process proc)
             (kill-buffer proc-buf)
             (setq proc nil proc-buf nil))
           (setq last-args nil)
           (funcall sink action))
          (_ (funcall sink action)))))))