Mercurial > emacs
changeset 102704:acda56dde7fb
(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.
| author | Dan Nicolaescu <dann@ics.uci.edu> |
|---|---|
| date | Mon, 23 Mar 2009 16:25:30 +0000 |
| parents | d856a0c3b3a7 |
| children | 36389825b3d8 |
| files | lisp/ChangeLog lisp/vc-bzr.el |
| diffstat | 2 files changed, 57 insertions(+), 9 deletions(-) [+] |
line wrap: on
line diff
--- 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.
--- 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