Function: vc-do-async-command

vc-do-async-command is a byte-compiled function defined in vc-dispatcher.el.gz.

Signature

(vc-do-async-command BUFFER ROOT COMMAND &rest ARGS)

Documentation

Run COMMAND asynchronously with ARGS, displaying the result.

Send the output to BUFFER, which should be a buffer or the name of a buffer, which is created. ROOT should be the directory in which the command should be run. The process object is returned. Display the buffer in some window, but don't select it.

Source Code

;; Defined in /usr/src/emacs/lisp/vc/vc-dispatcher.el.gz
(defun vc-do-async-command (buffer root command &rest args)
  "Run COMMAND asynchronously with ARGS, displaying the result.
Send the output to BUFFER, which should be a buffer or the name
of a buffer, which is created.
ROOT should be the directory in which the command should be run.
The process object is returned.
Display the buffer in some window, but don't select it."
  (letrec ((dir default-directory)
           (start-time) (proc)
           (finished-fun
            (lambda (proc _msg)
              (cond ((not (buffer-live-p buffer))
                     (remove-function (process-sentinel proc)
                                      finished-fun))
                    ((not (eq (process-status proc) 'run))
                     (remove-function (process-sentinel proc)
                                      finished-fun)
                     (with-current-buffer buffer
                       (save-excursion
                         (goto-char (process-mark proc))
                         (let ((inhibit-read-only t))
                           (insert
                            (format "Finished in %.2f seconds\n"
                                    (time-to-seconds
                                     (time-since start-time))))
                           (set-marker (process-mark proc)
                                       (point))))))))))
    (setq buffer (get-buffer-create buffer))
    (if (get-buffer-process buffer)
	(error "Another VC action on %s is running" root))
    (with-current-buffer buffer
      (setq default-directory root)
      (let* (;; Run in the original working directory.
             (default-directory dir)
             (orig-fun vc-filter-command-function)
             (inhibit-read-only t)
             (vc-filter-command-function
              (lambda (&rest args)
                (cl-destructuring-bind (&whole args cmd _ flags)
                    (apply orig-fun args)
                  (goto-char (point-max))
                  (unless (eq (point) (point-min))
                    (insert "\n"))
                  (insert "Running '" cmd)
                  (dolist (flag flags)
                    (let ((lines (string-lines flag)))
                      (insert " ")
                      ;; If the argument has newlines in it (as a commit
                      ;; message commonly will) then ellipse it down so
                      ;; that the whole command is more readable.
                      (if (cdr lines)
                          (let ((flag (copy-sequence flag))
                                (cl-print-string-length (length
                                                         (car lines))))
                            (set-text-properties 0 (length flag) nil
                                                 flag)
                            (cl-prin1 flag buffer))
                        (insert flag))))
                  (insert "'...\n")
                  args))))
	(setq start-time (current-time)
              proc (apply #'vc-do-command t 'async command nil args))))
    (add-function :after (process-sentinel proc) finished-fun)
    (vc--display-async-command-buffer buffer)
    proc))