bug#24082: 25.1; vc-dir for CVS repositories list all files as if from toplevel directory

[Dmitry Gutov <dgutov@yandex.ru>]

[-- Attachment #1: Type: text/plain, Size: 579 bytes --]

On 15.10.2016 17:06, Jérémie Courrèges-Anglas wrote:

> You asked for the output of `cvs -fnq update', but in my tests the
> actual command that is run seems to be `cvs -fnq update ./'.

Could you both please try the attached modified patch.

It removes the vc-expand-dirs call from vc-cvs-dir-status-files (its 
return value was unused anyway), and passes FILES unmodified to 
vc-cvs-command.

We can be fairly sure that DIR is default-directory, so passing it in 
explicitly is unnecessary. Whenever that ceases to be the case, we'll 
have to update other backends as well.

[-- Attachment #2: bug-24082-2.patch --]
[-- Type: text/x-diff, Size: 6018 bytes --]

diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index a2499a2..2134793 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -938,103 +938,32 @@ vc-cvs-parse-status
 	  (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 @@ vc-cvs-dir-status-files
 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."