Subject: bug#64055: Implementation of modifying VC change comments for Git

From: Sean Whitton <[email-masked]>
Date: Sun, 20 Oct 2024 13:19:09 +0800

Hello,

On Sat 19 Oct 2024 at 01:28pm +03, Eli Zaretskii wrote:

>> From: Sean Whitton <[email-masked]>
>> Cc: Dmitry Gutov <[email-masked]>, Morgan Smith <[email-masked]>
>> Date: Fri, 18 Oct 2024 17:26:28 +0800
>>
>> This patch is the rest of this feature.  Eli, would you kindly test on
>> MS-Windows, please?  Just try to edit the message for an unpushed git
>> commit and add some Unicode, and see if it works correctly.
>
> I'm supposed to type 'e' in the log buffer, edit the comment, then
> type "C-c C-c"?

Yeah, that's right.

> When I do the above, I get an error message:
>
>   vc-do-command: Failed (status 128): git --no-pager commit --only
> --allow-empty -F c:/Users/EliZ/AppData/Local/Temp/git-msgWaNflu
>
> and the *vc* buffer says:
>
>   fatal: No paths with --include/--only does not make sense.
>
> It's possible my Git is very old, but shouldn't this command work with
> old versions as well?

I've looked into it and what's required is Git 2.11.1 from early 2017.

I think we can support older by stashing and unstashing.  So please try
the attached patch, which does that.

-- 
Sean Whitton
>From 3ab65121d229e64915c7b4c89fe53f80cb34ebff Mon Sep 17 00:00:00 2001
From: Sean Whitton <[email-masked]>
Date: Fri, 18 Oct 2024 17:19:45 +0800
Subject: [PATCH v2] Support modifying VC change comments for Git

* lisp/vc/vc-git.el (vc-git-allow-rewriting-history): New option.
(vc-git--assert-allowed-rewrite, vc-git-modify-change-comment):
New functions (bug#64055).

(vc-git--current-branch): Factor out of vc-git-dir--branch-headers.
(vc-git--log-edit-extract-headers): Factor out of vc-git-checkin.

* etc/NEWS: Announce the new support and option.
---
 etc/NEWS          |  15 +++++
 lisp/vc/vc-git.el | 167 ++++++++++++++++++++++++++++++++++++++--------
 2 files changed, 154 insertions(+), 28 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 10d86173235..d2e72bc537a 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -568,6 +568,21 @@ a desktop notification when the song changes, using
 customized using the new user options 'mpc-notifications-title' and
 'mpc-notifications-body'.
 
+** VC
+
+---
+*** Using 'e' from Log View mode to modify change comments now works for Git.
+
+---
+*** New user option 'vc-git-allow-rewriting-history'.
+Many Git commands can change your copy of published change history
+without warning.  If VC commands detect that this could happen, they
+will stop.  You can customize this variable to permit rewriting history
+even though Emacs thinks it is dangerous.
+
+So far, this applies only to the 'log-view-modify-change-comment'
+command.
+
 
 * New Modes and Packages in Emacs 31.1
 
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index f77bf0cc5ff..59d5386bc72 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -252,6 +252,27 @@ vc-git-revision-complete-only-branches
   :type 'boolean
   :version "28.1")
 
+;; The default is nil because only a VC user who also possesses a lot of
+;; Git-specific knowledge can know when it is okay to rewrite history,
+;; and we can't convey to a relatively Git-naïve user the potential
+;; risks in only the space of a minibuffer y/n prompt.
+(defcustom vc-git-allow-rewriting-history nil
+  "When non-nil, permit Git operations that may rewrite published history.
+
+Many Git commands can change your copy of published change history
+without warning.  If this occurs, you won't be able to pull and push in
+the ordinary way until you take special action.  See \"Recovering from
+Upstream Rebase\" in the Man page git-rebase(1).
+
+Normally, Emacs refuses to run Git commands that it thinks will rewrite
+published history.  If you customize this variable to a non-nil value,
+Emacs will instead prompt you to confirm that you really want to perform
+the rewrite.  A value of `no-ask' means to proceed with no prompting."
+  :type '(choice (const :tag "Don't allow" nil)
+                 (const :tag "Prompt to allow" t)
+                 (const :tag "Allow without prompting" no-ask))
+  :version "31.1")
+
 ;; History of Git commands.
 (defvar vc-git-history nil)
 
@@ -728,11 +749,13 @@ vc-git-dir-status-files
                                  :files files
                                  :update-function update-function)))
 
+(defun vc-git--current-branch ()
+  (vc-git--out-match '("symbolic-ref" "HEAD")
+                     "^\\(refs/heads/\\)?\\(.+\\)$" 2))
+
 (defun vc-git-dir--branch-headers ()
   "Return headers for branch-related information."
-  (let ((branch (vc-git--out-match
-                 '("symbolic-ref" "HEAD")
-                 "^\\(refs/heads/\\)?\\(.+\\)$" 2))
+  (let ((branch (vc-git--current-branch))
         tracking remote-url)
     (if branch
         (when-let ((branch-merge
@@ -1082,6 +1105,17 @@ vc-git-checkin-patch
 
 (autoload 'vc-switches "vc")
 
+(defun vc-git--log-edit-extract-headers (comment)
+  (cl-flet ((boolean-arg-fn (argument)
+              (lambda (v) (and (equal v "yes") (list argument)))))
+    (log-edit-extract-headers
+     `(("Author" . "--author")
+       ("Date" . "--date")
+       ("Amend" . ,(boolean-arg-fn "--amend"))
+       ("No-Verify" . ,(boolean-arg-fn "--no-verify"))
+       ("Sign-Off" . ,(boolean-arg-fn "--signoff")))
+     comment)))
+
 (defun vc-git-checkin (files comment &optional _rev)
   (let* ((file1 (or (car files) default-directory))
          (root (vc-git-root file1))
@@ -1180,31 +1214,23 @@ vc-git-checkin
               (vc-git-command nil 0 patch-file "apply" "--cached")
             (delete-file patch-file))))
       (when to-stash (vc-git--stash-staged-changes files)))
-    (cl-flet ((boolean-arg-fn
-               (argument)
-               (lambda (value) (when (equal value "yes") (list argument)))))
-      ;; When operating on the whole tree, better pass "-a" than ".", since "."
-      ;; fails when we're committing a merge.
-      (apply #'vc-git-command nil 0 (if (and only (not vc-git-patch-string)) files)
-             (nconc (if msg-file (list "commit" "-F"
-                                       (file-local-name msg-file))
-                      (list "commit" "-m"))
-                    (let ((args
-                           (log-edit-extract-headers
-                            `(("Author" . "--author")
-                              ("Date" . "--date")
-                              ("Amend" . ,(boolean-arg-fn "--amend"))
-                              ("No-Verify" . ,(boolean-arg-fn "--no-verify"))
-                              ("Sign-Off" . ,(boolean-arg-fn "--signoff")))
-                            comment)))
-                      (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)))
-                      args)
-                    (unless vc-git-patch-string
-                      (if only (list "--only" "--") '("-a"))))))
+    ;; When operating on the whole tree, better pass "-a" than ".",
+    ;; since "."  fails when we're committing a merge.
+    (apply #'vc-git-command nil 0
+           (if (and only (not vc-git-patch-string)) files)
+           (nconc (if msg-file (list "commit" "-F"
+                                     (file-local-name msg-file))
+                    (list "commit" "-m"))
+                  (let ((args
+                         (vc-git--log-edit-extract-headers comment)))
+                    (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)))
+                    args)
+                  (unless vc-git-patch-string
+                    (if only (list "--only" "--") '("-a")))))
     (if (and msg-file (file-exists-p msg-file)) (delete-file msg-file))
     (when to-stash
       (let ((cached (make-nearby-temp-file "git-cached")))
@@ -1960,6 +1986,91 @@ vc-git-get-change-comment
     (vc-git-command standard-output 1 nil
                     "log" "--max-count=1" "--pretty=format:%B" rev)))
 
+(defun vc-git--assert-allowed-rewrite (rev)
+  (when (and (not (eq vc-git-allow-rewriting-history 'no-ask))
+             ;; Check there is an upstream.
+             (with-temp-buffer
+               (vc-git--out-ok "config" "--get"
+                               (format "branch.%s.merge"
+                                       (vc-git--current-branch)))))
+    (let ((outgoing (split-string
+                     (with-output-to-string
+                       (vc-git-command standard-output 0 nil "log"
+                                       "--pretty=format:%H"
+                                       "@{upstream}..HEAD")))))
+      (unless (or (cl-member rev outgoing :test #'string-prefix-p)
+                  (and vc-git-allow-rewriting-history
+                       (yes-or-no-p
+                        (format
+"Commit %s looks to be published; are you sure you want to rewrite history?"
+                         rev))))
+        (user-error "Will not rewrite likely-public Git history")))))
+
+(defun vc-git-modify-change-comment (files rev comment)
+  (vc-git--assert-allowed-rewrite rev)
+  (let* ((args (delete "--amend"
+                       (vc-git--log-edit-extract-headers comment)))
+         (message (format "amend! %s\n\n%s" rev (pop args)))
+         (msg-file
+          ;; On MS-Windows, pass the message through a file, to work
+          ;; around how command line arguments must be in the system
+          ;; codepage, and therefore might not support non-ASCII.
+          ;;
+          ;; As our other arguments are static, we need not be concerned
+          ;; about the encoding of command line arguments in general.
+          ;; See `vc-git-checkin' for the more complex case.
+          (and (eq system-type 'windows-nt)
+               (let ((default-directory
+                      (or (file-name-directory (or (car files)
+                                                   default-directory))
+                          default-directory)))
+                 (make-nearby-temp-file "git-msg"))))
+         (nothing-staged
+          (zerop
+           (vc-git-command nil t nil "diff" "--cached" "--quiet"))))
+    ;; We want to do just
+    ;;
+    ;;     % git commit --only --allow-empty -m...
+    ;;     % git rebase --autostash --autosquash -i REV~1
+    ;;
+    ;; because the first command is guaranteed to create an empty commit
+    ;; regardless of the state of the index and working tree.  However,
+    ;; that requires git.git commit 319d835, released in Git 2.11.1.
+    ;; In order to support older Git we do this longer, slower sequence:
+    ;;
+    ;;     % git stash push
+    ;;     % git commit --allow-empty -m...
+    ;;     % git rebase --autosquash -i REV~1
+    ;;     % git stash pop
+    (unless nothing-staged
+      (vc-git-command nil 0 nil "stash" "push"))
+    (unwind-protect
+        (progn
+          (when (cl-intersection '("--author" "--date") args
+                                 :test #'string=)
+            ;; 'git rebase --autosquash' cannot alter authorship.
+            ;; See the description of --fixup in git-commit(1).
+            (error
+"Author: and Date: not supported when modifying existing commits"))
+          (when msg-file
+            (let ((coding-system-for-write
+                   (or coding-system-for-write
+                       vc-git-commits-coding-system)))
+              (write-region message nil msg-file)))
+          (apply #'vc-git-command nil 0 nil
+                 "commit" "--allow-empty"
+                 (nconc (if msg-file
+                            (list "-F" (file-local-name msg-file))
+                          (list "-m" message))
+                        args)))
+      (when (and msg-file (file-exists-p msg-file))
+        (delete-file msg-file)))
+    (with-environment-variables (("GIT_SEQUENCE_EDITOR" "true"))
+      (vc-git-command nil 0 nil "rebase" "--autosquash" "-i"
+                      (format "%s~1" rev)))
+    (unless nothing-staged
+      (vc-git-command nil 0 nil "stash" "pop" "--index"))))
+
 (defvar vc-git-extra-menu-map
   (let ((map (make-sparse-keymap)))
     (define-key map [git-grep]
-- 
2.45.2