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.

2 files changed, 26 insertions, 8 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7407e60efb4..6661ee7d768 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
+2009-12-29  Dan Nicolaescu  <dann@ics.uci.edu>
+
+        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.
+
 2009-12-28  Tassilo Horn  <tassilo@member.fsf.org>
 
         * font-lock.el (font-lock-refresh-defaults): New function, which
diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el
index 99b910e9f94..fff4eca57fa 100644
--- a/lisp/vc-bzr.el
+++ b/lisp/vc-bzr.el
@@ -639,7 +639,7 @@ stream.  Standard error output is discarded."
                'face 'font-lock-comment-face)))))
 
 ;; FIXME: this needs testing, it's probably incomplete.
-(defun vc-bzr-after-dir-status (update-function)
+(defun vc-bzr-after-dir-status (update-function relative-dir)
   (let ((status-str nil)
         (translation '(("+N " . added)
                        ("-D " . removed)
@@ -687,16 +687,17 @@ stream.  Standard error output is discarded."
               (setf (nth 1 entry) 'conflict))))
          ((eq translated 'renamed)
           (re-search-forward "R   \\(.*\\) => \\(.*\\)$" (line-end-position) t)
-          (let ((new-name (match-string 2))
-                (old-name (match-string 1)))
+          (let ((new-name (file-relative-name (match-string 2) relative-dir))
+                (old-name (file-relative-name (match-string 1) relative-dir)))
             (push (list new-name 'edited
                       (vc-bzr-create-extra-fileinfo old-name)) result)))
          ;; do nothing for non existent files
          ((eq translated 'not-found))
          (t
-          (push (list (buffer-substring-no-properties
-                       (+ (point) 4)
-                       (line-end-position))
+          (push (list (file-relative-name
+                       (buffer-substring-no-properties
+                        (+ (point) 4)
+                        (line-end-position)) relative-dir)
                       translated) result)))
         (forward-line))
       (funcall update-function result)))
@@ -705,13 +706,22 @@ stream.  Standard error output is discarded."
   "Return a list of conses (file . state) for DIR."
   (vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S")
   (vc-exec-after
-   `(vc-bzr-after-dir-status (quote ,update-function))))
+   `(vc-bzr-after-dir-status (quote ,update-function)
+                             ;; "bzr status" results are relative to
+                             ;; the bzr root directory, NOT to the
+                             ;; directory "bzr status" was invoked in.
+                             ;; Ugh.
+                             ;; We pass the relative directory here so
+                             ;; that `vc-bzr-after-dir-status' can
+                             ;; frob the results accordingly.
+                             (file-relative-name ,dir (vc-bzr-root ,dir)))))
 
 (defun vc-bzr-dir-status-files (dir files default-state update-function)
   "Return a list of conses (file . state) for DIR."
   (apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files)
   (vc-exec-after
-   `(vc-bzr-after-dir-status (quote ,update-function))))
+   `(vc-bzr-after-dir-status (quote ,update-function)
+                             (file-relative-name ,dir (vc-bzr-root ,dir)))))
 
 (defvar vc-bzr-shelve-map
   (let ((map (make-sparse-keymap)))