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