procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add basic VC push support.

Browse source 
* lisp/vc/vc.el (vc-push): New autoloaded command.
* lisp/vc/vc-hooks.el (vc-prefix-map, vc-menu-map): Add vc-push.
* lisp/vc/vc-bzr.el (vc-bzr--pushpull): New, factored from vc-bzr-pull.
(vc-bzr-pull): Reimplement using vc-bzr--pushpull.
(vc-bzr-push): New.
* lisp/vc/vc-git.el (vc-git--pushpull): New, factored from vc-git-pull.
(vc-git-pull): Reimplement using vc-git--pushpull.
(vc-git-push): New.
* lisp/vc/vc-hg.el (vc-hg--pushpull): New, factored from vc-hg-pull.
(vc-hg-pull, vc-hg-push): Reimplement using vc-hg--pushpull.
* doc/emacs/maintaining.texi (Pulling / Pushing):
Rename from "VC Pull".  Mention pushing.
(VC With A Merging VCS, VC Change Log): Update xrefs.
(Branches): Update menu.
* doc/emacs/emacs.texi: Update menu.
* etc/NEWS: Mention this.
This commit is contained in:
Glenn Morris 2015-05-12 20:42:42 -04:00
parent f9ba8dc074
commit 660c30cc8c
9 changed files with 164 additions and 80 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
doc/emacs/emacs.texi
View file

@ -831,7 +831,7 @@ VC Directory Mode
Version Control Branches
* Switching Branches:: How to get to another existing branch.
* VC Pull:: Updating the contents of a branch.
* Pulling / Pushing:: Receiving/sending changes from/to elsewhere.
* Merging:: Transferring changes between branches.
* Creating Branches:: How to start a new branch.

36
doc/emacs/maintaining.texi
View file

@ -491,10 +491,10 @@ commit. @xref{Log Buffer}.
If committing to a shared repository, the commit may fail if the
repository that has been changed since your last update. In that
case, you must perform an update before trying again. On a
decentralized version control system, use @kbd{C-x v +} (@pxref{VC
Pull}) or @kbd{C-x v m} (@pxref{Merging}). On a centralized version
control system, type @kbd{C-x v v} again to merge in the repository
changes.
decentralized version control system, use @kbd{C-x v +}
(@pxref{Pulling / Pushing}) or @kbd{C-x v m} (@pxref{Merging}).
On a centralized version control system, type @kbd{C-x v v} again to
merge in the repository changes.
@item
Finally, if you are using a centralized version control system, check
@ -942,7 +942,7 @@ revision at point. A second @key{RET} hides it again.
(@code{vc-log-incoming}) command displays a log buffer showing the
changes that will be applied, the next time you run the version
control system's ``pull'' command to get new revisions from another
repository (@pxref{VC Pull}). This other repository is the default
repository (@pxref{Pulling / Pushing}). This other repository is the default
one from which changes are pulled, as defined by the version control
system; with a prefix argument, @code{vc-log-incoming} prompts for a
specific repository. Similarly, @kbd{C-x v O}
@ -1305,7 +1305,7 @@ different branches.
@menu
* Switching Branches:: How to get to another existing branch.
* VC Pull:: Updating the contents of a branch.
* Pulling / Pushing:: Receiving/sending changes from/to elsewhere.
* Merging:: Transferring changes between branches.
* Creating Branches:: How to start a new branch.
@end menu
@ -1349,8 +1349,8 @@ unlocks (write-protects) the working tree.
branch until you switch away; for instance, any VC filesets that you
commit will be committed to that specific branch.
@node VC Pull
@subsubsection Pulling Changes into a Branch
@node Pulling / Pushing
@subsubsection Pulling/Pushing Changes into/from a Branch
@table @kbd
@item C-x v +
@ -1359,6 +1359,11 @@ by ``pulling in'' changes from another location.
On a centralized version control system, update the current VC
fileset.
@item C-x v P
On a decentralized version control system, ``push'' changes from the
current branch to another location. This concept does not exist
for centralized version control systems.
@end table
@kindex C-x v +
@ -1388,6 +1393,21 @@ Log}.
On a centralized version control system like CVS, @kbd{C-x v +}
updates the current VC fileset from the repository.
@kindex C-x v P
@findex vc-push
On a decentralized version control system, the command @kbd{C-x v P}
(@code{vc-push}) sends changes from your current branch to another location.
With a prefix argument, the command prompts for the exact
version control command to use, which lets you specify where to push
changes. Otherwise, it pushes to a default location determined
by the version control system.
Prior to pushing, you can use @kbd{C-x v O} (@code{vc-log-outgoing})
to view a log buffer of the changes to be sent. @xref{VC Change Log}.
This command is currently supported only by Bazaar, Git, and Mercurial.
It signals an error for centralized version control systems.
@node Merging
@subsubsection Merging Branches
@cindex merging changes

3
etc/NEWS
View file

@ -553,6 +553,9 @@ and comments.
** VC and related modes
*** Basic push support, via `vc-push', bound to `C-x v P'.
Implemented for Bzr, Git, Hg.
*** The new command vc-region-history shows the log+diff of the active region.
*** New option `vc-annotate-background-mode' controls whether

44
lisp/vc/vc-bzr.el
View file

@ -335,29 +335,31 @@ in the repository root directory of FILE."
(declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
(declare-function vc-compilation-mode "vc-dispatcher" (backend))
(defun vc-bzr-pull (prompt)
"Pull changes into the current Bzr branch.
Normally, this runs \"bzr pull\". However, if the branch is a
bound branch, run \"bzr update\" instead. If there is no default
location from which to pull or update, or if PROMPT is non-nil,
prompt for the Bzr command to run."
(defun vc-bzr--pushpull (command prompt)
"Run COMMAND (a string; either push or pull) on the current Bzr branch.
If PROMPT is non-nil, prompt for the Bzr command to run."
(let* ((vc-bzr-program vc-bzr-program)
(branch-conf (vc-bzr-branch-conf default-directory))
;; Check whether the branch is bound.
(bound (assoc "bound" branch-conf))
(bound (and bound (equal "true" (downcase (cdr bound)))))
;; If we need to do a "bzr pull", check for a parent. If it
;; does not exist, bzr will need a pull location.
(has-parent (unless bound
(assoc "parent_location" branch-conf)))
(command (if bound "update" "pull"))
(has-loc (assoc (if (equal command "push")
"push_location"
"parent_location")
branch-conf))
args)
(when bound
(if (equal command "push")
(user-error "Cannot push a bound branch")
(setq command "update")))
;; If necessary, prompt for the exact command.
(when (or prompt (not (or bound has-parent)))
(when (or prompt (if (equal command "push")
(not has-loc)
(not (or bound has-loc))))
(setq args (split-string
(read-shell-command
"Bzr pull command: "
(concat vc-bzr-program " " command)
(format "Bzr %s command: " command)
(format "%s %s" vc-bzr-program command)
'vc-bzr-history)
" " t))
(setq vc-bzr-program (car args)
@ -368,6 +370,20 @@ prompt for the Bzr command to run."
(with-current-buffer buf (vc-run-delayed (vc-compilation-mode 'bzr)))
(vc-set-async-update buf))))
(defun vc-bzr-pull (prompt)
"Pull changes into the current Bzr branch.
Normally, this runs \"bzr pull\". However, if the branch is a
bound branch, run \"bzr update\" instead. If there is no default
location from which to pull or update, or if PROMPT is non-nil,
prompt for the Bzr command to run."
(vc-bzr--pushpull "pull" prompt))
(defun vc-bzr-push (prompt)
"Push changes from the current Bzr branch.
Normally, this runs \"bzr push\". If there is no push location,
or if PROMPT is non-nil, prompt for the Bzr command to run."
(vc-bzr--pushpull "push" prompt))
(defun vc-bzr-merge-branch ()
"Merge another Bzr branch into the current one.
Prompt for the Bzr command to run, providing a pre-defined merge

10
lisp/vc/vc-dir.el
View file

@ -111,7 +111,7 @@ See `run-hooks'."
(current-buffer)))))
(defvar vc-dir-menu-map
(let ((map (make-sparse-keymap "VC-dir")))
(let ((map (make-sparse-keymap "VC-Dir")))
(define-key map [quit]
'(menu-item "Quit" quit-window
:help "Quit"))
@ -204,6 +204,10 @@ See `run-hooks'."
:help "List the change log for the current tree in a window"))
;; VC commands.
(define-key map [sepvccmd] '("--"))
(define-key map [push]
'(menu-item "Push Changes" vc-push
:enable (vc-find-backend-function vc-dir-backend 'push)
:help "Push the current branch's changes"))
(define-key map [update]
'(menu-item "Update to Latest Version" vc-update
:help "Update the current fileset's files to their tip revisions"))
@ -246,6 +250,8 @@ See `run-hooks'."
(define-key map "D" 'vc-root-diff) ;; C-x v D
(define-key map "i" 'vc-register) ;; C-x v i
(define-key map "+" 'vc-update) ;; C-x v +
;; I'd prefer some kind of symmetry with vc-update:
(define-key map "P" 'vc-push) ;; C-x v P
(define-key map "l" 'vc-print-log) ;; C-x v l
(define-key map "L" 'vc-print-root-log) ;; C-x v L
(define-key map "I" 'vc-log-incoming) ;; C-x v I
@ -294,7 +300,7 @@ See `run-hooks'."
`(menu-item
;; VC backends can use this to add mode-specific menu items to
;; vc-dir-menu-map.
"VC-dir" ,vc-dir-menu-map :filter vc-dir-menu-map-filter))
"VC-Dir" ,vc-dir-menu-map :filter vc-dir-menu-map-filter))
map)
"Keymap for directory buffer.")

28
lisp/vc/vc-git.el
View file

@ -721,21 +721,21 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
;; To be called via vc-pull from vc.el, which requires vc-dispatcher.
(declare-function vc-compilation-mode "vc-dispatcher" (backend))
(defun vc-git-pull (prompt)
"Pull changes into the current Git branch.
Normally, this runs \"git pull\". If PROMPT is non-nil, prompt
for the Git command to run."
(defun vc-git--pushpull (command prompt)
"Run COMMAND (a string; either push or pull) on the current Git branch.
If PROMPT is non-nil, prompt for the Git command to run."
(let* ((root (vc-git-root default-directory))
(buffer (format "*vc-git : %s*" (expand-file-name root)))
(command "pull")
(git-program vc-git-program)
args)
;; If necessary, prompt for the exact command.
;; TODO if pushing, prompt if no default push location - cf bzr.
(when prompt
(setq args (split-string
(read-shell-command "Git pull command: "
(format "%s pull" git-program)
'vc-git-history)
(read-shell-command
(format "Git %s command: " command)
(format "%s %s" git-program command)
'vc-git-history)
" " t))
(setq git-program (car args)
command (cadr args)
@ -745,6 +745,18 @@ for the Git command to run."
(with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git)))
(vc-set-async-update buffer)))
(defun vc-git-pull (prompt)
"Pull changes into the current Git branch.
Normally, this runs \"git pull\". If PROMPT is non-nil, prompt
for the Git command to run."
(vc-git--pushpull "pull" prompt))
(defun vc-git-push (prompt)
"Push changes from the current Git branch.
Normally, this runs \"git push\". If PROMPT is non-nil, prompt
for the Git command to run."
(vc-git--pushpull "push" prompt))
(defun vc-git-merge-branch ()
"Merge changes into the current Git branch.
This prompts for a branch to merge from."

99
lisp/vc/vc-hg.el
View file

@ -659,20 +659,6 @@ REV is the revision to check out into WORKFILE."
(vc-hg-command buffer 1 nil "outgoing" "-n" (unless (string= remote-location "")
remote-location)))
(declare-function log-view-get-marked "log-view" ())
;; XXX maybe also add key bindings for these functions.
(defun vc-hg-push ()
(interactive)
(let ((marked-list (log-view-get-marked)))
(if marked-list
(apply #'vc-hg-command
nil 0 nil
"push"
(apply 'nconc
(mapcar (lambda (arg) (list "-r" arg)) marked-list)))
(error "No log entries selected for push"))))
(defvar vc-hg-error-regexp-alist nil
;; 'hg pull' does not list modified files, so, for now, the only
;; benefit of `vc-compilation-mode' is that one can get rid of
@ -682,6 +668,47 @@ REV is the revision to check out into WORKFILE."
"Value of `compilation-error-regexp-alist' in *vc-hg* buffers.")
(autoload 'vc-do-async-command "vc-dispatcher")
(autoload 'log-view-get-marked "log-view")
(defun vc-hg--pushpull (command prompt &optional obsolete)
"Run COMMAND (a string; either push or pull) on the current Hg branch.
If PROMPT is non-nil, prompt for the Hg command to run.
If OBSOLETE is non-nil, behave like the old versions of the Hg push/pull
commands, which only operated on marked files."
(let (marked-list)
;; The `vc-hg-pull' and `vc-hg-push' commands existed before the
;; `pull'/`push' VC actions were implemented.
;; The following is for backwards compatibility.
(if (and obsolete (setq marked-list (log-view-get-marked)))
(apply #'vc-hg-command
nil 0 nil
command
(apply 'nconc
(mapcar (lambda (arg) (list "-r" arg)) marked-list)))
(let* ((root (vc-hg-root default-directory))
(buffer (format "*vc-hg : %s*" (expand-file-name root)))
(hg-program vc-hg-program)
;; Fixme: before updating the working copy to the latest
;; state, should check if it's visiting an old revision.
(args (if (equal command "pull") '("-u"))))
;; If necessary, prompt for the exact command.
;; TODO if pushing, prompt if no default push location - cf bzr.
(when prompt
(setq args (split-string
(read-shell-command
(format "Hg %s command: " command)
(format "%s %s%s" hg-program command
(if (not args) ""
(concat " " (mapconcat 'identity args " "))))
'vc-hg-history)
" " t))
(setq hg-program (car args)
command (cadr args)
args (cddr args)))
(apply 'vc-do-async-command buffer root hg-program command args)
(with-current-buffer buffer
(vc-run-delayed (vc-compilation-mode 'hg)))
(vc-set-async-update buffer)))))
(defun vc-hg-pull (prompt)
"Issue a Mercurial pull command.
@ -693,39 +720,17 @@ specific Mercurial pull command. The default is \"hg pull -u\",
which fetches changesets from the default remote repository and
then attempts to update the working directory."
(interactive "P")
(let (marked-list)
;; The `vc-hg-pull' command existed before the `pull' VC action
;; was implemented. Keep it for backward compatibility.
(if (and (called-interactively-p 'interactive)
(setq marked-list (log-view-get-marked)))
(apply #'vc-hg-command
nil 0 nil
"pull"
(apply 'nconc
(mapcar (lambda (arg) (list "-r" arg))
marked-list)))
(let* ((root (vc-hg-root default-directory))
(buffer (format "*vc-hg : %s*" (expand-file-name root)))
(command "pull")
(hg-program vc-hg-program)
;; Fixme: before updating the working copy to the latest
;; state, should check if it's visiting an old revision.
(args '("-u")))
;; If necessary, prompt for the exact command.
(when prompt
(setq args (split-string
(read-shell-command "Run Hg (like this): "
(format "%s pull -u" hg-program)
'vc-hg-history)
" " t))
(setq hg-program (car args)
command (cadr args)
args (cddr args)))
(apply 'vc-do-async-command buffer root hg-program
command args)
(with-current-buffer buffer
(vc-run-delayed (vc-compilation-mode 'hg)))
(vc-set-async-update buffer)))))
(vc-hg--pushpull "pull" prompt (called-interactively-p 'interactive)))
(defun vc-hg-push (prompt)
"Push changes from the current Mercurial branch.
Normally, this runs \"hg push\". If PROMPT is non-nil, prompt
for the Hg command to run.
If called interactively with a set of marked Log View buffers,
call \"hg push -r REVS\" to push the specified revisions REVS."
(interactive "P")
(vc-hg--pushpull "push" prompt (called-interactively-p 'interactive)))
(defun vc-hg-merge-branch ()
"Merge incoming changes into the current working directory.

6
lisp/vc/vc-hooks.el
View file

@ -883,6 +883,8 @@ current, and kill the buffer that visits the link."
(define-key map "u" 'vc-revert)
(define-key map "v" 'vc-next-action)
(define-key map "+" 'vc-update)
;; I'd prefer some kind of symmetry with vc-update:
(define-key map "P" 'vc-push)
(define-key map "=" 'vc-diff)
(define-key map "D" 'vc-root-diff)
(define-key map "~" 'vc-revision-other-window)
@ -940,6 +942,10 @@ current, and kill the buffer that visits the link."
(bindings--define-key map [vc-revert]
'(menu-item "Revert to Base Version" vc-revert
:help "Revert working copies of the selected file set to their repository contents"))
;; TODO Only :enable if (vc-find-backend-function backend 'push)
(bindings--define-key map [vc-push]
'(menu-item "Push Changes" vc-push
:help "Push the current branch's changes"))
(bindings--define-key map [vc-update]
'(menu-item "Update to Latest Version" vc-update
:help "Update the current fileset's files to their tip revisions"))

16
lisp/vc/vc.el
View file

@ -2484,6 +2484,22 @@ tip revision are merged into the working file."
;;;###autoload
(defalias 'vc-update 'vc-pull)
;;;###autoload
(defun vc-push (&optional arg)
"Push the current branch.
You must be visiting a version controlled file, or in a `vc-dir' buffer.
On a distributed version control system, this runs a \"push\"
operation on the current branch, prompting for the precise command
if required. Optional prefix ARG non-nil forces a prompt.
On a non-distributed version control system, this signals an error."
(interactive "P")
(let* ((vc-fileset (vc-deduce-fileset t))
(backend (car vc-fileset)))
;;; (files (cadr vc-fileset)))
(if (vc-find-backend-function backend 'push)
(vc-call-backend backend 'push arg)
(user-error "VC 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