Fix display of vc-dir CVS file statuses in subdirectories

* lisp/vc/vc-cvs.el (vc-cvs-dir-status-files): Use 'cvs update'
instead of 'cvs status'.  It's faster, easier to parse, and
relieves us of the need to use vc-expand-dirs.  (Bug#24082)
(vc-cvs-after-dir-status): Parse its output.

1 files changed, 31 insertions, 106 deletions

diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index a2499a2294b..3cfe8ee56a2 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -938,103 +938,32 @@ state."
           (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)
-        (ignore-next nil)
-        (subdir default-directory))
+  (let ((result nil)
+        (translation '((?? . unregistered)
+                       (?A . added)
+                       (?C . conflict)
+                       (?M . edited)
+                       (?P . needs-merge)
+                       (?R . removed)
+                       (?U . needs-update))))
     (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\\|nothing\\) .*\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))
-      (when (looking-at "cvs status: nothing known about")
-        ;; We asked about a non existent file.  The output looks like this:
-
-        ;; cvs status: nothing known about `lisp/v.diff'
-        ;; ===================================================================
-        ;; File: no file v.diff            Status: Unknown
-        ;;
-        ;;    Working revision:    No entry for v.diff
-        ;;    Repository revision: No revision control file
-        ;;
-
-        ;; Due to narrowing in this iteration we only see the "cvs
-        ;; status:" line, so just set a flag so that we can ignore the
-        ;; file in the next iteration.
-        (setq ignore-next t))
-      ;; 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)))
-        (if ignore-next
-            (setq ignore-next nil)
-          (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)))
-  )
+    (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)))
 
 ;; Based on vc-cvs-dir-state-heuristic from Emacs 22.
 ;; FIXME does not mention unregistered files.
@@ -1071,16 +1000,12 @@ state."
 Query all files in DIR if files is nil."
   (let ((local (vc-cvs-stay-local-p dir)))
     (if (and (not files) local (not (eq local 'only-file)))
-        (vc-cvs-dir-status-heuristic dir update-function)
-      (if (not files) (setq files (vc-expand-dirs (list dir) 'CVS)))
-      (vc-cvs-command (current-buffer) 'async files "-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-run-delayed
-       (vc-cvs-after-dir-status update-function)))))
+        (vc-cvs-dir-status-heuristic dir update-function))
+    (vc-cvs-command (current-buffer) 'async
+                    files
+                    "-f" "-n" "-q" "update")
+    (vc-run-delayed
+      (vc-cvs-after-dir-status update-function))))
 
 (defun vc-cvs-file-to-string (file)
   "Read the content of FILE and return it as a string."