Function: vc-default-checkin-patch

vc-default-checkin-patch is a byte-compiled function defined in vc.el.gz.

Signature

(vc-default-checkin-patch BACKEND PATCH-STRING COMMENT)

Source Code

;; Defined in /usr/src/emacs/lisp/vc/vc.el.gz
(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 buffer-file-name)))
          (with-temp-buffer
            ;; Trying to support CVS too.  Assuming that vc-diff
            ;; there will usually have 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))))
          (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))))