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)))
    (cl-flet ((do-it ()
                (vc-revert-files backend
                                 (mapcar (lambda (f)
                                           (with-current-buffer
                                               (find-file-noselect f)
                                             buffer-file-name))
                                         files))
                (with-temp-buffer
                  ;; Try to support CVS too.  Assume 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 (zerop (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))
              (cleanup ()
                (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)))
      (if (and vc-async-checkin
               (vc-call-backend backend 'async-checkins))
          (let ((ret (do-it)))
            (when (eq (car-safe ret) 'async)
              (vc-exec-after #'cleanup nil (cadr ret))))
        (unwind-protect (do-it) (cleanup))))))