From be14a4253c35de66b434959cbd8ae24129bed4e5 Mon Sep 17 00:00:00 2001 From: Dan Nicolaescu Date: Mon, 23 Mar 2009 16:25:30 +0000 Subject: [PATCH] (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. --- lisp/ChangeLog | 7 ++++++ lisp/vc-bzr.el | 59 ++++++++++++++++++++++++++++++++++++++++++-------- 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 + + * 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 * 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 -- 2.39.5