** 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
;; 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.
;; 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")
(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)
"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))
;;;
;; 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.
(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".
;; 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
'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.
((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)
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)
(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))
(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)
;; 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))
(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)
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)
(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.
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."
;; 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))
;; 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")
(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
projects / emacs.git / commitdiff