[Emacs-diffs] master 660c30c: Add basic VC push support.

[Glenn Morris]

branch: master
commit 660c30cc8cec13cf0c2177c62f3c1acc23b04f7d
Author: Glenn Morris <address@hidden>
Commit: Glenn Morris <address@hidden>

    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 30c35a0..21f645e 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 a129886..8ec1cd2 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.
 
address@hidden VC Pull
address@hidden Pulling Changes into a Branch
address@hidden Pulling / Pushing
address@hidden 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.
+
address@hidden 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.
 
address@hidden C-x v P
address@hidden 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 aa6a257..3f907db 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 a1f6bab..c950825 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 e050c94..eb03a8b 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 2bca723..20f2101 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 c302436..556174a 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 251fecb..bae9919 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 1a997a4..d5d0abe 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