From 2b04ca05ad9f3679a047ffc06b35d2d61d74b12e Mon Sep 17 00:00:00 2001
From: Juri Linkov <juri@linkov.net>
Date: Wed, 19 Feb 2020 01:35:03 +0200
Subject: [PATCH] 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.
---
 etc/NEWS                 |  5 +++++
 lisp/vc/vc-dispatcher.el |  3 ++-
 lisp/vc/vc.el            | 35 ++++++++++++++++++++++++++++-------
 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."
-- 
2.39.5