diff options
| author | Magnus Henoch <mange@freemail.hu> | 2008-10-16 11:48:42 +0000 |
|---|---|---|
| committer | Magnus Henoch <mange@freemail.hu> | 2008-10-16 11:48:42 +0000 |
| commit | b4a7be3810c2b86eaf89aba6b75cfc819f4a36ef (patch) | |
| tree | 62a88cc85c83f4af1ff97a1dde82ccc92a085ef8 | |
| parent | 1b8c5120c89960577e12928eca9d205858a11190 (diff) | |
* vc-arch.el (vc-arch-dir-status): New function.
(vc-arch-after-dir-status): New function.
| -rw-r--r-- | lisp/ChangeLog | 5 | ||||
| -rw-r--r-- | lisp/vc-arch.el | 37 |
2 files changed, 42 insertions, 0 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3ac0b618b6..417f689726 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 cc8c8ae3c1..c4f2c9dfc3 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))) |