1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-26 07:33:47 +00:00

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
This commit is contained in:
Dmitry Gutov 2022-10-17 02:46:02 +03:00
parent 13d6e8fa54
commit 4a6ad6e18f

View File

@ -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)