[Emacs-diffs] /srv/bzr/emacs/trunk r103017: Rudimentary support for vc-pull and vc-merge in Git and Mercurial.

[Chong Yidong]

------------------------------------------------------------
revno: 103017
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Fri 2011-01-28 22:12:32 -0500
message:
  Rudimentary support for vc-pull and vc-merge in Git and Mercurial.
  
  * lisp/vc/vc.el (vc-pull): Make vc-update an alias for this, instead of
  the other way around.
  
  * lisp/vc/vc-git.el (vc-git-branches, vc-git-pull)
  (vc-git-merge-branch): New functions.
  (vc-git-history): New var.
  
  * lisp/vc/vc-hg.el (vc-hg-history): New var.
  (vc-hg-pull): Perform default pull if called via Lisp by vc-pull.
  (vc-hg-merge-branch): New function.
modified:
  etc/NEWS
  lisp/ChangeLog
  lisp/vc/vc-dispatcher.el
  lisp/vc/vc-git.el
  lisp/vc/vc-hg.el
  lisp/vc/vc.el

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2011-01-28 22:12:05 +0000
+++ b/etc/NEWS  2011-01-29 03:12:32 +0000
@@ -589,20 +589,20 @@
 ** VC and related modes
 
 *** Support for pulling on distributed version control systems.
-The vc-update command now runs a "pull" operation, if it is supported.
+The vc-pull command runs a "pull" operation, if it is supported.
 This updates the current branch from upstream.  A prefix argument
-means to prompt the user for command specifics, e.g. a pull location.
-
-**** vc-pull is an alias for vc-update.
-
-**** Currently supported by Bzr.
+means to prompt the user for specifics, e.g. a pull location.
+
+**** vc-update is now an alias for vc-update.
+
+**** Currently supported by Bzr, Git, and Mercurial.
 
 *** Support for merging on distributed version control systems.
 The vc-merge command now runs a "merge" operation, if it is supported.
-This merges another branch into the current one.  A prefix argument
-means to prompt the user for command specifics, e.g. a merge location.
+This merges another branch into the current one.  This command prompts
+the user for specifics, e.g. a merge source.
 
-**** Currently supported by Bzr.
+**** Currently supported by Bzr, Git, and Mercurial.
 
 ** Miscellaneous
 

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-01-28 23:10:55 +0000
+++ b/lisp/ChangeLog    2011-01-29 03:12:32 +0000
@@ -1,3 +1,16 @@
+2011-01-29  Chong Yidong  <address@hidden>
+
+       * vc/vc-hg.el (vc-hg-history): New var.
+       (vc-hg-pull): Perform default pull if called via Lisp by vc-pull.
+       (vc-hg-merge-branch): New function.
+
+       * vc/vc.el (vc-pull): Make vc-update an alias for this, instead of
+       the other way around.
+
+       * vc/vc-git.el (vc-git-branches, vc-git-pull)
+       (vc-git-merge-branch): New functions.
+       (vc-git-history): New var.
+
 2011-01-28  Chong Yidong  <address@hidden>
 
        * vc/vc-dispatcher.el (vc-do-async-command): New function.

=== modified file 'lisp/vc/vc-dispatcher.el'
--- a/lisp/vc/vc-dispatcher.el  2011-01-28 23:10:55 +0000
+++ b/lisp/vc/vc-dispatcher.el  2011-01-29 03:12:32 +0000
@@ -373,7 +373,7 @@
       (unless (eq (point) (point-min))
        (insert "\n"))
       (setq new-window-start (point))
-      (insert "Running \"" command " ")
+      (insert "Running \"" command)
       (dolist (arg args)
        (insert " " arg))
       (insert "\"...\n")

=== modified file 'lisp/vc/vc-git.el'
--- a/lisp/vc/vc-git.el 2011-01-25 04:08:28 +0000
+++ b/lisp/vc/vc-git.el 2011-01-29 03:12:32 +0000
@@ -122,6 +122,9 @@
 (defvar vc-git-commits-coding-system 'utf-8
   "Default coding system for git commits.")
 
+;; History of Git commands.
+(defvar vc-git-history nil)
+
 ;;; BACKEND PROPERTIES
 
 (defun vc-git-revision-granularity () 'repository)
@@ -526,6 +529,21 @@
                    'help-echo stash-help-echo
                    'face 'font-lock-variable-name-face))))))
 
+(defun vc-git-branches ()
+  "Return the existing branches, as a list of strings.
+The car of the list is the current branch."
+  (with-temp-buffer
+    (call-process "git" nil t nil "branch")
+    (goto-char (point-min))
+    (let (current-branch branches)
+      (while (not (eobp))
+       (when (looking-at "^\\([ *]\\) \\(.+\\)$")
+         (if (string-equal (match-string 1) "*")
+             (setq current-branch (match-string 2))
+           (push (match-string 2) branches)))
+       (forward-line 1))
+      (cons current-branch (nreverse branches)))))
+
 ;;; STATE-CHANGING FUNCTIONS
 
 (defun vc-git-create-repo ()
@@ -587,6 +605,39 @@
     (vc-git-command nil 0 file "reset" "-q" "--")
     (vc-git-command nil nil file "checkout" "-q" "--")))
 
+(defun vc-git-pull (prompt)
+  "Pull changes into the current Git branch.
+Normally, this runs \"git pull\".If there is no default
+location from which to pull or update, or 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 "git")
+        args)
+    ;; If necessary, prompt for the exact command.
+    (when prompt
+      (setq args (split-string
+                 (read-shell-command "Run Git (like this): "
+                                     "git pull"
+                                     'vc-git-history)
+                 " " t))
+      (setq git-program (car  args)
+           command     (cadr args)
+           args        (cddr args)))
+    (apply 'vc-do-async-command buffer root git-program command args)))
+
+(defun vc-git-merge-branch ()
+  "Merge changes into the current Git branch.
+This prompts for a branch to merge from."
+  (let* ((root (vc-git-root default-directory))
+        (buffer (format "*vc-git : %s*" (expand-file-name root)))
+        (branches (cdr (vc-git-branches)))
+        (merge-source
+         (completing-read "Merge from branch: " branches nil t)))
+    (apply 'vc-do-async-command buffer root "git" "merge"
+          (list merge-source))))
+
 ;;; HISTORY FUNCTIONS
 
 (defun vc-git-print-log (files buffer &optional shortlog start-revision limit)

=== modified file 'lisp/vc/vc-hg.el'
--- a/lisp/vc/vc-hg.el  2011-01-25 04:08:28 +0000
+++ b/lisp/vc/vc-hg.el  2011-01-29 03:12:32 +0000
@@ -141,6 +141,8 @@
 
 ;;; Properties of the backend
 
+(defvar vc-hg-history nil)
+
 (defun vc-hg-revision-granularity () 'repository)
 (defun vc-hg-checkout-model (files) 'implicit)
 
@@ -607,16 +609,41 @@
                       (mapcar (lambda (arg) (list "-r" arg)) marked-list)))
       (error "No log entries selected for push"))))
 
-(defun vc-hg-pull ()
-  (interactive)
-  (let ((marked-list (log-view-get-marked)))
-    (if marked-list
-        (apply #'vc-hg-command
-               nil 0 nil
-               "pull"
-               (apply 'nconc
-                      (mapcar (lambda (arg) (list "-r" arg)) marked-list)))
-      (error "No log entries selected for pull"))))
+(defun vc-hg-pull (prompt)
+  (interactive "P")
+  (let (marked-list)
+    (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 "hg")
+            ;; Todo: maybe check if we're up-to-date before updating
+            ;; the working copy to the latest state.
+            (args '("-u")))
+       ;; If necessary, prompt for the exact command.
+       (when prompt
+         (setq args (split-string
+                     (read-shell-command "Run Hg (like this): " "hg -u"
+                                         '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)))))
+
+(defun vc-hg-merge-branch ()
+  "Merge incoming changes into the current Mercurial working directory."
+  (let* ((root (vc-hg-root default-directory))
+        (buffer (format "*vc-hg : %s*" (expand-file-name root))))
+    (apply 'vc-do-async-command buffer root "hg" '("merge"))))
 
 ;;; Internal functions
 

=== modified file 'lisp/vc/vc.el'
--- a/lisp/vc/vc.el     2011-01-26 08:36:39 +0000
+++ b/lisp/vc/vc.el     2011-01-29 03:12:32 +0000
@@ -2297,7 +2297,7 @@
 (define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1")
 
 ;;;###autoload
-(defun vc-update (&optional arg)
+(defun vc-pull (&optional arg)
   "Update the current fileset or branch.
 On a distributed version control system, this runs a \"pull\"
 operation to update the current branch, prompting for an argument
@@ -2337,7 +2337,7 @@
       (error "VC update is unsupported for `%s'" backend)))))
 
 ;;;###autoload
-(defalias 'vc-pull 'vc-update)
+(defalias 'vc-update 'vc-pull)
 
 (defun vc-version-backup-file (file &optional rev)
   "Return name of backup file for revision REV of FILE.