bug#24082: [PATCH] Use ‘cvs update’ instead ‘cvs status’ for CVS *vc-dir* buffers

["Göktuğ Kayaalp" <self@gkayaalp.com>]

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

Hi, attached is a patch that fixes bug#24082.

The reason of the bug was that, in function ‘vc-cvs-after-dir-status’,
the CVS status line ‘cvs status: Examining <dir>’ was excluded when the
function narrows to match, and when it tries to set the local variable
‘subdir’, as it does not find this line, it skips setting it.  As
‘subdir’ defaults to ‘default-directory’, which is previously set to
repo root (i.e. the argument to function ‘vc-dir’, when ‘subdir’ is used
to construct the relative path to file, concatenating it with the
already-known file base name, it returns the basename, i.e. in
the form ‘name.ext’, with no directory path.  This because it constructs
the relative path like ‘(file-relative-name basename subdir)’.

The patch uses ‘cvs update’ command instead.  The implementation was
already there, commented out.  I enabled and corrected it.  The result
is more correct than the ‘cvs status’ approach, i.e. includes
unregistered and missing, and is faster compared to ‘cvs status’ way.

PS.: Please have me in CC when updating, I'm not subscribed to
bug-gnu-emacs.

-- 
İ. Göktuğ Kayaalp.
http://gkayaalp.com/


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch for #24082 --]
[-- Type: text/x-diff, Size: 6019 bytes --]

diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index 5019871..fa385ae 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -944,103 +944,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.
@@ -1078,15 +1007,12 @@ 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)))))
+      (if (not files) (setq files (vc-expand-dirs (list dir) 'CVS)))) 
+    (vc-cvs-command (current-buffer) 'async
+                    (file-relative-name dir)
+                    "-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."