Initial support for unified DVCS pull and merge.

* lisp/vc/vc-bzr.el (vc-bzr-admin-branchconf, vc-bzr-history): New vars.
(vc-bzr--branch-conf, vc-bzr-async-command, vc-bzr-pull)
(vc-bzr-merge-branch): New functions, implementing merge-branch
and pull operations.

* lisp/vc/vc.el (vc-merge): Use vc-BACKEND-merge-branch if available.
Accept optional prefix arg meaning to prompt for a command.
(vc-update): Use vc-BACKEND-pull if available.  Accept optional
prefix arg meaning to prompt for a command.
(vc-pull): Alias for vc-update.

3 files changed, 224 insertions, 80 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 763d73c883b..f86ff355fa9 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,16 @@
+2010-11-23  Chong Yidong  <cyd@stupidchicken.com>
+
+        * vc/vc.el (vc-merge): Use vc-BACKEND-merge-branch if available.
+        Accept optional prefix arg meaning to prompt for a command.
+        (vc-update): Use vc-BACKEND-pull if available.  Accept optional
+        prefix arg meaning to prompt for a command.
+        (vc-pull): Alias for vc-update.
+
+        * vc/vc-bzr.el (vc-bzr-admin-branchconf, vc-bzr-history): New vars.
+        (vc-bzr--branch-conf, vc-bzr-async-command, vc-bzr-pull)
+        (vc-bzr-merge-branch): New functions, implementing merge-branch
+        and pull operations.
+
 2010-11-22  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * Makefile.in: Fix up last merge.
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index 78441772bd4..9f8a018cec5 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -115,6 +115,8 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
   (concat vc-bzr-admin-dirname "/branch/revision-history"))
 (defconst vc-bzr-admin-lastrev
   (concat vc-bzr-admin-dirname "/branch/last-revision"))
+(defconst vc-bzr-admin-branchconf
+  (concat vc-bzr-admin-dirname "/branch/branch.conf"))
 
 ;;;###autoload (defun vc-bzr-registered (file)
 ;;;###autoload   (if (vc-find-root file vc-bzr-admin-checkout-format-file)
@@ -129,6 +131,13 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
       (let ((root (vc-find-root file vc-bzr-admin-checkout-format-file)))
         (when root (vc-file-setprop file 'bzr-root root)))))
 
+(defun vc-bzr--branch-conf (file)
+  "Return the Bzr branch config for file FILE, as a string."
+  (with-temp-buffer
+    (insert-file-contents
+     (expand-file-name vc-bzr-admin-branchconf (vc-bzr-root file)))
+    (buffer-string)))
+
 (require 'sha1)                         ;For sha1-program
 
 (defun vc-bzr-sha1 (file)
@@ -228,6 +237,9 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
   "added\\|ignored\\|kind changed\\|modified\\|removed\\|renamed\\|unknown"
   "Regexp matching file status words as reported in `bzr' output.")
 
+;; History of Bzr commands.
+(defvar vc-bzr-history nil)
+
 (defun vc-bzr-file-name-relative (filename)
   "Return file name FILENAME stripped of the initial Bzr repository path."
   (lexical-let*
@@ -236,6 +248,87 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
     (when rootdir
          (file-relative-name filename* rootdir))))
 
+(defun vc-bzr-async-command (command args)
+  "Run Bzr COMMAND asynchronously with ARGS, displaying the result.
+Send the output to a buffer named \"*vc-bzr : NAME*\", where NAME
+is the root of the current Bzr branch.  Display the buffer in
+some window, but don't select it."
+  ;; TODO: set up hyperlinks.
+  (let* ((dir default-directory)
+         (root (vc-bzr-root default-directory))
+         (buffer (get-buffer-create (format "*vc-bzr : %s*" root))))
+    (with-current-buffer buffer
+      (setq default-directory root)
+      (goto-char (point-max))
+      (unless (eq (point) (point-min))
+        (insert "\n"))
+      (insert "Running \"" vc-bzr-program " " command)
+      (dolist (arg args)
+        (insert " " arg))
+      (insert "\"...\n")
+      ;; Run bzr in the original working directory.
+      (let ((default-directory dir))
+        (apply 'vc-bzr-command command t 'async nil args)))
+    (display-buffer buffer)))
+
+(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."
+  (let* ((vc-bzr-program vc-bzr-program)
+         (branch-conf (vc-bzr--branch-conf default-directory))
+         ;; Check whether the branch is bound.
+         (bound (string-match "^bound\\s-*=\\s-*True" branch-conf))
+         ;; If we need to do a "bzr pull", check for a parent.  If it
+         ;; does not exist, bzr will need a pull location.
+         (parent (unless bound
+                   (string-match
+                    "^parent_location\\s-*=\\s-*[^\n[:space:]]+"
+                    branch-conf)))
+         (command (if bound "update" "pull"))
+         args buf)
+    ;; If necessary, prompt for the exact command.
+    (when (or prompt (not (or bound parent)))
+      (setq args (split-string
+                  (read-shell-command
+                   "Run Bzr (like this): "
+                   (concat vc-bzr-program " " command)
+                   'vc-bzr-history)
+                  " " t))
+      (setq vc-bzr-program (car  args)
+            command        (cadr args)
+            args           (cddr args)))
+    (vc-bzr-async-command command args)))
+
+(defun vc-bzr-merge-branch (prompt)
+  "Merge another Bzr branch into the current one.
+If a default merge source is defined (i.e. an upstream branch or
+a previous merge source), this normally runs \"bzr merge --pull\".
+If optional PROMPT is non-nil or no default merge source is
+defined, prompt for the Bzr command to run."
+  (let* ((vc-bzr-program vc-bzr-program)
+         (command "merge")
+         (args '("--pull"))
+         command-string args buf)
+    (when (or prompt
+              ;; Prompt if there is no default merge source.
+              (null
+               (string-match
+                "^\\(parent_location\\|submit_branch\\)\\s-*=\\s-*[^\n[:space:]]+"
+                (vc-bzr--branch-conf default-directory))))
+      (setq args (split-string
+                  (read-shell-command
+                   "Run Bzr (like this): "
+                   (concat vc-bzr-program " " command " --pull")
+                   'vc-bzr-history)
+                  " " t))
+      (setq vc-bzr-program (car  args)
+            command        (cadr args)
+            args           (cddr args)))
+    (vc-bzr-async-command command args)))
+
 (defun vc-bzr-status (file)
   "Return FILE status according to Bzr.
 Return value is a cons (STATUS . WARNING), where WARNING is a
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 56bf353b6b4..d8741c3752e 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -100,7 +100,7 @@
 ;; In the list of functions below, each identifier needs to be prepended
 ;; with `vc-sys-'.  Some of the functions are mandatory (marked with a
 ;; `*'), others are optional (`-').
-;;
+
 ;; BACKEND PROPERTIES
 ;;
 ;; * revision-granularity
@@ -109,7 +109,7 @@
 ;;   that return 'file have per-file revision numbering; backends
 ;;   that return 'repository have per-repository revision numbering,
 ;;   so a revision level implicitly identifies a changeset
-;;
+
 ;; STATE-QUERYING FUNCTIONS
 ;;
 ;; * registered (file)
@@ -313,11 +313,24 @@
 ;;
 ;; - merge (file rev1 rev2)
 ;;
-;;   Merge the changes between REV1 and REV2 into the current working file.
+;;   Merge the changes between REV1 and REV2 into the current working file
+;;   (for non-distributed VCS).
+;;
+;; - merge-branch (prompt)
+;;
+;;   Merge another branch into the current one.  If PROMPT is non-nil,
+;;   or if necessary, prompt for a location to merge from.
 ;;
 ;; - merge-news (file)
 ;;
 ;;   Merge recent changes from the current branch into FILE.
+;;   (for non-distributed VCS).
+;;
+;; - pull (prompt)
+;;
+;;   Pull "upstream" changes into the current branch (for distributed
+;;   VCS).  If PROMPT is non-nil, or if necessary, prompt for a
+;;   location to pull from.
 ;;
 ;; - steal-lock (file &optional revision)
 ;;
@@ -335,7 +348,7 @@
 ;;
 ;;   Mark conflicts as resolved.  Some VC systems need to run a
 ;;   command to mark conflicts as resolved.
-;;
+
 ;; HISTORY FUNCTIONS
 ;;
 ;; * print-log (files buffer &optional shortlog start-revision limit)
@@ -440,7 +453,7 @@
 ;;   If the backend supports annotating through copies and renames,
 ;;   and displays a file name and a revision, then return a cons
 ;;   (REVISION . FILENAME).
-;;
+
 ;; TAG SYSTEM
 ;;
 ;; - create-tag (dir name branchp)
@@ -461,7 +474,7 @@
 ;;   does a sanity check whether there aren't any uncommitted changes at
 ;;   or below DIR, and then performs a tree walk, using the `checkout'
 ;;   function to retrieve the corresponding revisions.
-;;
+
 ;; MISCELLANEOUS
 ;;
 ;; - make-version-backups-p (file)
@@ -1815,54 +1828,67 @@ The headers are reset to their non-expanded form."
                           'modify-change-comment files rev comment))))))
 
 ;;;###autoload
-(defun vc-merge ()
-  "Merge changes between two revisions into the current buffer's file.
-This asks for two revisions to merge from in the minibuffer.  If the
-first revision is a branch number, then merge all changes from that
-branch.  If the first revision is empty, merge news, i.e. recent changes
-from the current branch.
-
-See Info node `Merging'."
-  (interactive)
-  (vc-ensure-vc-buffer)
-  (vc-buffer-sync)
-  (let* ((file buffer-file-name)
-         (backend (vc-backend file))
-         (state (vc-state file))
-         first-revision second-revision status)
+(defun vc-merge (&optional arg)
+  "Perform a version control merge operation.
+On a distributed version control system, this runs a \"merge\"
+operation to incorporate changes from another branch onto the
+current branch, prompting for an argument list if required.
+Optional prefix ARG forces a prompt.
+
+On a non-distributed version control system, this merges changes
+between two revisions into the current fileset.  This asks for
+two revisions to merge from in the minibuffer.  If the first
+revision is a branch number, then merge all changes from that
+branch.  If the first revision is empty, merge the most recent
+changes from the current branch."
+  (interactive "P")
+  (let* ((vc-fileset (vc-deduce-fileset t))
+         (backend (car vc-fileset))
+         (files (cadr vc-fileset)))
     (cond
-     ((stringp state)   ;; Locking VCses only
-      (error "File is locked by %s" state))
-     ((not (vc-editable-p file))
-      (if (y-or-n-p
-           "File must be checked out for merging.  Check out now? ")
-          (vc-checkout file t)
-        (error "Merge aborted"))))
-    (setq first-revision
-          (vc-read-revision
-           (concat "Branch or revision to merge from "
-                   "(default news on current branch): ")
-           (list file)
-           backend))
-    (if (string= first-revision "")
-        (setq status (vc-call-backend backend 'merge-news file))
-      (if (not (vc-find-backend-function backend 'merge))
-          (error "Sorry, merging is not implemented for %s" backend)
-        (if (not (vc-branch-p first-revision))
-            (setq second-revision
-                  (vc-read-revision
-                   "Second revision: "
-                   (list file) backend nil
-                   ;; FIXME: This is CVS/RCS/SCCS specific.
-                   (concat (vc-branch-part first-revision) ".")))
-          ;; We want to merge an entire branch.  Set revisions
-          ;; accordingly, so that vc-BACKEND-merge understands us.
-          (setq second-revision first-revision)
-          ;; first-revision must be the starting point of the branch
-          (setq first-revision (vc-branch-part first-revision)))
-        (setq status (vc-call-backend backend 'merge file
-                                      first-revision second-revision))))
-    (vc-maybe-resolve-conflicts file status "WORKFILE" "MERGE SOURCE")))
+     ;; If a branch-merge operation is defined, use it.
+     ((vc-find-backend-function backend 'merge-branch)
+      (vc-call-backend backend 'merge-branch arg))
+     ;; Otherwise, do a per-file merge.
+     ((vc-find-backend-function backend 'merge)
+      (vc-buffer-sync)
+      (dolist (file files)
+        (let* ((state (vc-state file))
+               first-revision second-revision status)
+          (cond
+           ((stringp state)     ;; Locking VCses only
+            (error "File %s is locked by %s" file state))
+           ((not (vc-editable-p file))
+            (vc-checkout file t)))
+          (setq first-revision
+                (vc-read-revision
+                 (concat "Merge " file
+                         "from branch or revision "
+                         "(default news on current branch): ")
+                 (list file)
+                 backend))
+          (cond
+           ((string= first-revision "")
+            (setq status (vc-call-backend backend 'merge-news file)))
+           (t
+            (if (not (vc-branch-p first-revision))
+                (setq second-revision
+                      (vc-read-revision
+                       "Second revision: "
+                       (list file) backend nil
+                       ;; FIXME: This is CVS/RCS/SCCS specific.
+                       (concat (vc-branch-part first-revision) ".")))
+              ;; We want to merge an entire branch.  Set revisions
+              ;; accordingly, so that vc-BACKEND-merge understands us.
+              (setq second-revision first-revision)
+              ;; first-revision must be the starting point of the branch
+              (setq first-revision (vc-branch-part first-revision)))
+            (setq status (vc-call-backend backend 'merge file
+                                          first-revision second-revision))))
+          (vc-maybe-resolve-conflicts file status "WORKFILE" "MERGE SOURCE"))))
+     (t
+      (error "Sorry, merging is not implemented for %s" backend)))))
+
 
 (defun vc-maybe-resolve-conflicts (file status &optional name-A name-B)
   (vc-resynch-buffer file t (not (buffer-modified-p)))
@@ -2274,35 +2300,47 @@ depending on the underlying version-control system."
 (define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1")
 
 ;;;###autoload
-(defun vc-update ()
-  "Update the current fileset's files to their tip revisions.
-For each one that contains no changes, and is not locked, then this simply
-replaces the work file with the latest revision on its branch.  If the file
-contains changes, and the backend supports merging news, then any recent
-changes from the current branch are merged into the working file."
-  (interactive)
-  (let* ((vc-fileset (vc-deduce-fileset))
+(defun vc-update (&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
+list if required.  Optional prefix ARG forces a prompt.
+
+On a non-distributed version control system, update the current
+fileset to the tip revisions.  For each unchanged and unlocked
+file, this simply replaces the work file with the latest revision
+on its branch.  If the file contains changes, any changes in the
+tip revision are merged into the working file."
+  (interactive "P")
+  (let* ((vc-fileset (vc-deduce-fileset t))
          (backend (car vc-fileset))
          (files (cadr vc-fileset)))
-    (save-some-buffers          ; save buffers visiting files
-     nil (lambda ()
-           (and (buffer-modified-p)
-                (let ((file (buffer-file-name)))
-                  (and file (member file files))))))
-    (dolist (file files)
-      (if (vc-up-to-date-p file)
-          (vc-checkout file nil t)
-        (if (eq (vc-checkout-model backend (list file)) 'locking)
-            (if (eq (vc-state file) 'edited)
-                (error "%s"
-                       (substitute-command-keys
-                        "File is locked--type \\[vc-revert] to discard changes"))
-              (error "Unexpected file state (%s) -- type %s"
-                     (vc-state file)
-                     (substitute-command-keys
-                      "\\[vc-next-action] to correct")))
-          (vc-maybe-resolve-conflicts
-           file (vc-call-backend backend 'merge-news file)))))))
+    (cond
+     ;; If a pull operation is defined, use it.
+     ((vc-find-backend-function backend 'pull)
+      (vc-call-backend backend 'pull arg))
+     ;; If VCS has `merge-news' functionality (CVS and SVN), use it.
+     ((vc-find-backend-function backend 'merge-news)
+      (save-some-buffers ; save buffers visiting files
+       nil (lambda ()
+             (and (buffer-modified-p)
+                  (let ((file (buffer-file-name)))
+                    (and file (member file files))))))
+      (dolist (file files)
+        (if (vc-up-to-date-p file)
+            (vc-checkout file nil t)
+          (vc-maybe-resolve-conflicts
+           file (vc-call-backend backend 'merge-news file)))))
+     ;; For a locking VCS, check out each file.
+     ((eq (vc-checkout-model backend files) 'locking)
+      (dolist (file files)
+        (if (vc-up-to-date-p file)
+            (vc-checkout file nil t))))
+     (t
+      (error "VC update is unsupported for `%s'" backend)))))
+
+;;;###autoload
+(defalias 'vc-pull 'vc-update)
 
 (defun vc-version-backup-file (file &optional rev)
   "Return name of backup file for revision REV of FILE.