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

[Juri Linkov]

branch: master
commit 2b04ca05ad9f3679a047ffc06b35d2d61d74b12e
Author: Juri Linkov <address@hidden>
Commit: Juri Linkov <address@hidden>

    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 1f8e604..1a51a90 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 5ae300b..4a04c93 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 ec252b7..f7d651f 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."