Add default implementation for 'checkin-patch'

* lisp/vc/vc.el (vc-default-checkin-patch):
Add default implementation for 'checkin-patch' (bug#52349).
The first attempt was here:
https://lists.gnu.org/archive/html/emacs-devel/2022-08/msg01464.html

diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 8d0680888a4169a35293dfd2dc27e2db3bded33c..7152b51eff69f0c022c822815cc3698bf5342037 100644 (file)
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1683,6 +1683,50 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
    backend
    patch-string))
 
+(defun vc-default-checkin-patch (_backend patch-string comment)
+  (pcase-let* ((`(,backend ,files) (with-temp-buffer
+                                     (insert patch-string)
+                                     (diff-vc-deduce-fileset)))
+               (tmpdir (make-temp-file "vc-checkin-patch" t)))
+    (dolist (f files)
+      (make-directory (file-name-directory (expand-file-name f tmpdir)) t)
+      (copy-file (expand-file-name f)
+                 (expand-file-name f tmpdir)))
+    (unwind-protect
+        (progn
+          (dolist (f files)
+            (with-current-buffer (find-file-noselect f)
+              (vc-revert-file f)))
+          (with-temp-buffer
+            ;; Trying to support CVS too.  Assuming that vc-diff
+            ;; there will usually the diff root in default-directory.
+            (when (vc-find-backend-function backend 'root)
+              (setq-local default-directory
+                          (vc-call-backend backend 'root (car files))))
+            (unless (eq 0
+                        (call-process-region patch-string
+                                             nil
+                                             "patch"
+                                             nil
+                                             t
+                                             nil
+                                             "-p1"
+                                             "-r" null-device
+                                             "--no-backup-if-mismatch"
+                                             "-i" "-"))
+              (user-error "Patch failed: %s" (buffer-string))))
+          (dolist (f files)
+            (with-current-buffer (get-file-buffer f)
+              (revert-buffer t t t)))
+          (vc-call-backend backend 'checkin files comment))
+      (dolist (f files)
+        (copy-file (expand-file-name f tmpdir)
+                   (expand-file-name f)
+                   t)
+        (with-current-buffer (get-file-buffer f)
+          (revert-buffer t t t))
+        (delete-directory tmpdir t)))))
+
 ;;; Additional entry points for examining version histories
 
 ;; (defun vc-default-diff-tree (backend dir rev1 rev2)