# HG changeset patch
# User Dan Nicolaescu <dann@ics.uci.edu>
# Date 1237825530 0
# Node ID acda56dde7fbf532eeab3a9b14034f9060002b36
# Parent  d856a0c3b3a7f2dde3df3ac1fa02392bafe28ed9
(vc-bzr-working-revision): Add support for lightweight
checkouts.  (Bug#2157)
(vc-bzr-after-dir-status): Ignore a warning for bzr status.
(vc-bzr-dir-extra-headers): Add headers for lightweight checkouts.

diff -r d856a0c3b3a7 -r acda56dde7fb lisp/ChangeLog
--- a/lisp/ChangeLog	Mon Mar 23 10:10:39 2009 +0000
+++ b/lisp/ChangeLog	Mon Mar 23 16:25:30 2009 +0000
@@ -1,3 +1,10 @@
+2009-03-23  Dan Nicolaescu  <dann@ics.uci.edu>
+
+	* vc-bzr.el (vc-bzr-working-revision): Add support for lightweight
+	checkouts.  (Bug#2157)
+	(vc-bzr-after-dir-status): Ignore a warning for bzr status.
+	(vc-bzr-dir-extra-headers): Add headers for lightweight checkouts.
+
 2009-03-22  Richard M Stallman  <rms@gnu.org>
 
 	* mail/rmail.el (rmail-expunge): Update summary buffer even if DONT-SHOW.
diff -r d856a0c3b3a7 -r acda56dde7fb lisp/vc-bzr.el
--- a/lisp/vc-bzr.el	Mon Mar 23 10:10:39 2009 +0000
+++ b/lisp/vc-bzr.el	Mon Mar 23 16:25:30 2009 +0000
@@ -327,7 +327,24 @@
        (lastrev-file (expand-file-name vc-bzr-admin-lastrev rootdir)))
     ;; This looks at internal files to avoid forking a bzr process.
     ;; May break if they change their format.
-    (if (file-exists-p branch-format-file)
+    (if (and (file-exists-p branch-format-file)
+	     ;; For lightweight checkouts (obtained with bzr checkout --lightweight)
+	     ;; the branch-format-file does not contain the revision
+	     ;; information, we need to look up the branch-format-file
+	     ;; in the place where the lightweight checkout comes
+	     ;; from.  We only do that if it's a local file.
+	     (let ((location-fname (expand-file-name
+				    (concat vc-bzr-admin-dirname
+					    "/branch/location") rootdir)))
+	       ;; The existence of this file is how we distinguish
+	       ;; lightweight checkouts.
+	       (if (file-exists-p location-fname)
+		   (with-temp-buffer
+		     (insert-file-contents location-fname)
+		     (when (re-search-forward "file://\(.+\)" nil t)
+		       (setq branch-format-file (match-string 1))
+		       (file-exists-p branch-format-file)))
+		 t)))
         (with-temp-buffer
           (insert-file-contents branch-format-file)
           (goto-char (point-min))
@@ -619,6 +636,11 @@
 		       ;; For a non existent file FOO, the output is:
 		       ;; bzr: ERROR: Path(s) do not exist: FOO
 		       ("bzr" . not-found)
+		       ;; If the tree is not up to date, bzr will print this warning:
+		       ;; working tree is out of date, run 'bzr update'
+		       ;; ignore it.
+		       ;; FIXME: maybe this warning can be put in the vc-dir header...
+		       ("wor" . not-found)
                        ;; Ignore "P " and "P." for pending patches.
                        ))
 	(translated nil)
@@ -671,16 +693,35 @@
    `(vc-bzr-after-dir-status (quote ,update-function))))
 
 (defun vc-bzr-dir-extra-headers (dir)
-  (let ((str (with-temp-buffer
-	       (vc-bzr-command "info" t 0 dir)
-	       (buffer-string))))
+  (let*
+      ((str (with-temp-buffer
+	      (vc-bzr-command "info" t 0 dir)
+	      (buffer-string)))
+       (light-checkout
+	(when (string-match ".+light checkout root: \\(.+\\)$" str)
+	  (match-string 1 str)))
+       (light-checkout-branch
+	(when light-checkout
+	  (when (string-match ".+checkout of branch: \\(.+\\)$" str)
+	    (match-string 1 str)))))
     (concat
-     (propertize "Parent branch: " 'face 'font-lock-type-face)
-     (propertize 
+     (propertize "Parent branch      : " 'face 'font-lock-type-face)
+     (propertize
       (if (string-match "parent branch: \\(.+\\)$" str)
-	  (match-string 1 str)
-	"None")
-       'face 'font-lock-variable-name-face))))
+ 	  (match-string 1 str)
+ 	"None")
+       'face 'font-lock-variable-name-face)
+     "\n"
+      (when light-checkout
+	(concat
+	 (propertize "Light checkout root: " 'face 'font-lock-type-face)
+	 (propertize light-checkout 'face 'font-lock-variable-name-face)
+	 "\n"))
+      (when light-checkout-branch
+	(concat
+	 (propertize "Checkout of branch : " 'face 'font-lock-type-face)
+	 (propertize light-checkout-branch 'face 'font-lock-variable-name-face)
+	 "\n")))))
 
 ;;; Revision completion