* vc-arch.el (vc-arch-dir-status): New function.

(vc-arch-after-dir-status): New function.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 3ac0b618b6d0d161b57e2f235b01c74bce564640..417f689726b5af1057c3bcf690d6e2677a391687 100644 (file)
--- 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 cc8c8ae3c1ee464ff46f8179ae3de1964fe7ed50..c4f2c9dfc3582dcfc64be37341e0ce6336190ac5 100644 (file)
--- 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)))