Support state changing VC operations in dired-mode on files (bug#34949)

* lisp/vc/vc.el (vc-deduce-fileset): Don't error out when observer is nil.
(vc-dired-deduce-fileset): Add optional args 'state-model-only-files'
and 'observer'.  Check that all files are in a consistent state
when state-model-only-files is non-nil.  Error out on directories.

* lisp/vc/vc-dispatcher.el (vc-dispatcher-browsing): Check dired-mode
for derived-mode-p.

3 files changed, 35 insertions, 8 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 1f8e6049a88..1a51a90636d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -96,6 +96,11 @@ shows equivalent key bindings for all commands that have them.
 
 * Changes in Specialized Modes and Packages in Emacs 28.1
 
+** Dired
+
+*** State changing VC operations are supported in dired-mode on files
+(but still not on directories).
+
 ** Help
 
 +++
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 5ae300bf09b..4a04c9365a5 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -746,7 +746,8 @@ the buffer contents as a comment."
 
 (defun vc-dispatcher-browsing ()
   "Are we in a directory browser buffer?"
-  (derived-mode-p 'vc-dir-mode))
+  (or (derived-mode-p 'vc-dir-mode)
+      (derived-mode-p 'dired-mode)))
 
 ;; These are unused.
 ;; (defun vc-dispatcher-in-fileset-p (fileset)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index ec252b74d47..f7d651fac6f 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1032,9 +1032,7 @@ BEWARE: this function may change the current buffer."
      ((derived-mode-p 'vc-dir-mode)
       (vc-dir-deduce-fileset state-model-only-files))
      ((derived-mode-p 'dired-mode)
-      (if observer
-          (vc-dired-deduce-fileset)
-        (error "State changing VC operations not supported in `dired-mode'")))
+      (vc-dired-deduce-fileset state-model-only-files observer))
      ((setq backend (vc-backend buffer-file-name))
       (if state-model-only-files
         (list backend (list buffer-file-name)
@@ -1046,7 +1044,8 @@ BEWARE: this function may change the current buffer."
            ;; FIXME: Why this test?  --Stef
            (or (buffer-file-name vc-parent-buffer)
                                 (with-current-buffer vc-parent-buffer
-                                  (derived-mode-p 'vc-dir-mode))))
+                                  (or (derived-mode-p 'vc-dir-mode)
+                                      (derived-mode-p 'dired-mode)))))
       (progn                  ;FIXME: Why not `with-current-buffer'? --Stef.
         (set-buffer vc-parent-buffer)
         (vc-deduce-fileset observer allow-unregistered state-model-only-files)))
@@ -1066,9 +1065,31 @@ BEWARE: this function may change the current buffer."
               (list buffer-file-name))))
      (t (error "File is not under version control")))))
 
-(defun vc-dired-deduce-fileset ()
-  (list (vc-responsible-backend default-directory)
-        (dired-map-over-marks (dired-get-filename nil t) nil)))
+(declare-function dired-get-marked-files "dired"
+                  (&optional localp arg filter distinguish-one-marked error))
+
+(defun vc-dired-deduce-fileset (&optional state-model-only-files observer)
+  (let ((backend (vc-responsible-backend default-directory))
+        (files (dired-get-marked-files nil nil nil nil t))
+        only-files-list
+        state
+        model)
+    (when (and (not observer) (cl-some #'file-directory-p files))
+      (error "State changing VC operations on directories not supported in `dired-mode'"))
+
+    (when state-model-only-files
+      (setq only-files-list (mapcar (lambda (file) (cons file (vc-state file))) files))
+      (setq state (cdar only-files-list))
+      ;; Check that all files are in a consistent state, since we use that
+      ;; state to decide which operation to perform.
+      (dolist (crt (cdr only-files-list))
+        (unless (vc-compatible-state (cdr crt) state)
+          (error "When applying VC operations to multiple files, the files are required\nto  be in similar VC states.\n%s in state %s clashes with %s in state %s"
+                 (car crt) (cdr crt) (caar only-files-list) state)))
+      (setq only-files-list (mapcar 'car only-files-list))
+      (when (and state (not (eq state 'unregistered)))
+        (setq model (vc-checkout-model backend only-files-list))))
+    (list backend files only-files-list state model)))
 
 (defun vc-ensure-vc-buffer ()
   "Make sure that the current buffer visits a version-controlled file."