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."