*** empty log message ***
[bpt/emacs.git] / lisp / vc-cvs.el
index 452d9c1..d976213 100644 (file)
@@ -1,7 +1,7 @@
 ;;; vc-cvs.el --- non-resident support for CVS version-control
 
 ;; Copyright (C) 1995, 1998, 1999, 2000, 2001, 2002, 2003,
-;;   2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author:      FSF (see vc.el for full credits)
 ;; Maintainer:  Andre Spiegel <spiegel@gnu.org>
@@ -12,7 +12,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -179,8 +179,7 @@ See also variable `vc-cvs-sticky-date-format-string'."
           (goto-char (point-min))
          (cond
           ((re-search-forward
-            ;; CVS-removed files are not taken under VC control.
-            (concat "^/" (regexp-quote basename) "/[^/-]") nil t)
+            (concat "^/" (regexp-quote basename) "/[^/]") nil t)
            (beginning-of-line)
            (vc-cvs-parse-entry file)
            t)
@@ -207,12 +206,13 @@ See also variable `vc-cvs-sticky-date-format-string'."
   ;; Otherwise consider it `edited'.
   (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
         (lastmod (nth 5 (file-attributes file))))
-    (if (equal checkout-time lastmod)
-        'up-to-date
-      'edited)))
+    (cond
+     ((equal checkout-time lastmod) 'up-to-date)
+     ((string= (vc-working-revision file) "0") 'added)
+     (t 'edited))))
 
 (defun vc-cvs-dir-state (dir)
-  "Find the CVS state of all files in DIR."
+  "Find the CVS state of all files in DIR and subdirectories."
   ;; if DIR is not under CVS control, don't do anything.
   (when (file-readable-p (expand-file-name "CVS/Entries" dir))
     (if (vc-stay-local-p dir)
@@ -221,7 +221,8 @@ See also variable `vc-cvs-sticky-date-format-string'."
        ;; Don't specify DIR in this command, the default-directory is
        ;; enough.  Otherwise it might fail with remote repositories.
        (with-temp-buffer
-         (vc-cvs-command t 0 nil "status" "-l")
+         (buffer-disable-undo)         ;; Because these buffers can get huge
+         (vc-cvs-command t 0 nil "status")
          (goto-char (point-min))
          (while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t)
            (narrow-to-region (match-beginning 0) (match-end 0))
@@ -229,13 +230,13 @@ See also variable `vc-cvs-sticky-date-format-string'."
            (goto-char (point-max))
            (widen)))))))
 
-(defun vc-cvs-workfile-version (file)
-  "CVS-specific version of `vc-workfile-version'."
+(defun vc-cvs-working-revision (file)
+  "CVS-specific version of `vc-working-revision'."
   ;; There is no need to consult RCS headers under CVS, because we
   ;; get the workfile version for free when we recognize that a file
   ;; is registered in CVS.
   (vc-cvs-registered file)
-  (vc-file-getprop file 'vc-workfile-version))
+  (vc-file-getprop file 'vc-working-revision))
 
 (defun vc-cvs-checkout-model (file)
   "CVS-specific version of `vc-checkout-model'."
@@ -260,16 +261,11 @@ Handle the special case of a CVS file that is added but not yet
 committed and support display of sticky tags."
   (let* ((sticky-tag (vc-file-getprop file 'vc-cvs-sticky-tag))
         help-echo
-        (string 
-         (if (string= (vc-workfile-version file) "0")
-             ;; A file that is added but not yet committed.
-             (progn
-               (setq help-echo "Added file (needs commit) under CVS")
-               "CVS @@")
-           (let ((def-ml (vc-default-mode-line-string 'CVS file)))
-             (setq help-echo 
-                   (get-text-property 0 'help-echo def-ml))
-             def-ml))))
+        (string
+          (let ((def-ml (vc-default-mode-line-string 'CVS file)))
+            (setq help-echo 
+                  (get-text-property 0 'help-echo def-ml))
+            def-ml)))
     (propertize 
      (if (zerop (length sticky-tag))
         string
@@ -278,15 +274,6 @@ committed and support display of sticky tags."
        (concat string "[" sticky-tag "]"))
      'help-echo help-echo)))
 
-(defun vc-cvs-dired-state-info (file)
-  "CVS-specific version of `vc-dired-state-info'."
-  (let ((cvs-state (vc-state file)))
-    (cond ((eq cvs-state 'edited)
-          (if (equal (vc-workfile-version file) "0")
-              "(added)" "(modified)"))
-         ((eq cvs-state 'needs-patch) "(patch)")
-         ((eq cvs-state 'needs-merge) "(merge)"))))
-
 
 ;;;
 ;;; State-changing functions
@@ -298,15 +285,18 @@ COMMENT can be used to provide an initial description of FILES.
 
 `vc-register-switches' and `vc-cvs-register-switches' are passed to
 the CVS command (in that order)."
-  (when (and (not (vc-cvs-responsible-p file))
-              (vc-cvs-could-register file))
-      ;; Register the directory if needed.
-      (vc-cvs-register (directory-file-name (file-name-directory file))))
-    (apply 'vc-cvs-command nil 0 files
-          "add"
-          (and comment (string-match "[^\t\n ]" comment)
-               (concat "-m" comment))
-          (vc-switches 'CVS 'register)))
+  ;; Register the directories if needed.
+  (let (dirs)
+    (dolist (file files)
+      (and (not (vc-cvs-responsible-p file))
+           (vc-cvs-could-register file)
+           (push (directory-file-name (file-name-directory file)) dirs)))
+    (if dirs (vc-cvs-register dirs)))
+  (apply 'vc-cvs-command nil 0 files
+         "add"
+         (and comment (string-match "[^\t\n ]" comment)
+              (concat "-m" comment))
+         (vc-switches 'CVS 'register)))
 
 (defun vc-cvs-responsible-p (file)
   "Return non-nil if CVS thinks it is responsible for FILE."
@@ -330,7 +320,7 @@ its parents."
 
 (defun vc-cvs-checkin (files rev comment)
   "CVS-specific version of `vc-backend-checkin'."
-  (unless (or (not rev) (vc-cvs-valid-version-number-p rev))
+  (unless (or (not rev) (vc-cvs-valid-revision-number-p rev))
     (if (not (vc-cvs-valid-symbolic-tag-name-p rev))
        (error "%s is not a valid symbolic tag name" rev)
       ;; If the input revison is a valid symbolic tag name, we create it
@@ -351,7 +341,7 @@ its parents."
        ((re-search-forward "Up-to-date check failed" nil t)
        (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge))
              files)
-        (error (substitute-command-keys
+        (error "%s" (substitute-command-keys
                 (concat "Up-to-date check failed: "
                         "type \\[vc-next-action] to merge in changes"))))
        (t
@@ -359,12 +349,12 @@ its parents."
         (goto-char (point-min))
         (shrink-window-if-larger-than-buffer)
         (error "Check-in failed"))))
-    ;; Single-file commit?  Then update the version by parsing the buffer.
+    ;; Single-file commit?  Then update the revision by parsing the buffer.
     ;; Otherwise we can't necessarily tell what goes with what; clear
     ;; its properties so they have to be refetched.
     (if (= (length files) 1)
        (vc-file-setprop
-        (car files) 'vc-workfile-version
+        (car files) 'vc-working-revision
         (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
       (mapc (lambda (file) (vc-file-clearprops file)) files))
     ;; Anyway, forget the checkout model of the file, because we might have
@@ -379,7 +369,7 @@ its parents."
     (if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev)))
        (vc-cvs-command nil 0 files "update" "-A"))))
 
-(defun vc-cvs-find-version (file rev buffer)
+(defun vc-cvs-find-revision (file rev buffer)
   (apply 'vc-cvs-command
         buffer 0 file
         "-Q"                           ; suppress diagnostic output
@@ -404,8 +394,8 @@ REV is the revision to check out."
                  (vc-cvs-command nil 0 file "edit")
                (set-file-modes file (logior (file-modes file) 128))
                (if (equal file buffer-file-name) (toggle-read-only -1))))
-      ;; Check out a particular version (or recreate the file).
-      (vc-file-setprop file 'vc-workfile-version nil)
+      ;; Check out a particular revision (or recreate the file).
+      (vc-file-setprop file 'vc-working-revision nil)
       (apply 'vc-cvs-command nil 0 file
              (and editable "-w")
              "update"
@@ -426,7 +416,7 @@ REV is the revision to check out."
   (vc-cvs-command nil 0 file "commit" "-mRemoved."))
 
 (defun vc-cvs-revert (file &optional contents-done)
-  "Revert FILE to the version on which it was based."
+  "Revert FILE to the working revision on which it was based."
   (vc-default-revert 'CVS file contents-done)
   (unless (eq (vc-checkout-model file) 'implicit)
     (if vc-cvs-use-edit
@@ -434,35 +424,40 @@ REV is the revision to check out."
       ;; Make the file read-only by switching off all w-bits
       (set-file-modes file (logand (file-modes file) 3950)))))
 
-(defun vc-cvs-merge (file first-version &optional second-version)
+(defun vc-cvs-merge (file first-revision &optional second-revision)
   "Merge changes into current working copy of FILE.
-The changes are between FIRST-VERSION and SECOND-VERSION."
+The changes are between FIRST-REVISION and SECOND-REVISION."
   (vc-cvs-command nil 0 file
                  "update" "-kk"
-                 (concat "-j" first-version)
-                 (concat "-j" second-version))
+                 (concat "-j" first-revision)
+                 (concat "-j" second-revision))
   (vc-file-setprop file 'vc-state 'edited)
   (with-current-buffer (get-buffer "*vc*")
     (goto-char (point-min))
     (if (re-search-forward "conflicts during merge" nil t)
-        1                              ; signal error
-      0)))                             ; signal success
+       (progn 
+         (vc-file-setprop file 'vc-state 'conflict)
+         ;; signal error
+         1)
+      (vc-file-setprop file 'vc-state 'edited)
+      ;; signal success
+      0)))
 
 (defun vc-cvs-merge-news (file)
   "Merge in any new changes made to FILE."
   (message "Merging changes into %s..." file)
-  ;; (vc-file-setprop file 'vc-workfile-version nil)
+  ;; (vc-file-setprop file 'vc-working-revision nil)
   (vc-file-setprop file 'vc-checkout-time 0)
-  (vc-cvs-command nil 0 file "update")
+  (vc-cvs-command nil nil file "update")
   ;; Analyze the merge result reported by CVS, and set
   ;; file properties accordingly.
   (with-current-buffer (get-buffer "*vc*")
     (goto-char (point-min))
-    ;; get new workfile version
+    ;; get new working revision
     (if (re-search-forward
         "^Merging differences between [0-9.]* and \\([0-9.]*\\) into" nil t)
-       (vc-file-setprop file 'vc-workfile-version (match-string 1))
-      (vc-file-setprop file 'vc-workfile-version nil))
+       (vc-file-setprop file 'vc-working-revision (match-string 1))
+      (vc-file-setprop file 'vc-working-revision nil))
     ;; get file status
     (prog1
         (if (eq (buffer-size) 0)
@@ -487,23 +482,28 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
                 0);; indicate success to the caller
                ;; Conflicts detected!
                (t
-                (vc-file-setprop file 'vc-state 'edited)
+                (vc-file-setprop file 'vc-state 'conflict)
                 1);; signal the error to the caller
                )
             (pop-to-buffer "*vc*")
             (error "Couldn't analyze cvs update result")))
       (message "Merging changes into %s...done" file))))
 
+(defun vc-cvs-modify-change-comment (files rev comment)
+  "Modify the change comments for FILES on a specified REV. 
+Will fail unless you have administrative privileges on the repo."
+  (vc-cvs-command nil 0 files "admin" (concat "-m" rev ":" comment)))
 
 ;;;
 ;;; History functions
 ;;;
 
 (defun vc-cvs-print-log (files &optional buffer)
-  "Get change log associated with FILE."
+  "Get change logs associated with FILES."
+  ;; It's just the catenation of the individual logs.
   (vc-cvs-command
    buffer
-   (if (and (vc-stay-local-p files) (fboundp 'start-process)) 'async 0)
+   (if (vc-stay-local-p files) 'async 0)
    files "log"))
 
 (defun vc-cvs-wash-log ()
@@ -512,41 +512,46 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
   nil)
 
 (defun vc-cvs-diff (files &optional oldvers newvers buffer)
-  "Get a difference report using CVS between two versions of FILE."
-    (let* ((async (and (not vc-disable-async-diff) 
-                      (vc-stay-local-p files)
-                      (fboundp 'start-process)))
-          (status (apply 'vc-cvs-command (or buffer "*vc-diff*")
+  "Get a difference report using CVS between two revisions of FILE."
+  (let* ((async (and (not vc-disable-async-diff)
+                    (vc-stay-local-p files)))
+        (invoke-cvs-diff-list nil)
+        status)
+    ;; Look through the file list and see if any files have backups
+    ;; that can be used to do a plain "diff" instead of "cvs diff".
+    (dolist (file files)
+      (let ((ov oldvers)
+           (nv newvers))
+       (when (or (not ov) (string-equal ov ""))
+         (setq ov (vc-working-revision file)))
+       (when (string-equal nv "")
+         (setq nv nil))
+       (let ((file-oldvers (vc-version-backup-file file ov))
+             (file-newvers (if (not nv)
+                               file
+                             (vc-version-backup-file file nv)))
+             (coding-system-for-read (vc-coding-system-for-diff file)))
+         (if (and file-oldvers file-newvers)
+             (progn
+               (apply 'vc-do-command (or buffer "*vc-diff*") 1 "diff" nil
+                      (append (if (listp diff-switches)
+                                  diff-switches
+                                (list diff-switches))
+                              (if (listp vc-diff-switches)
+                                  vc-diff-switches
+                                (list vc-diff-switches))
+                              (list (file-relative-name file-oldvers)
+                                    (file-relative-name file-newvers))))
+               (setq status 0))
+           (push file invoke-cvs-diff-list)))))
+    (when invoke-cvs-diff-list
+      (setq status (apply 'vc-cvs-command (or buffer "*vc-diff*")
                          (if async 'async 1)
-                         files "diff"
+                         invoke-cvs-diff-list "diff"
                          (and oldvers (concat "-r" oldvers))
                          (and newvers (concat "-r" newvers))
                          (vc-switches 'CVS 'diff))))
-      (if async 1 status)))            ; async diff, pessimistic assumption
-
-(defun vc-cvs-diff-tree (dir &optional rev1 rev2)
-  "Diff all files at and below DIR."
-  (with-current-buffer "*vc-diff*"
-    (setq default-directory dir)
-    (if (vc-stay-local-p dir)
-        ;; local diff: do it filewise, and only for files that are modified
-        (vc-file-tree-walk
-         dir
-         (lambda (f)
-           (vc-exec-after
-            `(let ((coding-system-for-read (vc-coding-system-for-diff ',f)))
-               ;; possible optimization: fetch the state of all files
-               ;; in the tree via vc-cvs-dir-state-heuristic
-               (unless (vc-up-to-date-p ',f)
-                 (message "Looking at %s" ',f)
-                 (vc-diff-internal ',f ',rev1 ',rev2))))))
-      ;; cvs diff: use a single call for the entire tree
-      (let ((coding-system-for-read
-             (or coding-system-for-read 'undecided)))
-        (apply 'vc-cvs-command "*vc-diff*" 1 nil "diff"
-               (and rev1 (concat "-r" rev1))
-               (and rev2 (concat "-r" rev2))
-               (vc-switches 'CVS 'diff))))))
+    (if async 1 status))) ; async diff, pessimistic assumption
 
 (defconst vc-cvs-annotate-first-line-re "^[0-9]")
 
@@ -559,14 +564,14 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
       (set-process-filter process vc-filter)
       (funcall vc-filter process (substring string (match-beginning 0))))))
 
-(defun vc-cvs-annotate-command (file buffer &optional version)
+(defun vc-cvs-annotate-command (file buffer &optional revision)
   "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER.
-Optional arg VERSION is a version to annotate from."
+Optional arg REVISION is a revision to annotate from."
   (vc-cvs-command buffer
-                  (if (and (vc-stay-local-p file) (fboundp 'start-process))
+                  (if (vc-stay-local-p file)
                      'async 0)
                   file "annotate"
-                  (if version (concat "-r" version)))
+                  (if revision (concat "-r" revision)))
   ;; Strip the leading few lines.
   (let ((proc (get-buffer-process buffer)))
     (if proc
@@ -590,7 +595,8 @@ encoded as fractional days."
 systime, or nil if there is none."
   (let* ((bol (point))
          (cache (get-text-property bol 'vc-cvs-annotate-time))
-         buffer-read-only)
+         (inhibit-read-only t)
+         (inhibit-modification-hooks t))
     (cond
      (cache)
      ((looking-at
@@ -612,11 +618,14 @@ systime, or nil if there is none."
          bol (1+ bol) 'vc-cvs-annotate-time
          (setq cache (cons
                       ;; Position at end makes for nicer overlay result.
-                      (match-end 0)
+                      ;; Don't put actual buffer pos here, but only relative
+                      ;; distance, so we don't ever move backward in the
+                      ;; goto-char below, even if the text is moved.
+                      (- (match-end 0) (match-beginning 0))
                       (vc-annotate-convert-time
                        (encode-time 0 0 0 day month year))))))))
     (when cache
-      (goto-char (car cache))           ; fontify from here to eol
+      (goto-char (+ bol (car cache)))   ; Fontify from here to eol.
       (cdr cache))))                    ; days (float)
 
 (defun vc-cvs-annotate-extract-revision-at-line ()
@@ -632,7 +641,7 @@ systime, or nil if there is none."
 ;;;
 
 (defun vc-cvs-create-snapshot (dir name branchp)
-  "Assign to DIR's current version a given NAME.
+  "Assign to DIR's current revision a given NAME.
 If BRANCHP is non-nil, the name is created as a branch (and the current
 workspace is immediately moved to that new branch)."
   (vc-cvs-command nil 0 dir "tag" "-c" (if branchp "-b") name)
@@ -662,13 +671,13 @@ If UPDATE is non-nil, then update (resynch) any affected buffers."
                   ((or (string= state "U")
                        (string= state "P"))
                    (vc-file-setprop file 'vc-state 'up-to-date)
-                   (vc-file-setprop file 'vc-workfile-version nil)
+                   (vc-file-setprop file 'vc-working-revision nil)
                    (vc-file-setprop file 'vc-checkout-time
                                     (nth 5 (file-attributes file))))
                   ((or (string= state "M")
                        (string= state "C"))
                    (vc-file-setprop file 'vc-state 'edited)
-                   (vc-file-setprop file 'vc-workfile-version nil)
+                   (vc-file-setprop file 'vc-working-revision nil)
                    (vc-file-setprop file 'vc-checkout-time 0)))
                  (vc-file-setprop file 'vc-cvs-sticky-tag sticky-tag)
                  (vc-resynch-buffer file t t))))
@@ -694,6 +703,9 @@ If UPDATE is non-nil, then update (resynch) any affected buffers."
 ;;; Internal functions
 ;;;
 
+(defun vc-cvs-root (dir)
+  (vc-find-root dir "CVS" t))
+
 (defun vc-cvs-command (buffer okstatus files &rest flags)
   "A wrapper around `vc-do-command' for use in vc-cvs.el.
 The difference to vc-do-command is that this function always invokes `cvs',
@@ -779,38 +791,54 @@ For an empty string, nil is returned (invalid CVS root)."
           ;; Normalize CVS root record
           (list method user host root)))))
 
+;; XXX: This does not work correctly for subdirectories.  "cvs status"
+;; information is context sensitive, it contains lines like:
+;; cvs status: Examining DIRNAME
+;; and the file entries after that don't show the full path.
+;; Because of this vc-dired only shows changed files at the top level
+;; for CVS.
 (defun vc-cvs-parse-status (&optional full)
   "Parse output of \"cvs status\" command in the current buffer.
 Set file properties accordingly.  Unless FULL is t, parse only
-essential information."
-  (let (file status)
+essential information. Note that this can never set the 'ignored
+state."
+  (let (file status missing)
     (goto-char (point-min))
-    (if (re-search-forward "^File: " nil t)
-        (cond
-         ((looking-at "no file") nil)
-         ((re-search-forward "\\=\\([^ \t]+\\)" nil t)
-         (setq file (expand-file-name (match-string 1)))
-          (vc-file-setprop file 'vc-backend 'CVS)
-          (if (not (re-search-forward "\\=[ \t]+Status: \\(.*\\)" nil t))
-              (setq status "Unknown")
-            (setq status (match-string 1)))
-          (if (and full
-                   (re-search-forward
-                    "\\(RCS Version\\|RCS Revision\\|Repository revision\\):\
+    (while (looking-at "? \\(.*\\)")
+      (setq file (expand-file-name (match-string 1)))
+      (vc-file-setprop file 'vc-state 'unregistered)
+      (forward-line 1))
+    (when (re-search-forward "^File: " nil t)
+      (when (setq missing (looking-at "no file "))
+       (goto-char (match-end 0)))
+      (cond
+       ((re-search-forward "\\=\\([^ \t]+\\)" nil t)
+       (setq file (expand-file-name (match-string 1)))
+       (vc-file-setprop file 'vc-backend 'CVS)
+       (if (not (re-search-forward "\\=[ \t]+Status: \\(.*\\)" nil t))
+           (setq status "Unknown")
+         (setq status (match-string 1)))
+       (when (and full
+                  (re-search-forward
+                   "\\(RCS Version\\|RCS Revision\\|Repository revision\\):\
 \[\t ]+\\([0-9.]+\\)"
-                    nil t))
-              (vc-file-setprop file 'vc-latest-version (match-string 2)))
-          (vc-file-setprop
-           file 'vc-state
-           (cond
-            ((string-match "Up-to-date" status)
-             (vc-file-setprop file 'vc-checkout-time
-                              (nth 5 (file-attributes file)))
-             'up-to-date)
-            ((string-match "Locally Modified" status)             'edited)
-            ((string-match "Needs Merge" status)                  'needs-merge)
-            ((string-match "Needs \\(Checkout\\|Patch\\)" status) 'needs-patch)
-            (t 'edited))))))))
+                   nil t))
+           (vc-file-setprop file 'vc-latest-revision (match-string 2)))
+       (vc-file-setprop
+        file 'vc-state
+        (cond
+         ((string-match "Up-to-date" status)
+          (vc-file-setprop file 'vc-checkout-time
+                           (nth 5 (file-attributes file)))
+          'up-to-date)
+         ((string-match "Locally Modified" status)             'edited)
+         ((string-match "Needs Merge" status)                  'needs-merge)
+         ((string-match "Needs \\(Checkout\\|Patch\\)" status)
+          (if missing 'missing 'needs-patch))
+         ((string-match "Locally Added" status)                'added)
+         ((string-match "Locally Removed" status)              'removed)
+         ((string-match "File had conflicts " status)          'conflict)
+         (t 'edited))))))))
 
 (defun vc-cvs-dir-state-heuristic (dir)
   "Find the CVS state of all files in DIR, using only local information."
@@ -825,6 +853,104 @@ essential information."
            (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)
+  ;; 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)
+       (missing 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 (list file 'unregistered) result)
+       (forward-line 1))
+      ;; A file entry.
+      (when (re-search-forward "^File: " nil t)
+       (when (setq missing (looking-at "no file "))
+         (goto-char (match-end 0)))
+       (cond
+        ((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 (list 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)
+                   (if missing 'missing 'needs-patch))
+                  ((string-match "Locally Added" status-str) 'added)
+                  ((string-match "Locally Removed" status-str) 'removed)
+                  ((string-match "File had conflicts " status-str) 'conflict)
+                  (t 'edited)))
+           (unless (eq status 'up-to-date)
+             (push (list file status) result))))))
+      (goto-char (point-max))
+      (widen))
+      (funcall update-function result))
+  ;; Alternative implementation: use the "update" command instead of
+  ;; the "status" command.
+  ;; (let ((result nil)
+  ;;   (translation '((?? . unregistered)
+  ;;                  (?A . added)
+  ;;                  (?C . conflict)
+  ;;                  (?M . edited)
+  ;;                  (?P . needs-merge)
+  ;;                  (?R . removed)
+  ;;                  (?U . needs-patch))))
+  ;;   (goto-char (point-min))
+  ;;   (while (not (eobp))
+  ;;     (if (looking-at "^[ACMPRU?] \\(.*\\)$")
+  ;;     (push (list (match-string 1) 
+  ;;                 (cdr (assoc (char-after) translation))) 
+  ;;           result)
+  ;;   (cond
+  ;;    ((looking-at "cvs update: warning: \\(.*\\) was lost")
+  ;;     ;; Format is:
+  ;;     ;; cvs update: warning: FILENAME was lost
+  ;;     ;; U FILENAME
+  ;;     (push (list (match-string 1) 'missing) result)
+  ;;     ;; Skip the "U" line
+  ;;     (forward-line 1))
+  ;;    ((looking-at "cvs update: New directory `\\(.*\\)' -- ignored")
+  ;;     (push (list (match-string 1) 'unregistered) result))))
+  ;;     (forward-line 1))
+  ;;   (funcall update-function result)))
+  )
+
+;; XXX Experimental function for the vc-dired replacement.
+(defun vc-cvs-dir-status (dir update-function)
+  "Create a list of conses (file . state) for DIR."
+  (vc-cvs-command (current-buffer) 'async dir "status")
+  ;; Alternative implementation: use the "update" command instead of
+  ;; the "status" command.
+  ;; (vc-cvs-command (current-buffer) 'async
+  ;;             (file-relative-name dir)
+  ;;             "-f" "-n" "update" "-d" "-P")
+  (vc-exec-after
+   `(vc-cvs-after-dir-status (quote ,update-function))))
+
 (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,
@@ -842,8 +968,8 @@ CVS/Entries should only be accessed through this function."
   (and (string-match "^[a-zA-Z]" tag)
        (not (string-match "[^a-z0-9A-Z-_]" tag))))
 
-(defun vc-cvs-valid-version-number-p (tag)
-  "Return non-nil if TAG is a valid version number."
+(defun vc-cvs-valid-revision-number-p (tag)
+  "Return non-nil if TAG is a valid revision number."
   (and (string-match "^[0-9]" tag)
        (not (string-match "[^0-9.]" tag))))
 
@@ -906,9 +1032,10 @@ is non-nil."
   (cond
    ;; entry for a "locally added" file (not yet committed)
    ((looking-at "/[^/]+/0/")
+    (vc-file-setprop file 'vc-backend 'CVS)
     (vc-file-setprop file 'vc-checkout-time 0)
-    (vc-file-setprop file 'vc-workfile-version "0")
-    (if set-state (vc-file-setprop file 'vc-state 'edited)))
+    (vc-file-setprop file 'vc-working-revision "0")
+    (if set-state (vc-file-setprop file 'vc-state 'added)))
    ;; normal entry
    ((looking-at
      (concat "/[^/]+"
@@ -921,7 +1048,8 @@ is non-nil."
             ;; sticky tag
             "\\(.\\|\\)" ;Sticky tag type (date or tag name, could be empty)
             "\\(.*\\)"))               ;Sticky tag
-    (vc-file-setprop file 'vc-workfile-version (match-string 1))
+    (vc-file-setprop file 'vc-backend 'CVS)
+    (vc-file-setprop file 'vc-working-revision (match-string 1))
     (vc-file-setprop file 'vc-cvs-sticky-tag
                     (vc-cvs-parse-sticky-tag (match-string 4)
                                               (match-string 5)))
@@ -961,11 +1089,11 @@ is non-nil."
         (push (match-string 1) res))
       res)))
 
-(defun vc-cvs-revision-completion-table (file)
-  (lexical-let ((file file)
+(defun vc-cvs-revision-completion-table (files)
+  (lexical-let ((files files)
                 table)
     (setq table (lazy-completion-table
-                 table (lambda () (vc-cvs-revision-table file))))
+                 table (lambda () (vc-cvs-revision-table (car files)))))
     table))