master 62ec74e9eda: VC pull/push: Consistently return and use process object

branch: master
commit 62ec74e9eda643e408f02cfde808b99b975d9c98
Author: Sean Whitton <[email protected]>
Commit: Sean Whitton <[email protected]>

    VC pull/push: Consistently return and use process object
    
    * lisp/vc/vc-hg.el (vc-hg--pushpull): Return the process object.
    * lisp/vc/vc.el (vc-pull, vc-push): Use it.
    (pull, push): Specify that it should be returned.
---
 lisp/vc/vc-hg.el | 53 +++++++++++++++++++++++++++--------------------------
 lisp/vc/vc.el    | 44 ++++++++++++++++++++++++++++----------------
 2 files changed, 55 insertions(+), 42 deletions(-)

diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index b3000534e7c..a34ed82fa23 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1632,7 +1632,7 @@ revisions, fetch only those revisions."
 		      (mapcar (lambda (arg) (list "-r" arg)) marked-list)))
       (let* ((root (vc-hg-root default-directory))
 	     (buffer (format "*vc-hg : %s*" (expand-file-name root)))
-	      ;; Disable pager.
+	     ;; Disable pager.
              (process-environment (cons "HGPLAIN=1" process-environment))
 	     (hg-program vc-hg-program)
 	     args)
@@ -1648,31 +1648,32 @@ revisions, fetch only those revisions."
 	  (setq hg-program (car  args)
 		command    (cadr args)
 		args       (cddr args)))
-	(set-process-query-on-exit-flag
-         (apply #'vc-do-async-command buffer root hg-program command args)
-         t)
-        (with-current-buffer buffer
-          (vc-run-delayed
-            (dolist (cmd post-processing)
-              (apply #'vc-do-command buffer nil hg-program nil cmd))
-            (vc-compilation-mode 'hg)
-            (setq-local compile-command
-                        (concat hg-program " " command " "
-                                (mapconcat #'identity args " ")
-                                (mapconcat (lambda (args)
-                                             (concat " && " hg-program " "
-                                                     (mapconcat #'identity
-                                                                args " ")))
-                                           post-processing "")))
-            (setq-local compilation-directory root)
-            ;; Either set `compilation-buffer-name-function' locally to nil
-            ;; or use `compilation-arguments' to set `name-function'.
-            ;; See `compilation-buffer-name'.
-            (setq-local compilation-arguments
-                        (list compile-command nil
-                              (lambda (_name-of-mode) buffer)
-                              nil))))
-	(vc-set-async-update buffer)))))
+        (let ((proc (apply #'vc-do-async-command buffer root hg-program
+                           command args)))
+          (set-process-query-on-exit-flag proc t)
+          (with-current-buffer buffer
+            (vc-run-delayed
+              (dolist (cmd post-processing)
+                (apply #'vc-do-command buffer nil hg-program nil cmd))
+              (vc-compilation-mode 'hg)
+              (setq-local compile-command
+                          (concat hg-program " " command " "
+                                  (mapconcat #'identity args " ")
+                                  (mapconcat (lambda (args)
+                                               (concat " && " hg-program " "
+                                                       (mapconcat #'identity
+                                                                  args " ")))
+                                             post-processing "")))
+              (setq-local compilation-directory root)
+              ;; Either set `compilation-buffer-name-function' locally to nil
+              ;; or use `compilation-arguments' to set `name-function'.
+              ;; See `compilation-buffer-name'.
+              (setq-local compilation-arguments
+                          (list compile-command nil
+                                (lambda (_name-of-mode) buffer)
+                                nil))))
+	  (vc-set-async-update buffer)
+          proc)))))
 
 (defun vc-hg-pull (prompt)
   "Issue a Mercurial pull command.
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 7497150562f..ef957b7010a 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -364,9 +364,17 @@
 ;;
 ;; - pull (prompt)
 ;;
-;;   Pull "upstream" changes into the current branch (for distributed
+;;   Pull upstream changes into the current branch (for distributed
 ;;   VCS).  If PROMPT is non-nil, or if necessary, prompt for a
-;;   location to pull from.
+;;   location to pull from.  If the pull is done asynchronously, return
+;;   the process object.
+;;
+;; - push (prompt)
+;;
+;;   Push local changes to the upstream of the current branch (for
+;;   distributed VCS).  If PROMPT is non-nil, or if necessary, prompt
+;;   for the command to run.  If the pull is done asynchronously, return
+;;   the process object.
 ;;
 ;; - steal-lock (file &optional revision)
 ;;
@@ -4894,13 +4902,15 @@ tip revision are merged into the working file."
     (cond
      ;; If a pull operation is defined, use it.
      (fn
-      (funcall fn arg)
-      (vc-run-delayed
-        ;; FIXME: Ideally we would only clear out the stored value for
-        ;; the REMOTE-LOCATION from which we are pulling.
-        (vc--repo-setprop backend 'vc-incoming-revision nil)
-        (when vc-dir-buffers
-          (vc-dir--refresh-headers (vc-root-dir backend)))))
+      (let ((proc (funcall fn arg)))
+        (vc-exec-after
+         (lambda ()
+           ;; FIXME: Ideally we would only clear out the stored value
+           ;; for the REMOTE-LOCATION from which we are pulling.
+           (vc--repo-setprop backend 'vc-incoming-revision nil)
+           (when vc-dir-buffers
+             (vc-dir--refresh-headers (vc-root-dir backend))))
+         nil (and (processp proc) proc))))
      ;; If VCS has `merge-news' functionality (CVS and SVN), use it.
      ((vc-find-backend-function backend 'merge-news)
       (save-some-buffers                ; save buffers visiting files
@@ -4939,13 +4949,15 @@ It also signals an error in a Bazaar bound branch."
   (let* ((fileset (vc-deduce-fileset t t))
 	 (backend (car fileset)))
     (if (vc-find-backend-function backend 'push)
-        (progn (vc-call-backend backend 'push arg)
-               (vc-run-delayed
-                 ;; FIXME: Ideally we would only clear out the
-                 ;; REMOTE-LOCATION to which we are pushing.
-                 (vc--repo-setprop backend 'vc-incoming-revision nil)
-                 (when vc-dir-buffers
-                   (vc-dir--refresh-headers (vc-root-dir backend)))))
+        (let ((proc (vc-call-backend backend 'push arg)))
+          (vc-exec-after
+           (lambda ()
+             ;; FIXME: Ideally we would only clear out the
+             ;; REMOTE-LOCATION to which we are pushing.
+             (vc--repo-setprop backend 'vc-incoming-revision nil)
+             (when vc-dir-buffers
+               (vc-dir--refresh-headers (vc-root-dir backend))))
+           nil (and (processp proc) proc)))
       (user-error "VC push is unsupported for `%s'" backend))))
 
 ;;;###autoload