2 files changed, 42 insertions, 0 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 3ac0b618b6d..417f689726b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2008-10-16  Magnus Henoch  <mange@freemail.hu>
+
+        * vc-arch.el (vc-arch-dir-status): New function.
+        (vc-arch-after-dir-status): New function.
+
 2008-10-16  Glenn Morris  <rgm@gnu.org>
 
         * man.el (Man-getpage-in-background): Force recent `man's to output
diff --git a/lisp/vc-arch.el b/lisp/vc-arch.el
index cc8c8ae3c1e..c4f2c9dfc35 100644
--- a/lisp/vc-arch.el
+++ b/lisp/vc-arch.el
@@ -288,6 +288,43 @@ Return non-nil if FILE is unchanged."
                     'up-to-date
                   'edited)))))))))
 
+(defun vc-arch-dir-status (dir callback)
+  "Run 'tla inventory' for DIR and pass results to CALLBACK.
+CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
+`vc-dir-refresh'."
+  (let ((default-directory dir))
+    (vc-arch-command t 'async nil "changes"))
+  ;; The updating could be done asynchronously.
+  (vc-exec-after
+   `(vc-arch-after-dir-status ',callback)))
+
+(defun vc-arch-after-dir-status (callback)
+  (let* ((state-map '(("M " . edited)
+                      ("Mb" . edited)   ;binary
+                      ("D " . removed)
+                      ("D/" . removed)  ;directory
+                      ("A " . added)
+                      ("A/" . added)    ;directory
+                      ("=>" . renamed)
+                      ("/>" . renamed)  ;directory
+                      ("lf" . symlink-to-file)
+                      ("fl" . file-to-symlink)
+                      ("--" . permissions-changed)
+                      ("-/" . permissions-changed) ;directory
+                      ))
+         (state-map-regexp (regexp-opt (mapcar 'car state-map) t))
+         (entry-regexp (concat "^" state-map-regexp " \\(.*\\)$"))
+         result)
+    (goto-char (point-min))
+    ;;(message "Got %s" (buffer-string))
+    (while (re-search-forward entry-regexp nil t)
+      (let* ((state-string (match-string 1))
+             (state (cdr (assoc state-string state-map)))
+             (filename (match-string 2)))
+        (push (list filename state) result)))
+
+    (funcall callback result nil)))
+
 (defun vc-arch-working-revision (file)
   (let* ((root (expand-file-name "{arch}" (vc-arch-root file)))
          (defbranch (vc-arch-default-version file)))