[Emacs-diffs] /srv/bzr/emacs/trunk r102479: Initial support for unified DVCS pull and merge.

[Chong Yidong]

------------------------------------------------------------
revno: 102479
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Mon 2010-11-22 20:15:08 -0500
message:
  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.
modified:
  lisp/ChangeLog
  lisp/vc/vc-bzr.el
  lisp/vc/vc.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-11-22 22:09:17 +0000
+++ b/lisp/ChangeLog    2010-11-23 01:15:08 +0000
@@ -1,3 +1,16 @@
+2010-11-23  Chong Yidong  <address@hidden>
+
+       * 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  <address@hidden>
 
        * Makefile.in: Fix up last merge.

=== modified file 'lisp/vc/vc-bzr.el'
--- a/lisp/vc/vc-bzr.el 2010-11-09 20:07:10 +0000
+++ b/lisp/vc/vc-bzr.el 2010-11-23 01:15:08 +0000
@@ -115,6 +115,8 @@
   (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 @@
       (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 @@
   "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 @@
     (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

=== modified file 'lisp/vc/vc.el'
--- a/lisp/vc/vc.el     2010-11-12 13:44:46 +0000
+++ b/lisp/vc/vc.el     2010-11-23 01:15:08 +0000
@@ -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 @@
                           '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.
+(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.
 
-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)
+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 @@
 (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.