From 8310795babf5699438b6ea416672194e4e0bb933 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 21 Sep 2025 21:39:42 +0100 Subject: [PATCH] VC checkin-patch: Support extracting commit metadata from patches * 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. --- lisp/vc/vc-git.el | 96 +++++++++++++++++++--- lisp/vc/vc-hg.el | 12 +-- lisp/vc/vc.el | 34 ++++++-- test/lisp/vc/vc-tests/vc-tests.el | 129 +++++++++++++++++++++++++++++- 4 files changed, 248 insertions(+), 23 deletions(-) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 8e0629a802a..868948c3a35 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -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. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 5c9df6bf287..ce1abbe3d88 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -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)) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index ee8d901e4b6..efb28501c21 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -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) diff --git a/test/lisp/vc/vc-tests/vc-tests.el b/test/lisp/vc/vc-tests/vc-tests.el index c9e2a4cac09..26da67e20aa 100644 --- a/test/lisp/vc/vc-tests/vc-tests.el +++ b/test/lisp/vc/vc-tests/vc-tests.el @@ -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 ") + (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