(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.

2 files changed, 57 insertions, 9 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 01c01e10435..eb146df5d4e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -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 --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el
index 5c8b50bc191..72d683fd549 100644
--- a/lisp/vc-bzr.el
+++ b/lisp/vc-bzr.el
@@ -327,7 +327,24 @@ If any error occurred in running `bzr status', then return nil."
        (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 @@ stream.  Standard error output is discarded."
                        ;; 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 @@ stream.  Standard error output is discarded."
    `(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