Mercurial > emacs
comparison lisp/vc-bzr.el @ 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 | e98ddfaefcae |
| children | b6ee4b011032 |
comparison
equal
deleted
inserted
replaced
| 102703:d856a0c3b3a7 | 102704:acda56dde7fb |
|---|---|
| 325 rootdir)) | 325 rootdir)) |
| 326 (revhistory-file (expand-file-name vc-bzr-admin-revhistory rootdir)) | 326 (revhistory-file (expand-file-name vc-bzr-admin-revhistory rootdir)) |
| 327 (lastrev-file (expand-file-name vc-bzr-admin-lastrev rootdir))) | 327 (lastrev-file (expand-file-name vc-bzr-admin-lastrev rootdir))) |
| 328 ;; This looks at internal files to avoid forking a bzr process. | 328 ;; This looks at internal files to avoid forking a bzr process. |
| 329 ;; May break if they change their format. | 329 ;; May break if they change their format. |
| 330 (if (file-exists-p branch-format-file) | 330 (if (and (file-exists-p branch-format-file) |
| 331 ;; For lightweight checkouts (obtained with bzr checkout --lightweight) | |
| 332 ;; the branch-format-file does not contain the revision | |
| 333 ;; information, we need to look up the branch-format-file | |
| 334 ;; in the place where the lightweight checkout comes | |
| 335 ;; from. We only do that if it's a local file. | |
| 336 (let ((location-fname (expand-file-name | |
| 337 (concat vc-bzr-admin-dirname | |
| 338 "/branch/location") rootdir))) | |
| 339 ;; The existence of this file is how we distinguish | |
| 340 ;; lightweight checkouts. | |
| 341 (if (file-exists-p location-fname) | |
| 342 (with-temp-buffer | |
| 343 (insert-file-contents location-fname) | |
| 344 (when (re-search-forward "file://\(.+\)" nil t) | |
| 345 (setq branch-format-file (match-string 1)) | |
| 346 (file-exists-p branch-format-file))) | |
| 347 t))) | |
| 331 (with-temp-buffer | 348 (with-temp-buffer |
| 332 (insert-file-contents branch-format-file) | 349 (insert-file-contents branch-format-file) |
| 333 (goto-char (point-min)) | 350 (goto-char (point-min)) |
| 334 (cond | 351 (cond |
| 335 ((or | 352 ((or |
| 617 ;; No such state, but we need to distinguish this case. | 634 ;; No such state, but we need to distinguish this case. |
| 618 ("R " . renamed) | 635 ("R " . renamed) |
| 619 ;; For a non existent file FOO, the output is: | 636 ;; For a non existent file FOO, the output is: |
| 620 ;; bzr: ERROR: Path(s) do not exist: FOO | 637 ;; bzr: ERROR: Path(s) do not exist: FOO |
| 621 ("bzr" . not-found) | 638 ("bzr" . not-found) |
| 639 ;; If the tree is not up to date, bzr will print this warning: | |
| 640 ;; working tree is out of date, run 'bzr update' | |
| 641 ;; ignore it. | |
| 642 ;; FIXME: maybe this warning can be put in the vc-dir header... | |
| 643 ("wor" . not-found) | |
| 622 ;; Ignore "P " and "P." for pending patches. | 644 ;; Ignore "P " and "P." for pending patches. |
| 623 )) | 645 )) |
| 624 (translated nil) | 646 (translated nil) |
| 625 (result nil)) | 647 (result nil)) |
| 626 (goto-char (point-min)) | 648 (goto-char (point-min)) |
| 669 (apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files) | 691 (apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files) |
| 670 (vc-exec-after | 692 (vc-exec-after |
| 671 `(vc-bzr-after-dir-status (quote ,update-function)))) | 693 `(vc-bzr-after-dir-status (quote ,update-function)))) |
| 672 | 694 |
| 673 (defun vc-bzr-dir-extra-headers (dir) | 695 (defun vc-bzr-dir-extra-headers (dir) |
| 674 (let ((str (with-temp-buffer | 696 (let* |
| 675 (vc-bzr-command "info" t 0 dir) | 697 ((str (with-temp-buffer |
| 676 (buffer-string)))) | 698 (vc-bzr-command "info" t 0 dir) |
| 699 (buffer-string))) | |
| 700 (light-checkout | |
| 701 (when (string-match ".+light checkout root: \\(.+\\)$" str) | |
| 702 (match-string 1 str))) | |
| 703 (light-checkout-branch | |
| 704 (when light-checkout | |
| 705 (when (string-match ".+checkout of branch: \\(.+\\)$" str) | |
| 706 (match-string 1 str))))) | |
| 677 (concat | 707 (concat |
| 678 (propertize "Parent branch: " 'face 'font-lock-type-face) | 708 (propertize "Parent branch : " 'face 'font-lock-type-face) |
| 679 (propertize | 709 (propertize |
| 680 (if (string-match "parent branch: \\(.+\\)$" str) | 710 (if (string-match "parent branch: \\(.+\\)$" str) |
| 681 (match-string 1 str) | 711 (match-string 1 str) |
| 682 "None") | 712 "None") |
| 683 'face 'font-lock-variable-name-face)))) | 713 'face 'font-lock-variable-name-face) |
| 714 "\n" | |
| 715 (when light-checkout | |
| 716 (concat | |
| 717 (propertize "Light checkout root: " 'face 'font-lock-type-face) | |
| 718 (propertize light-checkout 'face 'font-lock-variable-name-face) | |
| 719 "\n")) | |
| 720 (when light-checkout-branch | |
| 721 (concat | |
| 722 (propertize "Checkout of branch : " 'face 'font-lock-type-face) | |
| 723 (propertize light-checkout-branch 'face 'font-lock-variable-name-face) | |
| 724 "\n"))))) | |
| 684 | 725 |
| 685 ;;; Revision completion | 726 ;;; Revision completion |
| 686 | 727 |
| 687 (defun vc-bzr-revision-completion-table (files) | 728 (defun vc-bzr-revision-completion-table (files) |
| 688 (lexical-let ((files files)) | 729 (lexical-let ((files files)) |