Mercurial > emacs
comparison lisp/vc-bzr.el @ 106677:f147ed43b1d5
Make vc-dir work on subdirectories of the bzr root.
* vc-bzr.el (vc-bzr-after-dir-status): Add new argument. Return
file names relative to it.
(vc-bzr-dir-status, vc-bzr-dir-status-files): Pass the bzr root
relative directory to vc-bzr-after-dir-status.
| author | Dan Nicolaescu <dann@ics.uci.edu> |
|---|---|
| date | Mon, 28 Dec 2009 22:46:08 -0800 |
| parents | 8437678ea169 |
| children | 82660e679622 |
comparison
equal
deleted
inserted
replaced
| 106676:cf3b293aa85d | 106677:f147ed43b1d5 |
|---|---|
| 637 (format " (renamed from %s)" | 637 (format " (renamed from %s)" |
| 638 (vc-bzr-extra-fileinfo->extra-name extra)) | 638 (vc-bzr-extra-fileinfo->extra-name extra)) |
| 639 'face 'font-lock-comment-face))))) | 639 'face 'font-lock-comment-face))))) |
| 640 | 640 |
| 641 ;; FIXME: this needs testing, it's probably incomplete. | 641 ;; FIXME: this needs testing, it's probably incomplete. |
| 642 (defun vc-bzr-after-dir-status (update-function) | 642 (defun vc-bzr-after-dir-status (update-function relative-dir) |
| 643 (let ((status-str nil) | 643 (let ((status-str nil) |
| 644 (translation '(("+N " . added) | 644 (translation '(("+N " . added) |
| 645 ("-D " . removed) | 645 ("-D " . removed) |
| 646 (" M " . edited) ;; file text modified | 646 (" M " . edited) ;; file text modified |
| 647 (" *" . edited) ;; execute bit changed | 647 (" *" . edited) ;; execute bit changed |
| 685 (entry (assoc file result))) | 685 (entry (assoc file result))) |
| 686 (when entry | 686 (when entry |
| 687 (setf (nth 1 entry) 'conflict)))) | 687 (setf (nth 1 entry) 'conflict)))) |
| 688 ((eq translated 'renamed) | 688 ((eq translated 'renamed) |
| 689 (re-search-forward "R \\(.*\\) => \\(.*\\)$" (line-end-position) t) | 689 (re-search-forward "R \\(.*\\) => \\(.*\\)$" (line-end-position) t) |
| 690 (let ((new-name (match-string 2)) | 690 (let ((new-name (file-relative-name (match-string 2) relative-dir)) |
| 691 (old-name (match-string 1))) | 691 (old-name (file-relative-name (match-string 1) relative-dir))) |
| 692 (push (list new-name 'edited | 692 (push (list new-name 'edited |
| 693 (vc-bzr-create-extra-fileinfo old-name)) result))) | 693 (vc-bzr-create-extra-fileinfo old-name)) result))) |
| 694 ;; do nothing for non existent files | 694 ;; do nothing for non existent files |
| 695 ((eq translated 'not-found)) | 695 ((eq translated 'not-found)) |
| 696 (t | 696 (t |
| 697 (push (list (buffer-substring-no-properties | 697 (push (list (file-relative-name |
| 698 (+ (point) 4) | 698 (buffer-substring-no-properties |
| 699 (line-end-position)) | 699 (+ (point) 4) |
| 700 (line-end-position)) relative-dir) | |
| 700 translated) result))) | 701 translated) result))) |
| 701 (forward-line)) | 702 (forward-line)) |
| 702 (funcall update-function result))) | 703 (funcall update-function result))) |
| 703 | 704 |
| 704 (defun vc-bzr-dir-status (dir update-function) | 705 (defun vc-bzr-dir-status (dir update-function) |
| 705 "Return a list of conses (file . state) for DIR." | 706 "Return a list of conses (file . state) for DIR." |
| 706 (vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S") | 707 (vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S") |
| 707 (vc-exec-after | 708 (vc-exec-after |
| 708 `(vc-bzr-after-dir-status (quote ,update-function)))) | 709 `(vc-bzr-after-dir-status (quote ,update-function) |
| 710 ;; "bzr status" results are relative to | |
| 711 ;; the bzr root directory, NOT to the | |
| 712 ;; directory "bzr status" was invoked in. | |
| 713 ;; Ugh. | |
| 714 ;; We pass the relative directory here so | |
| 715 ;; that `vc-bzr-after-dir-status' can | |
| 716 ;; frob the results accordingly. | |
| 717 (file-relative-name ,dir (vc-bzr-root ,dir))))) | |
| 709 | 718 |
| 710 (defun vc-bzr-dir-status-files (dir files default-state update-function) | 719 (defun vc-bzr-dir-status-files (dir files default-state update-function) |
| 711 "Return a list of conses (file . state) for DIR." | 720 "Return a list of conses (file . state) for DIR." |
| 712 (apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files) | 721 (apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files) |
| 713 (vc-exec-after | 722 (vc-exec-after |
| 714 `(vc-bzr-after-dir-status (quote ,update-function)))) | 723 `(vc-bzr-after-dir-status (quote ,update-function) |
| 724 (file-relative-name ,dir (vc-bzr-root ,dir))))) | |
| 715 | 725 |
| 716 (defvar vc-bzr-shelve-map | 726 (defvar vc-bzr-shelve-map |
| 717 (let ((map (make-sparse-keymap))) | 727 (let ((map (make-sparse-keymap))) |
| 718 ;; Turn off vc-dir marking | 728 ;; Turn off vc-dir marking |
| 719 (define-key map [mouse-2] 'ignore) | 729 (define-key map [mouse-2] 'ignore) |