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).

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

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.

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")

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)
 

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))
 

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.

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)
 

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."

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))
 

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")
 

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