]> code.delx.au - gnu-emacs/blobdiff - lisp/vc-cvs.el
Merge from gnus--devo--0
[gnu-emacs] / lisp / vc-cvs.el
index f5c86d4ead87476ac7a660419e47f6354b85d7a3..edaf7f08d7c252cc46dffb35a3125e2b2f474798 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>
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -21,9 +21,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 ;; new functions when we reload this file.
 (put 'CVS 'vc-functions nil)
 
+;;; Properties of the backend.
+
+(defun vc-cvs-revision-granularity () 'file)
+
+(defun vc-cvs-checkout-model (files)
+  "CVS-specific version of `vc-checkout-model'."
+  (if (getenv "CVSREAD")
+      'announce
+    (let* ((file (if (consp files) (car files) files))
+           (attrib (file-attributes file)))
+      (or (vc-file-getprop file 'vc-checkout-model)
+          (vc-file-setprop
+           file 'vc-checkout-model
+           (if (and attrib ;; don't check further if FILE doesn't exist
+                    ;; If the file is not writable (despite CVSREAD being
+                    ;; undefined), this is probably because the file is being
+                    ;; "watched" by other developers.
+                    ;; (If vc-mistrust-permissions was t, we actually shouldn't
+                    ;; trust this, but there is no other way to learn this from
+                    ;; CVS at the moment (version 1.9).)
+                    (string-match "r-..-..-." (nth 8 attrib)))
+               'announce
+             'implicit))))))
+
 ;;;
 ;;; Customization options
 ;;;
@@ -174,17 +196,16 @@ See also variable `vc-cvs-sticky-date-format-string'."
         ;; make sure that the file name is searched case-sensitively
         (case-fold-search nil))
     (if (file-readable-p (expand-file-name "CVS/Entries" dirname))
-       (with-temp-buffer
-          (vc-cvs-get-entries dirname)
-          (goto-char (point-min))
-         (cond
-          ((re-search-forward
-            ;; CVS-removed files are not taken under VC control.
-            (concat "^/" (regexp-quote basename) "/[^/-]") nil t)
-           (beginning-of-line)
-           (vc-cvs-parse-entry file)
-           t)
-          (t nil)))
+        (or (string= basename "")
+            (with-temp-buffer
+              (vc-cvs-get-entries dirname)
+              (goto-char (point-min))
+              (cond ((re-search-forward
+                      (concat "^/" (regexp-quote basename) "/[^/]") nil t)
+                     (beginning-of-line)
+                     (vc-cvs-parse-entry file)
+                     t)
+                    (t nil))))
       nil)))
 
 (defun vc-cvs-state (file)
@@ -207,28 +228,11 @@ 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)))
-
-(defun vc-cvs-dir-state (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)
-       (vc-cvs-dir-state-heuristic dir)
-      (let ((default-directory dir))
-       ;; Don't specify DIR in this command, the default-directory is
-       ;; enough.  Otherwise it might fail with remote repositories.
-       (with-temp-buffer
-         (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))
-           (vc-cvs-parse-status)
-           (goto-char (point-max))
-           (widen)))))))
+    (cond
+     ((equal checkout-time lastmod) 'up-to-date)
+     ((string= (vc-working-revision file) "0") 'added)
+     ((null checkout-time) 'unregistered)
+     (t 'edited))))
 
 (defun vc-cvs-working-revision (file)
   "CVS-specific version of `vc-working-revision'."
@@ -238,22 +242,6 @@ See also variable `vc-cvs-sticky-date-format-string'."
   (vc-cvs-registered file)
   (vc-file-getprop file 'vc-working-revision))
 
-(defun vc-cvs-checkout-model (file)
-  "CVS-specific version of `vc-checkout-model'."
-  (if (getenv "CVSREAD")
-      'announce
-    (let ((attrib (file-attributes file)))
-      (if (and attrib ;; don't check further if FILE doesn't exist
-               ;; If the file is not writable (despite CVSREAD being
-               ;; undefined), this is probably because the file is being
-               ;; "watched" by other developers.
-               ;; (If vc-mistrust-permissions was t, we actually shouldn't
-               ;; trust this, but there is no other way to learn this from CVS
-               ;; at the moment (version 1.9).)
-               (string-match "r-..-..-." (nth 8 attrib)))
-          'announce
-        'implicit))))
-
 (defun vc-cvs-mode-line-string (file)
   "Return string for placement into the modeline for FILE.
 Compared to the default implementation, this function does two things:
@@ -261,33 +249,19 @@ 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-working-revision 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))))
-    (propertize 
+        (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
-       (setq help-echo (format "%s on the '%s' branch" 
+       (setq help-echo (format "%s on the '%s' branch"
                               help-echo sticky-tag))
        (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-working-revision file) "0")
-              "(added)" "(modified)"))
-         ((eq cvs-state 'needs-patch) "(patch)")
-         ((eq cvs-state 'needs-merge) "(merge)"))))
-
 
 ;;;
 ;;; State-changing functions
@@ -299,15 +273,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."
@@ -367,7 +344,7 @@ its parents."
        (vc-file-setprop
         (car files) 'vc-working-revision
         (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
-      (mapc (lambda (file) (vc-file-clearprops file)) files))
+      (mapc 'vc-file-clearprops files))
     ;; Anyway, forget the checkout model of the file, because we might have
     ;; guessed wrong when we found the file.  After commit, we can
     ;; tell it from the permissions of the file (see
@@ -400,7 +377,7 @@ REV is the revision to check out."
     (if (and (file-exists-p file) (not rev))
         ;; If no revision was specified, just make the file writable
         ;; if necessary (using `cvs-edit' if requested).
-        (and editable (not (eq (vc-cvs-checkout-model file) 'implicit))
+        (and editable (not (eq (vc-cvs-checkout-model (list file)) 'implicit))
              (if vc-cvs-use-edit
                  (vc-cvs-command nil 0 file "edit")
                (set-file-modes file (logior (file-modes file) 128))
@@ -423,13 +400,12 @@ REV is the revision to check out."
   (message "Checking out %s...done" file))
 
 (defun vc-cvs-delete-file (file)
-  (vc-cvs-command nil 0 file "remove" "-f")
-  (vc-cvs-command nil 0 file "commit" "-mRemoved."))
+  (vc-cvs-command nil 0 file "remove" "-f"))
 
 (defun vc-cvs-revert (file &optional contents-done)
   "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)
+  (unless (eq (vc-cvs-checkout-model (list file)) 'implicit)
     (if vc-cvs-use-edit
         (vc-cvs-command nil 0 file "unedit")
       ;; Make the file read-only by switching off all w-bits
@@ -446,15 +422,20 @@ The changes are between FIRST-REVISION and SECOND-REVISION."
   (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-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*")
@@ -488,7 +469,7 @@ The changes are between FIRST-REVISION and SECOND-REVISION."
                 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*")
@@ -496,9 +477,9 @@ The changes are between FIRST-REVISION and SECOND-REVISION."
       (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. 
+  "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 "rcs" (concat "-m" comment ":" rev)))
+  (vc-cvs-command nil 0 files "admin" (concat "-m" rev ":" comment)))
 
 ;;;
 ;;; History functions
@@ -512,10 +493,9 @@ Will fail unless you have administrative privileges on the repo."
    (if (vc-stay-local-p files) 'async 0)
    files "log"))
 
-(defun vc-cvs-wash-log ()
-  "Remove all non-comment information from log output."
-  (vc-call-backend 'RCS 'wash-log)
-  nil)
+(defun vc-cvs-comment-history (file)
+  "Get comment history of a file."
+  (vc-call-backend 'RCS 'comment-history file))
 
 (defun vc-cvs-diff (files &optional oldvers newvers buffer)
   "Get a difference report using CVS between two revisions of FILE."
@@ -559,31 +539,6 @@ Will fail unless you have administrative privileges on the repo."
                          (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))))))
-
 (defconst vc-cvs-annotate-first-line-re "^[0-9]")
 
 (defun vc-cvs-annotate-process-filter (process string)
@@ -649,11 +604,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 ()
@@ -665,19 +623,19 @@ systime, or nil if there is none."
       nil)))
 
 ;;;
-;;; Snapshot system
+;;; Tag system
 ;;;
 
-(defun vc-cvs-create-snapshot (dir name branchp)
+(defun vc-cvs-create-tag (dir name branchp)
   "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)
   (when branchp (vc-cvs-command nil 0 dir "update" "-r" name)))
 
-(defun vc-cvs-retrieve-snapshot (dir name update)
-  "Retrieve a snapshot at and below DIR.
-NAME is the name of the snapshot; if it is empty, do a `cvs update'.
+(defun vc-cvs-retrieve-tag (dir name update)
+  "Retrieve a tag at and below DIR.
+NAME is the name of the tag; if it is empty, do a `cvs update'.
 If UPDATE is non-nil, then update (resynch) any affected buffers."
   (with-current-buffer (get-buffer-create "*vc*")
     (let ((default-directory dir)
@@ -731,11 +689,14 @@ 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',
 and that it passes `vc-cvs-global-switches' to it before FLAGS."
-  (apply 'vc-do-command buffer okstatus "cvs" files
+  (apply 'vc-do-command (or buffer "*vc*") okstatus "cvs" files
          (if (stringp vc-cvs-global-switches)
              (cons vc-cvs-global-switches flags)
            (append vc-cvs-global-switches
@@ -816,51 +777,189 @@ 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 directory listings only show 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)
+       (setq status(if (re-search-forward "\\=[ \t]+Status: \\(.*\\)" nil t)
+                        (match-string 1) "Unknown"))
+       (when (and full
+                  (re-search-forward
+                   "\\(RCS Version\\|RCS Revision\\|Repository revision\\):\
 \[\t ]+\\([0-9.]+\\)"
-                    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) 'needs-patch)
-            (t 'edited))))))))
-
-(defun vc-cvs-dir-state-heuristic (dir)
-  "Find the CVS state of all files in DIR, using only local information."
-  (with-temp-buffer
-    (vc-cvs-get-entries dir)
+                   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-update))
+         ((string-match "Locally Added" status)                'added)
+         ((string-match "Locally Removed" status)              'removed)
+         ((string-match "File had conflicts " status)          'conflict)
+          ((string-match "Unknown" status)                     'unregistered)
+         (t 'edited))))))))
+
+(defun vc-cvs-after-dir-status (update-function)
+  ;; Heavily inspired by vc-cvs-parse-status. AKA a quick hack.
+  ;; This 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 (not (eobp))
-      ;; CVS-removed files are not taken under VC control.
-      (when (looking-at "/\\([^/]*\\)/[^/-]")
-       (let ((file (expand-file-name (match-string 1) dir)))
-         (unless (vc-file-getprop file 'vc-state)
-           (vc-cvs-parse-entry file t))))
-      (forward-line 1))))
+    (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)
+      ;; FIXME: 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: \\(no file \\)?\\(.*[^ \t]\\)[ \t]+Status: \\(.*\\)" nil t)
+       (setq missing (match-string 1))
+       (setq file (file-relative-name
+                   (expand-file-name (match-string 2) subdir)))
+       (setq status-str (match-string 3))
+       (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-update))
+              ((string-match "Locally Added" status-str) 'added)
+              ((string-match "Locally Removed" status-str) 'removed)
+              ((string-match "File had conflicts " status-str) 'conflict)
+              ((string-match "Unknown" status-str) 'unregistered)
+              (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-update))))
+  ;;   (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)))
+  )
+
+(defun vc-cvs-dir-status (dir update-function)
+  "Create a list of conses (file . state) for DIR."
+  (vc-cvs-command (current-buffer) 'async dir "-f" "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-file-to-string (file)
+  "Read the content of FILE and return it as a string."
+  (condition-case nil
+      (with-temp-buffer
+       (insert-file-contents file)
+       (goto-char (point-min))
+       (buffer-substring (point) (point-max)))
+    (file-error nil)))
+
+(defun vc-cvs-status-extra-headers (dir)
+  "Extract and represent per-directory properties of a CVS working copy."
+  (let ((repo
+        (condition-case nil
+            (with-temp-buffer
+              (insert-file-contents "CVS/Root")
+              (goto-char (point-min))
+              (and (looking-at ":ext:") (delete-char 5))
+              (buffer-substring (point) (1- (point-max))))
+          (file-error nil)))
+       (module
+        (condition-case nil
+            (with-temp-buffer
+              (insert-file-contents "CVS/Repository")
+              (goto-char (point-min))
+              (re-search-forward "[^/\n]*" nil t)
+              (concat (match-string 0) "\n"))
+          (file-error nil))))
+    (concat
+     (cond (module
+           (concat (propertize "Module     : " 'face 'font-lock-type-face)
+                    (propertize module 'face 'font-lock-variable-name-face)))
+          (t ""))
+     (cond (repo
+           (concat (propertize "Repository : " 'face 'font-lock-type-face)
+                    (propertize repo 'face 'font-lock-variable-name-face)))
+          (t ""))
+     ;; In CVS, branch is a per-file property, not a per-directory property.
+     ;; We can't really do this here without making dangerous assumptions.
+     ;;(propertize "Branch:     " 'face 'font-lock-type-face)
+     ;;(propertize "ADD CODE TO PRINT THE BRANCH NAME\n"
+     ;;         'face 'font-lock-warning-face)
+     )))
 
 (defun vc-cvs-get-entries (dir)
   "Insert the CVS/Entries file from below DIR into the current buffer.
@@ -943,9 +1042,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-working-revision "0")
-    (if set-state (vc-file-setprop file 'vc-state 'edited)))
+    (if set-state (vc-file-setprop file 'vc-state 'added)))
    ;; normal entry
    ((looking-at
      (concat "/[^/]+"
@@ -958,6 +1058,7 @@ is non-nil."
             ;; sticky tag
             "\\(.\\|\\)" ;Sticky tag type (date or tag name, could be empty)
             "\\(.*\\)"))               ;Sticky tag
+    (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)
@@ -1004,7 +1105,7 @@ is non-nil."
     (setq table (lazy-completion-table
                  table (lambda () (vc-cvs-revision-table (car files)))))
     table))
-                                           
+
 
 (provide 'vc-cvs)