[Emacs-diffs] emacs/lisp ChangeLog vc-bzr.el

[Dan Nicolaescu]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Dan Nicolaescu <dann>   09/03/23 16:25:34

Modified files:
        lisp           : ChangeLog vc-bzr.el 

Log message:
        (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.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/ChangeLog?cvsroot=emacs&r1=1.15516&r2=1.15517
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/vc-bzr.el?cvsroot=emacs&r1=1.74&r2=1.75

Patches:
Index: ChangeLog
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.15516
retrieving revision 1.15517
diff -u -b -r1.15516 -r1.15517
--- ChangeLog   22 Mar 2009 14:51:17 -0000      1.15516
+++ ChangeLog   23 Mar 2009 16:25:30 -0000      1.15517
@@ -1,3 +1,10 @@
+2009-03-23  Dan Nicolaescu  <address@hidden>
+
+       * 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  <address@hidden>
 
        * mail/rmail.el (rmail-expunge): Update summary buffer even if 
DONT-SHOW.

Index: vc-bzr.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/vc-bzr.el,v
retrieving revision 1.74
retrieving revision 1.75
diff -u -b -r1.74 -r1.75
--- vc-bzr.el   4 Feb 2009 07:32:53 -0000       1.74
+++ vc-bzr.el   23 Mar 2009 16:25:33 -0000      1.75
@@ -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
+  (let*
+      ((str (with-temp-buffer
               (vc-bzr-command "info" t 0 dir)
-              (buffer-string))))
+             (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 "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))))
+       '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