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.

diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index a2499a2294b496b8d32ca71647b7496853a1bafe..3cfe8ee56a2fa8ef914d2f1df4ee712ece27fd7e 100644 (file)
--- 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."