bug#34949: 27.0.50; Docstring of `vc-deduce-fileset' incomplete

[Juri Linkov]

> I don't say it's a bad thing, just will make the patch 10 times longer.

Ok, here's the patch that is 10 times longer.

It creates a new function vc-use-vc-dir-on-files
called from vc-next-action that checks whether
the buffer is Dired with marked directories,
and for optimization returns a list of files
to give to vc-dir via a new arg MARK-FILES.

Then vc-dir let-binds the global variable use-mark-files
exactly the same way as already let-binds use-vc-backend
since there is no other way.

Then vc-dir-refresh puts all marks on files.

Also the patch adds a new useful global keybinding 'C-x v V'
bound to vc-next-action-on-root to open *vc-dir* buffer where
all registered files are marked.

diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 38b4937e85..a2bf7c2a5a 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -1024,6 +1024,7 @@ vc-dir-resynch-file
     (dolist (b drop) (setq vc-dir-buffers (delq b vc-dir-buffers)))))
 
 (defvar use-vc-backend)  ;; dynamically bound
+(defvar use-mark-files)  ;; dynamically bound
 
 (define-derived-mode vc-dir-mode special-mode "VC dir"
   "Major mode for VC directory buffers.
@@ -1079,7 +1080,7 @@ vc-dir-mode
     ;; process running in the background is also killed.
     (add-hook 'kill-buffer-query-functions 'vc-dir-kill-query nil t)
     (hack-dir-local-variables-non-file-buffer)
-    (vc-dir-refresh)))
+    (vc-dir-refresh use-mark-files)))
 
 (defun vc-dir-headers (backend dir)
   "Display the headers in the *VC dir* buffer.
@@ -1143,7 +1144,7 @@ vc-dir-refresh-files
 (defun vc-dir-revert-buffer-function (&optional _ignore-auto _noconfirm)
   (vc-dir-refresh))
 
-(defun vc-dir-refresh ()
+(defun vc-dir-refresh (&optional mark-files)
   "Refresh the contents of the *VC-dir* buffer.
 Throw an error if another update process is in progress."
   (interactive)
@@ -1193,7 +1194,28 @@ vc-dir-refresh
                    (if remaining
                        (vc-dir-refresh-files
                         (mapcar 'vc-dir-fileinfo->name remaining))
-                     (setq mode-line-process nil))))))))))))
+                     (setq mode-line-process nil)
+                     (when mark-files
+                       (let* ((backend (vc-responsible-backend 
default-directory))
+                              (rootdir (vc-call-backend backend 'root 
default-directory)))
+                         (when (listp mark-files)
+                           (setq mark-files (mapcar (lambda (file)
+                                                      (file-relative-name
+                                                       (if (file-directory-p 
file)
+                                                           
(file-name-as-directory file)
+                                                         file)
+                                                       rootdir))
+                                                    mark-files)))
+                         (vc-dir-unmark-all-files t)
+                         (ewoc-map
+                          (lambda (filearg)
+                            (when (cond ((consp mark-files)
+                                         (member (vc-dir-fileinfo->name 
filearg) mark-files))
+                                        ((eq mark-files 'registered)
+                                         (memq (vc-dir-fileinfo->state 
filearg) '(edited added removed))))
+                              (setf (vc-dir-fileinfo->marked filearg) t)
+                              t))
+                          vc-ewoc))))))))))))))
 
 (defun vc-dir-show-fileentry (file)
   "Insert an entry for a specific file into the current *VC-dir* listing.
@@ -1287,7 +1309,7 @@ vc-dir-deduce-fileset
     (list vc-dir-backend files only-files-list state model)))
 
 ;;;###autoload
-(defun vc-dir (dir &optional backend)
+(defun vc-dir (dir &optional backend mark-files)
   "Show the VC status for \"interesting\" files in and below DIR.
 This allows you to mark files and perform VC operations on them.
 The list omits files which are up to date, with no changes in your copy
@@ -1326,9 +1348,10 @@ vc-dir
   (let (pop-up-windows)                      ; based on cvs-examine; bug#6204
     (pop-to-buffer (vc-dir-prepare-status-buffer "*vc-dir*" dir backend)))
   (if (derived-mode-p 'vc-dir-mode)
-      (vc-dir-refresh)
+      (vc-dir-refresh mark-files)
     ;; FIXME: find a better way to pass the backend to `vc-dir-mode'.
-    (let ((use-vc-backend backend))
+    (let ((use-vc-backend backend)
+          (use-mark-files mark-files))
       (vc-dir-mode))))
 
 (defun vc-default-dir-extra-headers (_backend _dir)
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 345a28d3f1..80c580e5ec 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -897,6 +897,7 @@ vc-prefix-map
     (define-key map "s" 'vc-create-tag)
     (define-key map "u" 'vc-revert)
     (define-key map "v" 'vc-next-action)
+    (define-key map "V" 'vc-next-action-on-root)
     (define-key map "+" 'vc-update)
     ;; I'd prefer some kind of symmetry with vc-update:
     (define-key map "P" 'vc-push)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 607fb37807..3b20a917f5 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1132,8 +1132,18 @@ vc-read-backend
    (completing-read prompt (mapcar #'symbol-name vc-handled-backends)
                     nil 'require-match)))
 
+(defun vc-next-action-on-root ()
+  (interactive)
+  (vc-dir (vc-root-dir) nil 'registered))
+
 ;; Here's the major entry point.
 
+(defun vc-use-vc-dir-on-files ()
+  (when (derived-mode-p 'dired-mode)
+    (let ((files (dired-get-marked-files nil nil nil nil t)))
+      (when (cl-some #'file-directory-p files)
+        files))))
+
 ;;;###autoload
 (defun vc-next-action (verbose)
   "Do the next logical version control operation on the current fileset.
@@ -1158,184 +1168,187 @@ vc-next-action
   If every file is locked by you and unchanged, unlock them.
   If every file is locked by someone else, offer to steal the lock."
   (interactive "P")
-  (let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files))
-         (backend (car vc-fileset))
-        (files (nth 1 vc-fileset))
-         ;; (fileset-only-files (nth 2 vc-fileset))
-         ;; FIXME: We used to call `vc-recompute-state' here.
-         (state (nth 3 vc-fileset))
-         ;; The backend should check that the checkout-model is consistent
-         ;; among all the `files'.
-        (model (nth 4 vc-fileset)))
+  (let ((mark-files (vc-use-vc-dir-on-files)))
+    (if mark-files
+        (vc-dir (vc-root-dir) nil mark-files)
+      (let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files))
+             (backend (car vc-fileset))
+             (files (nth 1 vc-fileset))
+             ;; (fileset-only-files (nth 2 vc-fileset))
+             ;; FIXME: We used to call `vc-recompute-state' here.
+             (state (nth 3 vc-fileset))
+             ;; The backend should check that the checkout-model is consistent
+             ;; among all the `files'.
+             (model (nth 4 vc-fileset)))
 
-    ;; If a buffer has unsaved changes, a checkout would discard those
-    ;; changes, so treat the buffer as having unlocked changes.
-    (when (and (not (eq model 'implicit)) (eq state 'up-to-date))
-      (dolist (file files)
-        (let ((buffer (get-file-buffer file)))
-          (and buffer
-               (buffer-modified-p buffer)
-               (setq state 'unlocked-changes)))))
-
-    ;; Do the right thing.
-    (cond
-     ((eq state 'missing)
-      (error "Fileset files are missing, so cannot be operated on"))
-     ((eq state 'ignored)
-      (error "Fileset files are ignored by the version-control system"))
-     ((or (null state) (eq state 'unregistered))
-      (vc-register vc-fileset))
-     ;; Files are up-to-date, or need a merge and user specified a revision
-     ((or (eq state 'up-to-date) (and verbose (eq state 'needs-update)))
-      (cond
-       (verbose
-       ;; Go to a different revision.
-       (let* ((revision
-                ;; FIXME: Provide completion.
-                (read-string "Branch, revision, or backend to move to: "))
-               (revision-downcase (downcase revision)))
-         (if (member
-              revision-downcase
-              (mapcar (lambda (arg) (downcase (symbol-name arg)))
-                       vc-handled-backends))
-             (let ((vsym (intern-soft revision-downcase)))
-               (dolist (file files) (vc-transfer-file file vsym)))
-           (dolist (file files)
-              (vc-checkout file revision)))))
-       ((not (eq model 'implicit))
-       ;; check the files out
-       (dolist (file files) (vc-checkout file)))
-       (t
-        ;; do nothing
-        (message "Fileset is up-to-date"))))
-     ;; Files have local changes
-     ((vc-compatible-state state 'edited)
-      (let ((ready-for-commit files))
-       ;; CVS, SVN and bzr don't care about read-only (bug#9781).
-       ;; RCS does, SCCS might (someone should check...).
-       (when (memq backend '(RCS SCCS))
-         ;; If files are edited but read-only, give user a chance to correct.
-         (dolist (file files)
-           ;; If committing a mix of removed and edited files, the
-           ;; fileset has state = 'edited.  Rather than checking the
-           ;; state of each individual file in the fileset, it seems
-           ;; simplest to just check if the file exists.        Bug#9781.
-           (when (and (file-exists-p file) (not (file-writable-p file)))
-             ;; Make the file-buffer read-write.
-             (unless (y-or-n-p (format "%s is edited but read-only; make it 
writable and continue? " file))
-               (error "Aborted"))
-             ;; Maybe we somehow lost permissions on the directory.
-             (condition-case nil
-                 (set-file-modes file (logior (file-modes file) 128))
-               (error (error "Unable to make file writable")))
-             (let ((visited (get-file-buffer file)))
-               (when visited
-                 (with-current-buffer visited
-                   (read-only-mode -1)))))))
-       ;; Allow user to revert files with no changes
-       (save-excursion
+        ;; If a buffer has unsaved changes, a checkout would discard those
+        ;; changes, so treat the buffer as having unlocked changes.
+        (when (and (not (eq model 'implicit)) (eq state 'up-to-date))
           (dolist (file files)
-            (let ((visited (get-file-buffer file)))
-              ;; For files with locking, if the file does not contain
-              ;; any changes, just let go of the lock, i.e. revert.
-              (when (and (not (eq model 'implicit))
-                        (eq state 'up-to-date)
-                        ;; If buffer is modified, that means the user just
-                        ;; said no to saving it; in that case, don't revert,
-                        ;; because the user might intend to save after
-                        ;; finishing the log entry and committing.
-                        (not (and visited (buffer-modified-p))))
-               (vc-revert-file file)
-               (setq ready-for-commit (delete file ready-for-commit))))))
-       ;; Remaining files need to be committed
-       (if (not ready-for-commit)
-           (message "No files remain to be committed")
-         (if (not verbose)
-             (vc-checkin ready-for-commit backend)
-           (let* ((revision (read-string "New revision or backend: "))
+            (let ((buffer (get-file-buffer file)))
+              (and buffer
+                   (buffer-modified-p buffer)
+                   (setq state 'unlocked-changes)))))
+
+        ;; Do the right thing.
+        (cond
+         ((eq state 'missing)
+          (error "Fileset files are missing, so cannot be operated on"))
+         ((eq state 'ignored)
+          (error "Fileset files are ignored by the version-control system"))
+         ((or (null state) (eq state 'unregistered))
+          (vc-register vc-fileset))
+         ;; Files are up-to-date, or need a merge and user specified a revision
+         ((or (eq state 'up-to-date) (and verbose (eq state 'needs-update)))
+          (cond
+           (verbose
+            ;; Go to a different revision.
+            (let* ((revision
+                    ;; FIXME: Provide completion.
+                    (read-string "Branch, revision, or backend to move to: "))
                    (revision-downcase (downcase revision)))
-             (if (member
-                  revision-downcase
-                  (mapcar (lambda (arg) (downcase (symbol-name arg)))
-                          vc-handled-backends))
-                 (let ((vsym (intern revision-downcase)))
-                   (dolist (file files) (vc-transfer-file file vsym)))
-               (vc-checkin ready-for-commit backend nil nil revision)))))))
-     ;; locked by somebody else (locking VCSes only)
-     ((stringp state)
-      ;; In the old days, we computed the revision once and used it on
-      ;; the single file.  Then, for the 2007-2008 fileset rewrite, we
-      ;; computed the revision once (incorrectly, using a free var) and
-      ;; used it on all files.  To fix the free var bug, we can either
-      ;; use `(car files)' or do what we do here: distribute the
-      ;; revision computation among `files'.  Although this may be
-      ;; tedious for those backends where a "revision" is a trans-file
-      ;; concept, it is nonetheless correct for both those and (more
-      ;; importantly) for those where "revision" is a per-file concept.
-      ;; If the intersection of the former group and "locking VCSes" is
-      ;; non-empty [I vaguely doubt it --ttn], we can reinstate the
-      ;; pre-computation approach of yore.
-      (dolist (file files)
-        (vc-steal-lock
-         file (if verbose
-                  (read-string (format "%s revision to steal: " file))
-                (vc-working-revision file))
-         state)))
-     ;; conflict
-     ((eq state 'conflict)
-      ;; FIXME: Is it really the UI we want to provide?
-      ;; In my experience, the conflicted files should be marked as resolved
-      ;; one-by-one when saving the file after resolving the conflicts.
-      ;; I.e. stating explicitly that the conflicts are resolved is done
-      ;; very rarely.
-      (vc-mark-resolved backend files))
-     ;; needs-update
-     ((eq state 'needs-update)
-      (dolist (file files)
-       (if (yes-or-no-p (format
-                         "%s is not up-to-date.  Get latest revision? "
-                         (file-name-nondirectory file)))
-           (vc-checkout file t)
-         (when (and (not (eq model 'implicit))
-                    (yes-or-no-p "Lock this revision? "))
-           (vc-checkout file)))))
-     ;; needs-merge
-     ((eq state 'needs-merge)
-      (dolist (file files)
-       (when (yes-or-no-p (format
-                         "%s is not up-to-date.  Merge in changes now? "
-                         (file-name-nondirectory file)))
-         (vc-maybe-resolve-conflicts
-           file (vc-call-backend backend 'merge-news file)))))
+              (if (member
+                   revision-downcase
+                   (mapcar (lambda (arg) (downcase (symbol-name arg)))
+                           vc-handled-backends))
+                  (let ((vsym (intern-soft revision-downcase)))
+                    (dolist (file files) (vc-transfer-file file vsym)))
+                (dolist (file files)
+                  (vc-checkout file revision)))))
+           ((not (eq model 'implicit))
+            ;; check the files out
+            (dolist (file files) (vc-checkout file)))
+           (t
+            ;; do nothing
+            (message "Fileset is up-to-date"))))
+         ;; Files have local changes
+         ((vc-compatible-state state 'edited)
+          (let ((ready-for-commit files))
+            ;; CVS, SVN and bzr don't care about read-only (bug#9781).
+            ;; RCS does, SCCS might (someone should check...).
+            (when (memq backend '(RCS SCCS))
+              ;; If files are edited but read-only, give user a chance to 
correct.
+              (dolist (file files)
+                ;; If committing a mix of removed and edited files, the
+                ;; fileset has state = 'edited.  Rather than checking the
+                ;; state of each individual file in the fileset, it seems
+                ;; simplest to just check if the file exists.   Bug#9781.
+                (when (and (file-exists-p file) (not (file-writable-p file)))
+                  ;; Make the file-buffer read-write.
+                  (unless (y-or-n-p (format "%s is edited but read-only; make 
it writable and continue? " file))
+                    (error "Aborted"))
+                  ;; Maybe we somehow lost permissions on the directory.
+                  (condition-case nil
+                      (set-file-modes file (logior (file-modes file) 128))
+                    (error (error "Unable to make file writable")))
+                  (let ((visited (get-file-buffer file)))
+                    (when visited
+                      (with-current-buffer visited
+                        (read-only-mode -1)))))))
+            ;; Allow user to revert files with no changes
+            (save-excursion
+              (dolist (file files)
+                (let ((visited (get-file-buffer file)))
+                  ;; For files with locking, if the file does not contain
+                  ;; any changes, just let go of the lock, i.e. revert.
+                  (when (and (not (eq model 'implicit))
+                             (eq state 'up-to-date)
+                             ;; If buffer is modified, that means the user just
+                             ;; said no to saving it; in that case, don't 
revert,
+                             ;; because the user might intend to save after
+                             ;; finishing the log entry and committing.
+                             (not (and visited (buffer-modified-p))))
+                    (vc-revert-file file)
+                    (setq ready-for-commit (delete file ready-for-commit))))))
+            ;; Remaining files need to be committed
+            (if (not ready-for-commit)
+                (message "No files remain to be committed")
+              (if (not verbose)
+                  (vc-checkin ready-for-commit backend)
+                (let* ((revision (read-string "New revision or backend: "))
+                       (revision-downcase (downcase revision)))
+                  (if (member
+                       revision-downcase
+                       (mapcar (lambda (arg) (downcase (symbol-name arg)))
+                               vc-handled-backends))
+                      (let ((vsym (intern revision-downcase)))
+                        (dolist (file files) (vc-transfer-file file vsym)))
+                    (vc-checkin ready-for-commit backend nil nil 
revision)))))))
+         ;; locked by somebody else (locking VCSes only)
+         ((stringp state)
+          ;; In the old days, we computed the revision once and used it on
+          ;; the single file.  Then, for the 2007-2008 fileset rewrite, we
+          ;; computed the revision once (incorrectly, using a free var) and
+          ;; used it on all files.  To fix the free var bug, we can either
+          ;; use `(car files)' or do what we do here: distribute the
+          ;; revision computation among `files'.  Although this may be
+          ;; tedious for those backends where a "revision" is a trans-file
+          ;; concept, it is nonetheless correct for both those and (more
+          ;; importantly) for those where "revision" is a per-file concept.
+          ;; If the intersection of the former group and "locking VCSes" is
+          ;; non-empty [I vaguely doubt it --ttn], we can reinstate the
+          ;; pre-computation approach of yore.
+          (dolist (file files)
+            (vc-steal-lock
+             file (if verbose
+                      (read-string (format "%s revision to steal: " file))
+                    (vc-working-revision file))
+             state)))
+         ;; conflict
+         ((eq state 'conflict)
+          ;; FIXME: Is it really the UI we want to provide?
+          ;; In my experience, the conflicted files should be marked as 
resolved
+          ;; one-by-one when saving the file after resolving the conflicts.
+          ;; I.e. stating explicitly that the conflicts are resolved is done
+          ;; very rarely.
+          (vc-mark-resolved backend files))
+         ;; needs-update
+         ((eq state 'needs-update)
+          (dolist (file files)
+            (if (yes-or-no-p (format
+                              "%s is not up-to-date.  Get latest revision? "
+                              (file-name-nondirectory file)))
+                (vc-checkout file t)
+              (when (and (not (eq model 'implicit))
+                         (yes-or-no-p "Lock this revision? "))
+                (vc-checkout file)))))
+         ;; needs-merge
+         ((eq state 'needs-merge)
+          (dolist (file files)
+            (when (yes-or-no-p (format
+                              "%s is not up-to-date.  Merge in changes now? "
+                              (file-name-nondirectory file)))
+              (vc-maybe-resolve-conflicts
+               file (vc-call-backend backend 'merge-news file)))))
 
-     ;; unlocked-changes
-     ((eq state 'unlocked-changes)
-      (dolist (file files)
-       (when (not (equal buffer-file-name file))
-         (find-file-other-window file))
-       (if (save-window-excursion
-             (vc-diff-internal nil
-                               (cons (car vc-fileset) (cons (cadr vc-fileset) 
(list file)))
-                               (vc-working-revision file) nil)
-             (goto-char (point-min))
-             (let ((inhibit-read-only t))
-               (insert
-                (format "Changes to %s since last lock:\n\n" file)))
-             (not (beep))
-             (yes-or-no-p (concat "File has unlocked changes.  "
-                                  "Claim lock retaining changes? ")))
-           (progn (vc-call-backend backend 'steal-lock file)
-                  (clear-visited-file-modtime)
-                  (write-file buffer-file-name)
-                  (vc-mode-line file backend))
-         (if (not (yes-or-no-p
-                   "Revert to checked-in revision, instead? "))
-             (error "Checkout aborted")
-           (vc-revert-buffer-internal t t)
-           (vc-checkout file)))))
-     ;; Unknown fileset state
-     (t
-      (error "Fileset is in an unknown state %s" state)))))
+         ;; unlocked-changes
+         ((eq state 'unlocked-changes)
+          (dolist (file files)
+            (when (not (equal buffer-file-name file))
+              (find-file-other-window file))
+            (if (save-window-excursion
+                  (vc-diff-internal nil
+                                    (cons (car vc-fileset) (cons (cadr 
vc-fileset) (list file)))
+                                    (vc-working-revision file) nil)
+                  (goto-char (point-min))
+                  (let ((inhibit-read-only t))
+                    (insert
+                     (format "Changes to %s since last lock:\n\n" file)))
+                  (not (beep))
+                  (yes-or-no-p (concat "File has unlocked changes.  "
+                                       "Claim lock retaining changes? ")))
+                (progn (vc-call-backend backend 'steal-lock file)
+                       (clear-visited-file-modtime)
+                       (write-file buffer-file-name)
+                       (vc-mode-line file backend))
+              (if (not (yes-or-no-p
+                        "Revert to checked-in revision, instead? "))
+                  (error "Checkout aborted")
+                (vc-revert-buffer-internal t t)
+                (vc-checkout file)))))
+         ;; Unknown fileset state
+         (t
+          (error "Fileset is in an unknown state %s" state)))))))
 
 (defun vc-create-repo (backend)
   "Create an empty repository in the current directory."