mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 18:40:39 -08:00
Code Issues Projects Releases Wiki Activity

VC checkin-patch: Support extracting commit metadata from patches

Browse source 
* lisp/vc/vc-git.el (vc-git--mailinfo): New function.
(vc-git-checkin-patch): Use it to extract authorship, date and
log message information from patches.
(vc-git--call): New INFILE argument.  All uses changed.
* lisp/vc/vc-hg.el (vc-hg--checkin): When COMMENT is nil, take
authorship, date and log message information from the patch.
* lisp/vc/vc.el (checkin-patch): Specify to use authorship, date
and comment information in PATCH-STRING (bug#79408).
(prepare-patch): Specify that patch should include authorship
identity, date and log message information for REV if supported.
(diff-bounds-of-hunk): Declare.
(vc-default-checkin-patch): Warn if it looks like we will ignore
patch authorship information.
* test/lisp/vc/vc-tests/vc-tests.el (vc-hg-command)
(vc-git--out-str): Declare.
(vc-test--checkin-patch): New function.
(vc-test-git08-checkin-patch, vc-test-hg08-checkin-patch): New
tests.
This commit is contained in:
Sean Whitton 2025-09-21 21:39:42 +01:00
parent 0109b4a758
commit 8310795bab
4 changed files with 248 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

96
lisp/vc/vc-git.el
View file

@ -978,7 +978,7 @@ or an empty string if none."
"Return the existing branches, as a list of strings.
The car of the list is the current branch."
(with-temp-buffer
(vc-git--call t "branch")
(vc-git--call nil t "branch")
(goto-char (point-min))
(let (current-branch branches)
(while (not (eobp))
@ -1139,7 +1139,7 @@ It is based on `log-edit-mode', and has Git-specific extensions."
(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.
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."
@ -1279,9 +1279,84 @@ It is an error to supply both or neither."
(apply #'vc-git-command nil 0 files args)
(funcall post)))))
(defun vc-git--mailinfo (patch-string)
"Pipe PATCH-STRING to git-mailinfo(1) and return an alist of its output.
The alist always contains an entry with key `message'.
This contains the commit log message.
In the case that there is also an alist entry with key \"Subject\", the
first line of the commit message is missing from the `message' entry.
To recover the full commit message, concatenate the \"Subject\" and
`message' entries, interpolating two newline characters.
The alist also always contains an entry with key `patch'.
This contains the patch extracted from PATCH-STRING.
If there is text in PATCH-STRING occurring before the actual hunks but
after the commit message, separated from the latter with a line
consisting of three hyphens, then that extra text is included in this
alist entry. (This space between the line of three hyphens and the
hunks is conventionally used for a diffstat, and/or additional
explanatory text submitted with the patch but not to be included in the
commit log message.)
The remaining entries in the alist correspond to the information
returned by git-mailinfo(1) on standard output. These specify the
authorship and date information for the commit, and sometimes the first
line of the commit message in an entry with key \"Subject\"."
(let ((input-file (make-nearby-temp-file "git-mailinfo-input"))
(msg-file (make-nearby-temp-file "git-mailinfo-msg"))
(patch-file (make-nearby-temp-file "git-mailinfo-patch"))
(coding-system-for-read (or coding-system-for-read
vc-git-log-output-coding-system))
res)
(unwind-protect
(with-temp-buffer
(let ((coding-system-for-write
;; Git expects Unix line endings here even on Windows.
(coding-system-change-eol-conversion
(or coding-system-for-write vc-git-commits-coding-system)
'unix)))
(with-temp-file input-file
(insert patch-string)))
(let ((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
coding-system-for-write)))
(vc-git--call input-file t "mailinfo" msg-file patch-file))
(goto-char (point-min))
;; git-mailinfo joins up any header continuation lines for us.
(while (re-search-forward "^\\([^\t\n\s:]+\\):\\(.*\\)$" nil t)
(push (cons (match-string 1) (string-trim (match-string 2)))
res))
(erase-buffer)
(insert-file-contents-literally patch-file)
(push (cons 'patch (buffer-string)) res)
(erase-buffer)
(insert-file-contents-literally msg-file)
(push (cons 'message (string-trim (buffer-string))) res))
(dolist (file (list input-file msg-file patch-file))
(when (file-exists-p file)
(delete-file file))))
res))
(defun vc-git-checkin-patch (patch-string comment)
"Git-specific version of `vc-BACKEND-checkin-patch'."
(vc-git--checkin comment nil patch-string))
(let ((mailinfo (vc-git--mailinfo patch-string)))
(unless comment
(setq comment (if-let* ((subject (assoc "Subject" mailinfo)))
(format "Summary: %s\n\n%s"
(cdr subject)
(cdr (assq 'message mailinfo)))
(cdr (assq 'message mailinfo)))))
(when-let* ((date (assoc "Date" mailinfo)))
(setq comment (format "Date: %s\n%s" (cdr date) comment)))
(when-let* ((author (assoc "Author" mailinfo))
(email (assoc "Email" mailinfo)))
(setq comment (format "Author: %s <%s>\n%s"
(cdr author) (cdr email) comment)))
(vc-git--checkin comment nil (cdr (assq 'patch mailinfo)))))
(defun vc-git-checkin (files comment &optional _rev)
"Git-specific version of `vc-BACKEND-checkin'.
@ -2081,7 +2156,7 @@ Will not rewrite likely-public history; see option `vc-allow-rewriting-published
(defun vc-git-modify-change-comment (files rev comment)
(vc-git--assert-allowed-rewrite rev)
(when (zerop (vc-git--call nil "rev-parse" (format "%s^2" rev)))
(when (zerop (vc-git--call nil nil "rev-parse" (format "%s^2" rev)))
;; This amend! approach doesn't work for merge commits.
;; Error out now instead of leaving an amend! commit hanging.
(error "Cannot modify merge commit comments"))
@ -2286,7 +2361,7 @@ In other modes, call `vc-deduce-fileset' to determine files to stash."
(interactive "sStash name: ")
(let ((root (vc-git-root default-directory)))
(when root
(apply #'vc-git--call nil "stash" "push" "-m" name
(apply #'vc-git--call nil nil "stash" "push" "-m" name
(vc-git--deduce-files-for-stash))
(vc-resynch-buffer root t t))))
@ -2353,7 +2428,7 @@ In `vc-dir-mode', if there are files marked, stash the changes to those.
If no files are marked, stash all uncommitted changes to tracked files.
In other modes, call `vc-deduce-fileset' to determine files to stash."
(interactive)
(apply #'vc-git--call nil "stash" "push" "-m"
(apply #'vc-git--call nil nil "stash" "push" "-m"
(format-time-string "Snapshot on %Y-%m-%d at %H:%M")
(vc-git--deduce-files-for-stash))
(vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" "stash@{0}")
@ -2543,9 +2618,9 @@ The difference to `vc-do-command' is that this function always invokes
(defun vc-git--empty-db-p ()
"Check if the git db is empty (no commit done yet)."
(let (process-file-side-effects)
(not (eq 0 (vc-git--call nil "rev-parse" "--verify" "HEAD")))))
(not (zerop (vc-git--call nil nil "rev-parse" "--verify" "HEAD")))))
(defun vc-git--call (buffer command &rest args)
(defun vc-git--call (infile buffer command &rest args)
;; We don't need to care the arguments. If there is a file name, it
;; is always a relative one. This works also for remote
;; directories. We enable `inhibit-null-byte-detection', otherwise
@ -2565,12 +2640,13 @@ The difference to `vc-do-command' is that this function always invokes
,@(when revert-buffer-in-progress
'("GIT_OPTIONAL_LOCKS=0")))
process-environment)))
(apply #'process-file vc-git-program nil buffer nil "--no-pager" command args)))
(apply #'process-file vc-git-program infile buffer nil
"--no-pager" command args)))
(defun vc-git--out-ok (command &rest args)
"Run `git COMMAND ARGS...' and insert standard output in current buffer.
Return whether the process exited with status zero."
(zerop (apply #'vc-git--call '(t nil) command args)))
(zerop (apply #'vc-git--call nil '(t nil) command args)))
(defun vc-git--out-str (command &rest args)
"Run `git COMMAND ARGS...' and return standard output as a string.

12
lisp/vc/vc-hg.el
View file

@ -1215,13 +1215,13 @@ It is based on `log-edit-mode', and has Hg-specific extensions.")
(defun vc-hg--checkin (comment &optional files patch-string)
"Workhorse routine for `vc-hg-checkin' and `vc-hg-checkin-patch'.
COMMENT is the commit message.
COMMENT is the commit message; nil if it should come from PATCH-STRING.
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-hg--checkin'"))
(let* ((args (vc-hg--extract-headers comment))
(let* ((args (and comment (vc-hg--extract-headers comment)))
(temps-dir (or (file-name-directory (or (car files)
default-directory))
default-directory))
@ -1231,7 +1231,7 @@ It is an error to supply both or neither."
;; must be in the system codepage, and therefore might not
;; support non-ASCII characters in the log message.
;; Also handle remote files.
(and (eq system-type 'windows-nt)
(and args (eq system-type 'windows-nt)
(let ((default-directory temps-dir))
(make-nearby-temp-file "hg-msg"))))
(patch-file (and patch-string
@ -1252,9 +1252,9 @@ It is an error to supply both or neither."
(nconc (if patch-file
(list "import" "--bypass" patch-file)
(list "commit" "-A"))
(if msg-file
(cl-list* "-l" (file-local-name msg-file) (cdr args))
(cl-list* "-m" args))))
(cond (msg-file (cl-list* "-l" (file-local-name msg-file)
(cdr args)))
(args (cons "-m" args)))))
(post (lambda ()
(when (and msg-file (file-exists-p msg-file))
(delete-file msg-file))

34
lisp/vc/vc.el
View file

@ -269,8 +269,15 @@
;;
;; - checkin-patch (patch-string comment)
;;
;; Commit a single patch PATCH-STRING to this backend, bypassing
;; the changes in filesets. COMMENT is used as a check-in comment.
;; Commit a single patch PATCH-STRING to this backend, bypassing any
;; changes to the fileset. COMMENT is used as a check-in comment.
;; If PATCH-STRING contains authorship and date information in a
;; format commonly used with the backend, it should be used as the
;; commit authorship identity and date; in particular, this should
;; always occur if PATCH-STRING was generated by the backend's
;; prepare-patch function (see below). Similarly, if COMMENT is nil
;; and PATCH-STRING contains a log message, that log message should be
;; used as the check-in comment.
;;
;; * find-revision (file rev buffer)
;;
@ -669,7 +676,9 @@
;; `:body-start' and `:body-end' demarcating what part of said
;; buffer should be inserted into an inline patch. If the two last
;; properties are omitted, `point-min' and `point-max' will
;; respectively be used instead.
;; respectively be used instead. If supported by the backend, the
;; patch should contain authorship identity and date information, and
;; REV's log message.
;;
;; - clone (remote directory rev)
;;
@ -2083,10 +2092,23 @@ have changed; continue with old fileset?" (current-buffer))))
backend
patch-string)))
(declare-function diff-bounds-of-hunk "diff-mode")
(defun vc-default-checkin-patch (_backend patch-string comment)
(pcase-let* ((`(,backend ,files) (with-temp-buffer
(insert patch-string)
(diff-vc-deduce-fileset)))
(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)

129
test/lisp/vc/vc-tests/vc-tests.el
View file

@ -783,6 +783,120 @@ This checks also `vc-backend' and `vc-responsible-backend'."
(ignore-errors
(run-hooks 'vc-test--cleanup-hook)))))))
(declare-function vc-hg-command "vc-hg")
(declare-function vc-git--out-str "vc-git")
(defun vc-test--checkin-patch (backend)
"Test preparing and checking in patches."
(ert-with-temp-directory _tempdir
(let ((vc-handled-backends `(,backend))
(default-directory
(file-name-as-directory
(expand-file-name
(make-temp-name "vc-test") temporary-file-directory)))
(file "foo")
(author "VC user <vc@example.org>")
(date "Fri, 19 Sep 2025 15:00:00 +0100")
(desc1 "Make a modification")
(desc2 "Make a modification redux")
vc-test--cleanup-hook buf)
(vc-test--with-author-identity backend
(unwind-protect
(cl-flet
((get-patch-string ()
"Get patch corresponding to most recent commit to FILE."
(let* ((rev (vc-call-backend backend 'working-revision file))
(patch (vc-call-backend backend 'prepare-patch rev)))
(with-current-buffer (plist-get patch :buffer)
(buffer-substring-no-properties (point-min)
(point-max)))))
(revert (msg)
"Make a commit reverting the most recent change to FILE."
(with-current-buffer buf
(undo-boundary)
(revert-buffer-quick)
(undo-boundary)
(undo)
(basic-save-buffer)
(vc-checkin (list file) backend)
(insert msg)
(let (vc-async-checkin)
(log-edit-done))))
(check (author date desc)
"Assert that most recent commit has AUTHOR, DATE and DESC."
(should
(equal
(string-trim-right
(cl-case backend
(Git
(vc-git--out-str "log" "-n1"
"--pretty=%an <%ae>%n%aD%n%B"))
(Hg
(with-output-to-string
(vc-hg-command standard-output 0 nil "log" "--limit=1"
"--template"
"{user}\n{date|rfc822date}\n{desc}")))))
(format "%s\n%s\n%s" author date desc)))))
;; (1) Cleanup.
(add-hook 'vc-test--cleanup-hook
(let ((dir default-directory))
(lambda ()
(delete-directory dir 'recursive))))
;; (2) Basic setup.
(make-directory default-directory)
(vc-test--create-repo-function backend)
(write-region "foo\n" nil file nil 'nomessage)
(vc-register `(,backend (,file)))
(setq buf (find-file-noselect file))
(with-current-buffer buf
(vc-checkin (list file) backend)
(insert "Initial commit")
(let (vc-async-checkin)
(log-edit-done)))
;; (3) Prepare a commit with a known Author & Date.
(with-current-buffer buf
(insert "bar\n")
(basic-save-buffer)
(vc-root-diff nil)
(vc-next-action nil)
(insert desc1)
(goto-char (point-min))
(insert (format "Author: %s\n" author))
(insert (format "Date: %s\n" date))
(let (vc-async-checkin)
(log-edit-done)))
;; (4) Revert it, then test applying it with
;; checkin-patch, passing nil as COMMENT. Should take the
;; author, date and comment from PATCH-STRING.
(let ((patch-string (get-patch-string)))
(revert "Revert modification, first time")
(vc-call-backend backend 'checkin-patch patch-string nil))
(check author date desc1)
;; (5) Revert it again and try applying it with
;; checkin-patch again, but passing non-nil COMMENT.
;; Should take the author, date but not the comment from
;; PATCH-STRING.
(let ((patch-string (get-patch-string)))
;; FIXME: We shouldn't need to branch here. Git should
;; update the working tree after making the commit.
(cl-case backend
(Git (with-current-buffer buf
(vc-checkin (list file) backend)
(insert "Revert modification, second time")
(let (vc-async-checkin)
(log-edit-done))))
(t (revert "Revert modification, second time")))
(vc-call-backend backend 'checkin-patch patch-string desc2))
(check author date desc2))
;; Save exit.
(ignore-errors
(run-hooks 'vc-test--cleanup-hook)))))))
;; Create the test cases.
(defun vc-test--rcs-enabled ()
@ -944,7 +1058,20 @@ This checks also `vc-backend' and `vc-responsible-backend'."
(version< (vc-git--program-version) "2.17")))
(let ((vc-hg-global-switches (cons "--config=extensions.share="
vc-hg-global-switches)))
(vc-test--other-working-trees ',backend)))))))
(vc-test--other-working-trees ',backend)))
(ert-deftest
,(intern (format "vc-test-%s08-checkin-patch" backend-string)) ()
,(format "Check preparing and checking in patches with the %s backend."
backend-string)
(skip-unless
(ert-test-passed-p
(ert-test-most-recent-result
(ert-get-test
',(intern
(format "vc-test-%s01-register" backend-string))))))
(skip-unless (memq ',backend '(Git Hg)))
(vc-test--checkin-patch ',backend))))))
(provide 'vc-tests)
;;; vc-tests.el ends here