Add a new command vc-pull-and-push

* lisp/vc/vc-svn.el (vc-exec-after):
* lisp/vc/vc-hg.el (vc-exec-after):
* lisp/vc/vc-git.el (vc-exec-after):
* lisp/vc/vc-cvs.el (vc-exec-after):
* lisp/vc/vc-bzr.el (vc-exec-after):
* lisp/org/org-macro.el (vc-exec-after):
* lisp/obsolete/vc-mtn.el (vc-exec-after):
* lisp/obsolete/vc-arch.el (vc-exec-after): Update declaration.
* lisp/vc/vc-dispatcher.el (vc--process-sentinel): Allow running
code only on success.
(vc-exec-after): Ditto.
(vc--inhibit-change-window-start): New variable.
(vc-do-async-command): Use it to allow chaining commands without
moving window point.  Return the process instead of the buffer,
since the process may have exited already, and then we can't get
at the process.

* lisp/vc/vc-git.el (vc-git--pushpull): Return the process object.
(vc-git-pull-and-push): New function.

* lisp/vc/vc.el (vc-pull-and-push): New command (bug#51964).

11 files changed, 82 insertions, 23 deletions

diff --git a/etc/NEWS b/etc/NEWS
index fd9fadc51f8..037368d1ec8 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1705,6 +1705,11 @@ info node.  This command only works for the Emacs and Emacs Lisp manuals.
 
 ** VC
 
+---
+*** New command 'vc-pull-and-push'.
+This commands first does a "pull" command, and if that is successful,
+do a "push" command afterwards.
+
 +++
 *** 'C-x v b' prefix key is used now for branch commands.
 'vc-print-branch-log' is bound to 'C-x v b l', and new commands are
diff --git a/lisp/obsolete/vc-arch.el b/lisp/obsolete/vc-arch.el
index 537d65c6587..20835a09d00 100644
--- a/lisp/obsolete/vc-arch.el
+++ b/lisp/obsolete/vc-arch.el
@@ -311,7 +311,7 @@ Only the value `maybe' can be trusted :-(."
 
 ;; dir-status-files called from vc-dir, which loads vc,
 ;; which loads vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
 
 (defun vc-arch-dir-status-files (dir _files callback)
   "Run `tla inventory' for DIR and pass results to CALLBACK.
diff --git a/lisp/obsolete/vc-mtn.el b/lisp/obsolete/vc-mtn.el
index cd56b290072..4fc496d5095 100644
--- a/lisp/obsolete/vc-mtn.el
+++ b/lisp/obsolete/vc-mtn.el
@@ -141,7 +141,7 @@ switches."
 
 ;; dir-status-files called from vc-dir, which loads vc,
 ;; which loads vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
 
 (defun vc-mtn-dir-status-files (dir _files update-function)
   (vc-mtn-command (current-buffer) 'async dir "status")
diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el
index 0921f3aa27c..b58c51f3fb4 100644
--- a/lisp/org/org-macro.el
+++ b/lisp/org/org-macro.el
@@ -66,7 +66,7 @@
 (declare-function org-mode "org" ())
 (declare-function vc-backend "vc-hooks" (f))
 (declare-function vc-call "vc-hooks" (fun file &rest args) t)
-(declare-function vc-exec-after "vc-dispatcher" (code))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
 
 (defvar org-link-search-must-match-exact-headline)
 
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index f6b17d4ce09..bce79967127 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -339,7 +339,7 @@ in the repository root directory of FILE."
   "Value of `compilation-error-regexp-alist' in *vc-bzr* buffers.")
 
 ;; To be called via vc-pull from vc.el, which requires vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
 (declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
 (declare-function vc-compilation-mode "vc-dispatcher" (backend))
 
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index 52cc42791fa..2dd3d416ac7 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -545,7 +545,7 @@ Will fail unless you have administrative privileges on the repo."
 ;;;
 
 ;; Follows vc-cvs-command, which uses vc-do-command from vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
 
 (defun vc-cvs-print-log (files buffer &optional _shortlog _start-revision limit)
   "Print commit log associated with FILES into specified BUFFER.
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 459c2ae1039..b4493ce40e7 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -197,7 +197,7 @@ Another is that undo information is not kept."
 
 (defvar vc-sentinel-movepoint)          ;Dynamically scoped.
 
-(defun vc--process-sentinel (p code)
+(defun vc--process-sentinel (p code &optional success)
   (let ((buf (process-buffer p)))
     ;; Impatient users sometime kill "slow" buffers; check liveness
     ;; to avoid "error in process sentinel: Selecting deleted buffer".
@@ -218,7 +218,7 @@ Another is that undo information is not kept."
             ;; each sentinel read&set process-mark, but since `cmd' needs
             ;; to work both for async and sync processes, this would be
             ;; difficult to achieve.
-            (vc-exec-after code)
+            (vc-exec-after code success)
             (move-marker m (point)))
           ;; But sometimes the sentinels really want to move point.
           (when vc-sentinel-movepoint
@@ -235,11 +235,14 @@ Another is that undo information is not kept."
                                 'help-echo
                                 "A command is in progress in this buffer"))))
 
-(defun vc-exec-after (code)
+(defun vc-exec-after (code &optional success)
   "Eval CODE when the current buffer's process is done.
 If the current buffer has no process, just evaluate CODE.
 Else, add CODE to the process' sentinel.
-CODE should be a function of no arguments."
+CODE should be a function of no arguments.
+
+If SUCCESS, it should be a process object.  Only run CODE if the
+SUCCESS process has a zero exit code."
   (let ((proc (get-buffer-process (current-buffer))))
     (cond
      ;; If there's no background process, just execute the code.
@@ -250,13 +253,15 @@ CODE should be a function of no arguments."
      ((or (null proc) (eq (process-status proc) 'exit))
       ;; Make sure we've read the process's output before going further.
       (when proc (accept-process-output proc))
-      (if (functionp code) (funcall code) (eval code t)))
+      (when (or (not success)
+                (zerop (process-exit-status success)))
+        (if (functionp code) (funcall code) (eval code t))))
      ;; If a process is running, add CODE to the sentinel
      ((eq (process-status proc) 'run)
       (vc-set-mode-line-busy-indicator)
       (letrec ((fun (lambda (p _msg)
                       (remove-function (process-sentinel p) fun)
-                      (vc--process-sentinel p code))))
+                      (vc--process-sentinel p code success))))
         (add-function :after (process-sentinel proc) fun)))
      (t (error "Unexpected process state"))))
   nil)
@@ -410,11 +415,14 @@ case, and the process object in the asynchronous case."
 			      command file-or-list flags))
 	status))))
 
+(defvar vc--inhibit-change-window-start nil)
+
 (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)
 	   (inhibit-read-only t)
@@ -428,7 +436,9 @@ Display the buffer in some window, but don't select it."
                   (dolist (arg args)
 	            (insert " " arg))
                   (insert "\"...\n")))
-	   (window nil) (new-window-start nil))
+	   (window nil)
+           (new-window-start nil)
+           (proc nil))
     (setq buffer (get-buffer-create buffer))
     (if (get-buffer-process buffer)
 	(error "Another VC action on %s is running" root))
@@ -437,11 +447,12 @@ Display the buffer in some window, but don't select it."
       (add-hook 'vc-pre-command-functions fun)
       ;; Run in the original working directory.
       (let ((default-directory dir))
-	(apply #'vc-do-command t 'async command nil args)))
+	(setq proc (apply #'vc-do-command t 'async command nil args))))
     (setq window (display-buffer buffer))
-    (if window
-	(set-window-start window new-window-start))
-    buffer))
+    (when (and window
+               (not vc--inhibit-change-window-start))
+      (set-window-start window new-window-start))
+    proc))
 
 (defvar compilation-error-regexp-alist)
 
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 3816d323e6f..18cc4a66adc 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -624,7 +624,7 @@ or an empty string if none."
 
 ;; Follows vc-git-command (or vc-do-async-command), which uses vc-do-command
 ;; from vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
 ;; Follows vc-exec-after.
 (declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
 
@@ -1098,7 +1098,8 @@ If PROMPT is non-nil, prompt for the Git command to run."
 	 (buffer (format "*vc-git : %s*" (expand-file-name root)))
          (git-program vc-git-program)
          ;; TODO if pushing, prompt if no default push location - cf bzr.
-         (vc-want-edit-command-p prompt))
+         (vc-want-edit-command-p prompt)
+         proc)
     (require 'vc-dispatcher)
     (when vc-want-edit-command-p
       (with-current-buffer (get-buffer-create buffer)
@@ -1108,8 +1109,8 @@ If PROMPT is non-nil, prompt for the Git command to run."
                           command (caaddr args)
                           extra-args (cdaddr args)))
                   nil t)))
-    (apply #'vc-do-async-command
-           buffer root git-program command extra-args)
+    (setq proc (apply #'vc-do-async-command
+                      buffer root git-program command extra-args))
     (with-current-buffer buffer
       (vc-run-delayed
         (vc-compilation-mode 'git)
@@ -1124,7 +1125,8 @@ If PROMPT is non-nil, prompt for the Git command to run."
                     (list compile-command nil
                           (lambda (_name-of-mode) buffer)
                           nil))))
-    (vc-set-async-update buffer)))
+    (vc-set-async-update buffer)
+    proc))
 
 (defun vc-git-pull (prompt)
   "Pull changes into the current Git branch.
@@ -1138,6 +1140,25 @@ Normally, this runs \"git push\".  If PROMPT is non-nil, prompt
 for the Git command to run."
   (vc-git--pushpull "push" prompt nil))
 
+(defun vc-git-pull-and-push (prompt)
+  "Pull changes into the current Git branch, and then push.
+The push will only be performed if the pull was successful.
+
+Normally, this runs \"git pull\".  If PROMPT is non-nil, prompt
+for the Git command to run."
+  (let ((proc (vc-git--pushpull "pull" prompt '("--stat"))))
+    (when (process-buffer proc)
+      (with-current-buffer (process-buffer proc)
+        (if (and (eq (process-status proc) 'exit)
+                 (zerop (process-exit-status proc)))
+            (let ((vc--inhibit-change-window-start t))
+              (vc-git-push nil))
+          (vc-exec-after
+           (lambda ()
+             (let ((vc--inhibit-change-window-start t))
+               (vc-git-push nil)))
+           proc))))))
+
 (defun vc-git-merge-branch ()
   "Merge changes into the current Git branch.
 This prompts for a branch to merge from."
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index f4a44df3c29..eed95923788 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1345,7 +1345,7 @@ REV is the revision to check out into WORKFILE."
 
 ;; Follows vc-hg-command (or vc-do-async-command), which uses vc-do-command
 ;; from vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
 ;; Follows vc-exec-after.
 (declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
 
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index 08b53a7169f..9c2bdf66746 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -207,7 +207,7 @@ switches."
 
 ;; dir-status-files called from vc-dir, which loads vc,
 ;; which loads vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
 
 (autoload 'vc-expand-dirs "vc")
 
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index a45e0e0c522..4ebcd3ae161 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -2975,6 +2975,28 @@ It also signals an error in a Bazaar bound branch."
         (vc-call-backend backend 'push arg)
       (user-error "VC push is unsupported for `%s'" backend))))
 
+;;;###autoload
+(defun vc-pull-and-push (&optional arg)
+  "First pull, and then push the current branch.
+The push will only be performed if the pull operation was successful.
+
+You must be visiting a version controlled file, or in a `vc-dir' buffer.
+
+On a distributed version control system, this runs a \"pull\"
+operation on the current branch, prompting for the precise
+command if required.  Optional prefix ARG non-nil forces a prompt
+for the VCS command to run.  If this is successful, a \"push\"
+operation will then be done.
+
+On a non-distributed version control system, this signals an error.
+It also signals an error in a Bazaar bound branch."
+  (interactive "P")
+  (let* ((vc-fileset (vc-deduce-fileset t))
+	 (backend (car vc-fileset)))
+    (if (vc-find-backend-function backend 'pull-and-push)
+        (vc-call-backend backend 'pull-and-push arg)
+      (user-error "VC pull-and-push is unsupported for `%s'" backend))))
+
 (defun vc-version-backup-file (file &optional rev)
   "Return name of backup file for revision REV of FILE.
 If version backups should be used for FILE, and there exists