Mercurial > emacs

--- a/lisp/ChangeLog	Tue Nov 23 00:03:44 2010 +0000
+++ b/lisp/ChangeLog	Mon Nov 22 20:15:08 2010 -0500
@@ -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.
--- a/lisp/vc/vc-bzr.el	Tue Nov 23 00:03:44 2010 +0000
+++ b/lisp/vc/vc-bzr.el	Mon Nov 22 20:15:08 2010 -0500
@@ -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
--- a/lisp/vc/vc.el	Tue Nov 23 00:03:44 2010 +0000
+++ b/lisp/vc/vc.el	Mon Nov 22 20:15:08 2010 -0500
@@ -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.