Subject: Re: bug#64055: [WIP Patch] Enable editing commit messages - vc-git-modify-change-comment

From: Sean Whitton <[email-masked]>
Date: Thu, 10 Oct 2024 10:39:12 +0800

Hello,

In Dmitry's patch he takes the approach of calling the
expanded-log-entry backend function to get the message to edit.
This is not a real VC backend function -- in fact it's a log-view
feature, log-view-expanded-log-entry-function.

So one thing we could do is add a VC backend action which returns just
the message text that a human might want to edit.
Probably a backend action called `get-change-comment'.

I think, though, that there might be subtle complexities there.  For
example, should there be a FILES argument, or just a REVISION argument?
For Git and Hg it's just REVISION, but we wouldn't want to bake that in.

I think, therefore, that the approach of parsing text out of the
log-view buffer is more future-proof, even though it's complex.
So please see the following WIP patch.
-- >8 --

---
 lisp/vc/log-view.el | 48 +++++++++++++++++++++++++++++++--------------
 lisp/vc/vc-git.el   |  9 +++++++++
 lisp/vc/vc-hg.el    |  8 ++++++++
 3 files changed, 50 insertions(+), 15 deletions(-)

diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index e9e6602e414..f2bfe642390 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -520,23 +520,41 @@ log-view-find-revision
                                         log-view-vc-backend))))

+(defun log-view--default-extract-comment-function ()
+  (when (memq log-view-vc-backend '(SCCS RCS CVS SVN))
+    (delete-region (pos-bol) (pos-bol 3)))
+  (goto-char (point-max))
+  (when (eq log-view-vc-backend 'SVN)
+    (delete-region (pos-bol 0) (point)))
+  (buffer-string))
+
+;; We want the possibility of something backend-specific here because
+;; there are all sorts of possibilities for how the comment needs to be
+;; extracted.  For example, if the user has customized a variable like
+;; `vc-git-log-switches' then that could change how to parse out the
+;; message in `vc-git-log-view-mode'.
+(defvar log-view-extract-comment-function
+  #'log-view--default-extract-comment-function
+  "Function to return the free text part of a Log View entry.
+`log-view-extract-comment' calls this with no arguments in a
+temporary buffer containing the full text of the Log View entry.
+The default value works for the SCCS, RCS, CVS and SVN backends.")
+
 (defun log-view-extract-comment ()
   "Parse comment from around the current point in the log."
-  (save-excursion
-    (let (st en (backend (vc-backend (log-view-current-file))))
-      (log-view-end-of-defun)
-      (cond ((eq backend 'SVN)
-	     (forward-line -1)))
-      (setq en (point))
-      (or (log-view-current-entry nil t)
-          (throw 'beginning-of-buffer nil))
-      (cond ((memq backend '(SCCS RCS CVS SVN))
-	     (forward-line 2))
-	    ((eq backend 'Hg)
-	     (forward-line 4)
-	     (re-search-forward "summary: *" nil t)))
-      (setq st (point))
-      (buffer-substring st en))))
+  (let* ((entry (or (log-view-current-entry)
+                    (throw 'beginning-of-buffer nil)))
+         (text (if log-view-expanded-log-entry-function
+                   (funcall log-view-expanded-log-entry-function
+                            (cadr entry))
+                 (save-excursion
+                   (goto-char (car entry))
+                   (log-view-end-of-defun)
+                   (buffer-substring (car entry) (point))))))
+    (with-temp-buffer
+      (insert text)
+      (goto-char (point-min))
+      (funcall log-view-extract-comment-function))))

 (declare-function vc-modify-change-comment "vc" (files rev oldcomment))

diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 05400523048..0af4e4e4600 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -1577,6 +1577,7 @@ log-view-file-re
 (defvar log-view-font-lock-keywords)
 (defvar log-view-per-file-logs)
 (defvar log-view-expanded-log-entry-function)
+(defvar log-view-extract-comment-function)

 (define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View"
   (require 'add-log) ;; We need the faces add-log.
@@ -1592,6 +1593,8 @@ vc-git-log-view-mode
     (setq truncate-lines t)
     (setq-local log-view-expanded-log-entry-function
                 'vc-git-expanded-log-entry))
+  (setq-local log-view-extract-comment-function
+              #'vc-git--extract-comment)
   (setq-local log-view-font-lock-keywords
        (if (not (memq vc-log-view-type '(long log-search with-diff)))
 	   (list (cons (nth 1 vc-git-root-log-format)
@@ -1650,6 +1653,12 @@ vc-git-expanded-log-entry
         (forward-line))
       (buffer-string))))

+(defun vc-git--extract-comment ()
+  (re-search-forward "^    " nil t)
+  (delete-region (point-min) (point))
+  ;; now deindent
+)
+
 (defun vc-git-region-history (file buffer lfrom lto)
   "Insert into BUFFER the history of FILE for lines LFROM to LTO.
 This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 876d86dc24f..9a9c9c41997 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -425,6 +425,7 @@ log-view-file-re
 (defvar log-view-font-lock-keywords)
 (defvar log-view-per-file-logs)
 (defvar log-view-expanded-log-entry-function)
+(defvar log-view-extract-comment-function)

 (define-derived-mode vc-hg-log-view-mode log-view-mode "Hg-Log-View"
   (require 'add-log) ;; we need the add-log faces
@@ -440,6 +441,8 @@ vc-hg-log-view-mode
     (setq truncate-lines t)
     (setq-local log-view-expanded-log-entry-function
                 'vc-hg-expanded-log-entry))
+  (setq-local log-view-extract-comment-function
+              #'vc-hg--extract-comment)
   (setq-local log-view-font-lock-keywords
        (if (eq vc-log-view-type 'short)
 	   (list (cons (nth 1 vc-hg-root-log-format)
@@ -541,6 +544,11 @@ vc-hg-expanded-log-entry
       (goto-char (point-max))
       (buffer-string))))

+(defun vc-hg--extract-comment ()
+  (forward-line 4)
+  (re-search-forward "summary: *" nil t)
+  (buffer-substring (point) (point-max)))
+
 (defun vc-hg-revision-table (files)
   (let ((default-directory (file-name-directory (car files))))
     (with-temp-buffer

-- 
Sean Whitton