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
                  (diff-mode)
                  (insert patch-string)
                  (goto-char (point-min))
                  (when (and (re-search-forward
                              "^\\(?:Date\\|From\\|Author\\):[\t\s]*[^\t\n\s]"
                              (car (diff-bounds-of-hunk))
                              t)
                             (not (yes-or-no-p "Patch appears to contain \
authorship information but this will be ignored when checking in; \
proceed anyway?")))
                    (user-error "Aborted"))
                  (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
          (vc-revert-files backend
                           (mapcar (lambda (f)
                                     (with-current-buffer (find-file-noselect f)
                                       buffer-file-name))
                                   files))
          (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
                                             "--posix"
                                             "--remove-empty-files"
                                             "-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))))