Function: vc-git--checkin
vc-git--checkin is a byte-compiled function defined in vc-git.el.gz.
Signature
(vc-git--checkin COMMENT &optional FILES PATCH-STRING)
Documentation
Workhorse routine for vc-git-checkin and vc-git-checkin-patch.
COMMENT is the commit message; must be non-nil. For a regular checkin, FILES is the list of files to check in. To check in a patch, PATCH-STRING is the patch text. It is an error to supply both or neither.
Source Code
;; Defined in /usr/src/emacs/lisp/vc/vc-git.el.gz
(defun vc-git--checkin (comment &optional files patch-string)
"Workhorse routine for `vc-git-checkin' and `vc-git-checkin-patch'.
COMMENT is the commit message; must be non-nil.
For a regular checkin, FILES is the list of files to check in.
To check in a patch, PATCH-STRING is the patch text.
It is an error to supply both or neither."
(unless (xor files patch-string)
(error "Invalid call to `vc-git--checkin'"))
(let* ((file1 (or (car files) default-directory))
(root (vc-git-root file1))
(default-directory (expand-file-name root))
(only (or (cdr files)
(not (equal root (abbreviate-file-name file1)))))
(pcsw coding-system-for-write)
(coding-system-for-write
;; On MS-Windows, we must encode command-line arguments in
;; the system codepage.
(if (eq system-type 'windows-nt)
locale-coding-system
(or coding-system-for-write vc-git-commits-coding-system)))
(msg-file
;; On MS-Windows, pass the commit log message through a
;; file, to work around the limitation that command-line
;; arguments must be in the system codepage, and therefore
;; might not support the non-ASCII characters in the log
;; message. Handle also remote files.
(if (eq system-type 'windows-nt)
(let ((default-directory (or (file-name-directory file1)
default-directory)))
(make-nearby-temp-file "git-msg"))))
to-stash)
(when patch-string
(unless (zerop (vc-git-command nil t nil "diff" "--cached" "--quiet"))
;; Check that what's already staged is compatible with what
;; we want to commit (bug#60126).
;;
;; 1. If the changes to a file in the index are identical to
;; the changes to that file we want to commit, remove the
;; changes from our patch, and let the commit take them
;; from the index. This is necessary for adding and
;; removing files to work.
;;
;; 2. If the changes to a file in the index are different to
;; changes to that file we want to commit, then we have to
;; unstage the changes or abort.
;;
;; 3. If there are changes to a file in the index but we don't
;; want to commit any changes to that file, we need to
;; stash those changes before committing.
(with-temp-buffer
;; If the user has switches like -D, -M etc. in their
;; `vc-git-diff-switches', we must pass them here too, or
;; our string matches will fail.
(if vc-git-diff-switches
(apply #'vc-git-command (current-buffer) t nil
"diff" "--cached" (vc-switches 'git 'diff))
;; Following code doesn't understand plain diff(1) output.
(user-error "Cannot commit patch with nil `vc-git-diff-switches'"))
(goto-char (point-min))
(let ((pos (point)) file-name file-header file-diff file-beg)
(while (not (eobp))
(when (and (looking-at "^diff --git a/\\(.+\\) b/\\(.+\\)")
(string= (match-string 1) (match-string 2)))
(setq file-name (match-string 1)))
(forward-line 1) ; skip current "diff --git" line
(setq file-header (buffer-substring pos (point)))
(search-forward "diff --git" nil 'move)
(move-beginning-of-line 1)
(setq file-diff (buffer-substring pos (point)))
(cond ((and (setq file-beg
(string-search file-diff patch-string))
;; Check that file diff ends with an empty string
;; or the beginning of the next file diff.
(string-match-p "\\`\\'\\|\\`diff --git"
(substring patch-string
(+ file-beg
(length file-diff)))))
(setq patch-string
(string-replace file-diff "" patch-string)))
((string-match (format "^%s" (regexp-quote file-header))
patch-string)
(if (and file-name
(yes-or-no-p
(format "Unstage already-staged changes to %s?"
file-name)))
(vc-git-command nil 0 file-name "reset" "-q" "--")
(user-error "Index not empty")))
(t (push file-name to-stash)))
(setq pos (point))))))
(unless (string-empty-p patch-string)
(let (;; Temporarily countermand the let-binding at the
;; beginning of this function.
(coding-system-for-write
(coding-system-change-eol-conversion
;; On DOS/Windows, it is important for the patch file
;; to have the Unix EOL format, because Git expects
;; that, even on Windows.
(or pcsw vc-git-commits-coding-system) 'unix)))
(vc-git--with-apply-temp (patch)
(with-temp-file patch
(insert patch-string)))))
(when to-stash (vc-git--stash-staged-changes to-stash)))
(let ((files (and only (not patch-string) files))
(args (vc-git--log-edit-extract-headers comment))
(buffer (format "*vc-git : %s*" (expand-file-name root)))
(post
(lambda ()
(when (and msg-file (file-exists-p msg-file))
(delete-file msg-file))
;; If PATCH-STRING didn't come from C-x v = or C-x v D, we
;; now need to update the working tree to include the
;; changes from the commit we just created.
;; If there are conflicts we want to favor the working
;; tree's version and the version from the commit will just
;; show up in the diff of uncommitted changes.
;;
;; 'git apply --3way --ours' is the way Git provides to
;; achieve this. This requires that the index match the
;; working tree and also implies the --index option, which
;; means applying the changes to the index in addition to
;; the working tree. These are both okay here because
;; before doing this we know the index is empty (we just
;; committed) and so we can just make use of it and reset
;; afterwards.
(when patch-string
(vc-git-command nil 0 nil "add" "--all")
(with-temp-buffer
(vc-git--with-apply-temp (patch t 1 "--3way")
(with-temp-file patch
(insert patch-string)))
;; We could delete the following if we could also pass
;; --ours to git-apply, but that is only available in
;; recent versions of Git. --3way is much older.
(cl-loop
initially (goto-char (point-min))
;; git-apply doesn't apply Git's usual quotation and
;; escape rules for printing file names so we can do
;; this simple regexp processing.
;; (Passing -z does not affect the relevant output.)
while (re-search-forward "^U " nil t)
collect (buffer-substring-no-properties (point)
(pos-eol))
into paths
finally (when paths
(vc-git-command nil 0 paths
"checkout" "--ours"))))
(vc-git-command nil 0 nil "reset"))
(when to-stash
(vc-git--with-apply-temp (cached)
(with-temp-file cached
(vc-git-command t 0 nil "stash" "show" "-p")))
(vc-git-command nil 0 nil "stash" "drop")))))
(when msg-file
(let ((coding-system-for-write
(or pcsw vc-git-commits-coding-system)))
(write-region (car args) nil msg-file))
(setq args (cdr args)))
(setq args (nconc (if msg-file
(list "commit" "-F"
(file-local-name msg-file))
(list "commit" "-m"))
args
;; When operating on the whole tree, better pass
;; "-a" than ".", since "." fails when we're
;; committing a merge.
(and (not patch-string)
(if only (list "--only" "--") '("-a")))))
(if vc-async-checkin
(let ((proc (apply #'vc-do-async-command buffer root
vc-git-program (nconc args files))))
(set-process-query-on-exit-flag proc t)
(vc-wait-for-process-before-save
proc
"Finishing checking in files...")
(with-current-buffer buffer
(vc-run-delayed
(vc-compilation-mode 'git)
(funcall post)))
(vc-set-async-update buffer)
(list 'async (get-buffer-process buffer)))
(apply #'vc-git-command nil 0 files args)
(funcall post)))))