From 660c30cc8cec13cf0c2177c62f3c1acc23b04f7d Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 12 May 2015 20:42:42 -0400 Subject: [PATCH] Add basic VC push support. * 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. --- doc/emacs/emacs.texi | 2 +- doc/emacs/maintaining.texi | 36 +++++++++++++---- etc/NEWS | 3 ++ lisp/vc/vc-bzr.el | 44 ++++++++++++++------- lisp/vc/vc-dir.el | 10 ++++- lisp/vc/vc-git.el | 28 +++++++++---- lisp/vc/vc-hg.el | 81 ++++++++++++++++++++------------------ lisp/vc/vc-hooks.el | 6 +++ lisp/vc/vc.el | 16 ++++++++ 9 files changed, 155 insertions(+), 71 deletions(-) diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index 30c35a05125..21f645e1570 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -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. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index a1298864df6..8ec1cd223c3 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -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 diff --git a/etc/NEWS b/etc/NEWS index aa6a257a7f7..3f907db4954 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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 diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index a1f6bab5fd4..c9508251c8d 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -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 diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index e050c947504..eb03a8b45a7 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -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.") diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 2bca723ce77..20f21011642 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -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." diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index c302436d83b..556174a3821 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -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,51 +668,70 @@ 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-pull (prompt) - "Issue a Mercurial pull command. -If called interactively with a set of marked Log View buffers, -call \"hg pull -r REVS\" to pull in the specified revisions REVS. - -With a prefix argument or if PROMPT is non-nil, prompt for a -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") +(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' 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))) + ;; 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 - "pull" + command (apply 'nconc - (mapcar (lambda (arg) (list "-r" arg)) - marked-list))) + (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"))) + (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 "Run Hg (like this): " - (format "%s pull -u" hg-program) - 'vc-hg-history) + (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) + (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. +If called interactively with a set of marked Log View buffers, +call \"hg pull -r REVS\" to pull in the specified revisions REVS. + +With a prefix argument or if PROMPT is non-nil, prompt for a +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") + (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. This runs the command \"hg merge\"." diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 251fecb49c0..bae991936b5 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -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")) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 1a997a4d183..d5d0abe6517 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -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 -- 2.39.5