(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 --git a/lisp/ChangeLog b/lisp/ChangeLog
index 01c01e104357d144b8b2351e15e2bc5c48e6c259..eb146df5d4ef50f38ff5074a8492809614d37d4d 100644 (file)
--- 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 5c8b50bc191a10d334dca28196864499a4d3a7ed..72d683fd549858b30d736f5e86753ad380b81210 100644 (file)
--- 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