From 798dafb411089b94c05a3f402ec7a9bac0e81735 Mon Sep 17 00:00:00 2001
From: Dan Nicolaescu <dann@ics.uci.edu>
Date: Sun, 23 Mar 2008 00:07:33 +0000
Subject: [PATCH] (vc-cvs-after-dir-status, vc-cvs-dir-status): New functions
 to implement vc-status support.

---
 lisp/ChangeLog |  5 ++++
 lisp/vc-cvs.el | 66 ++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 71 insertions(+)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0cb6857f250..d1460466f07 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2008-03-23  Dan Nicolaescu  <dann@ics.uci.edu>
+
+	* vc-cvs.el (vc-cvs-after-dir-status, vc-cvs-dir-status):
+	New functions to implement vc-status support.
+
 2008-03-22  Dan Nicolaescu  <dann@ics.uci.edu>
 
 	* vc.el (vc-status-prepare-status-buffer): New function.
diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el
index f75b3f4ebf5..98051b65430 100644
--- a/lisp/vc-cvs.el
+++ b/lisp/vc-cvs.el
@@ -864,6 +864,72 @@ state."
 	    (vc-cvs-parse-entry file t))))
       (forward-line 1))))
 
+;; XXX Experimental function for the vc-dired replacement.
+(defun vc-cvs-after-dir-status (update-function status-buffer)
+  ;; Heavily inspired by vc-cvs-parse-status. AKA a quick hack.
+  ;; It needs a lot of testing.
+  (let ((status nil)
+	(status-str nil)
+	(file nil)
+	(result nil)
+	(subdir default-directory))
+    (goto-char (point-min))
+    (while
+	;; Look for either a file entry, an unregistered file, or a
+	;; directory change.
+	(re-search-forward
+	 "\\(^=+\n\\([^=c?\n].*\n\\|\n\\)+\\)\\|\\(\\(^?? .*\n\\)+\\)\\|\\(^cvs status: Examining .*\n\\)"
+	 nil t)
+      ;; XXX: get rid of narrowing here.
+      (narrow-to-region (match-beginning 0) (match-end 0))
+      (goto-char (point-min))
+      ;; The subdir
+      (when (looking-at "cvs status: Examining \\(.+\\)")
+	(setq subdir (expand-file-name (match-string 1))))
+      ;; Unregistered files
+      (while (looking-at "? \\(.*\\)")
+	(setq file (file-relative-name 
+		    (expand-file-name (match-string 1) subdir)))
+	(push (cons file 'unregistered) result)
+	(forward-line 1))
+      ;; A file entry.
+      (when (re-search-forward "^File: " nil t)
+	(cond
+	 ((looking-at "no file") nil)
+	 ((re-search-forward "\\=\\([^ \t]+\\)" nil t)
+	  (setq file (file-relative-name 
+		      (expand-file-name (match-string 1) subdir)))
+	  (if (not (re-search-forward "\\=[ \t]+Status: \\(.*\\)" nil t))
+	      (push (cons file 'unregistered) result)
+	    (setq status-str (match-string 1))
+	    (setq status
+		  (cond
+		   ((string-match "Up-to-date" status-str) 'up-to-date)
+		   ((string-match "Locally Modified" status-str) 'edited)
+		   ((string-match "Needs Merge" status-str) 'needs-merge)
+		   ((string-match "Needs \\(Checkout\\|Patch\\)" status-str)
+		    'needs-patch)
+		   ((string-match "Locally Added" status-str) 'added)
+		   (t 'edited)))
+	    (unless (eq status 'up-to-date)
+	      (push (cons file status) result))))))
+      (goto-char (point-max))
+      (widen))
+      ;; Remove the temporary buffer.
+      (kill-buffer (current-buffer))
+      (funcall update-function result status-buffer)))
+
+;; XXX Experimental function for the vc-dired replacement.
+(defun vc-cvs-dir-status (dir update-function status-buffer)
+  "Create a list of conses (file . state) for DIR."
+  (with-current-buffer
+      (get-buffer-create (expand-file-name " *VC-cvs* tmp status" dir))
+    (erase-buffer)
+    (vc-cvs-command (current-buffer) 'async dir "status")
+    (vc-exec-after
+     `(vc-cvs-after-dir-status (quote ,update-function) ,status-buffer))
+    (current-buffer)))
+
 (defun vc-cvs-get-entries (dir)
   "Insert the CVS/Entries file from below DIR into the current buffer.
 This function ensures that the correct coding system is used for that,
-- 
2.39.2