[bug#49796] [PATCH 1/2] etc/committer: Support custom commit messages.

[Sarah Morgensen <iskarian@mgsn.dev>]

Allow custom change commit messages by supplying a commit message and
optionally a changelog message as arguments.

* etc/committer.scm.in (break-string-with-newlines)
(custom-commit-message): New procedures.
(main)[change-commit-message*]: New sub-procedure. Use them.
(main): Use it.
---
Hello Guix,

This allows supplying a commit message and optionally a ChangeLog message as
arguments to committer.scm, which will be used as the message(s) for changes
to definitions instead of "Update ..." Both support raw newlines, and if the
changelog message contains ": ", no extra colon is added to the ChangeLog
message (this is to support custom definition specifiers).

WDYT?

--
Sarah
 etc/committer.scm.in | 55 +++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 49 insertions(+), 6 deletions(-)

diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index 96cd1fbf0b..ec831643af 100755
--- a/etc/committer.scm.in
+++ b/etc/committer.scm.in
@@ -4,6 +4,7 @@
 
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -36,6 +37,7 @@
         (ice-9 popen)
         (ice-9 match)
         (ice-9 rdelim)
+        (ice-9 regex)
         (ice-9 textual-ports))
 
 (define* (break-string str #:optional (max-line-length 70))
@@ -65,6 +67,13 @@ Return a single string."
            (string-join (reverse (cons (restore-line last-words) lines))
                         "\n"))))))
 
+(define* (break-string-with-newlines str #:optional (max-line-length 70))
+  "Break the lines of string STR into lines that are no longer than
+MAX-LINE-LENGTH. Return a single string."
+  (string-join (map (cut break-string <> max-line-length)
+                    (string-split str #\newline))
+               "\n"))
+
 (define (read-excursion port)
   "Read an expression from PORT and reset the port position before returning
 the expression."
@@ -252,6 +261,32 @@ corresponding to the top-level definition containing the staged changes."
           "gnu: Add ~a.~%~%* ~a (~a): New variable.~%"
           variable-name file-name variable-name))
 
+(define* (custom-commit-message file-name variable-name message changelog
+                                #:optional (port (current-output-port)))
+  "Print custom commit message for a change to VARIABLE-NAME in FILE-NAME, using
+MESSAGE as the commit message and CHANGELOG as the body of the ChangeLog
+entry. If CHANGELOG is #f, the commit message is reused. If CHANGELOG already
+contains ': ', no colon is inserted between the location and body of the
+ChangeLog entry."
+  (define (trim msg)
+    (string-trim-right (string-trim-both msg) (char-set #\.)))
+
+  (define (changelog-has-location? changelog)
+    (->bool (string-match "^[[:graph:]]+:[[:blank:]]" changelog)))
+
+  (let* ((message (trim message))
+         (changelog (if changelog (trim changelog) message))
+         (message/f (format #f "gnu: ~a: ~a." variable-name message))
+         (changelog/f (if (changelog-has-location? changelog)
+                          (format #f "* ~a (~a)~a."
+                                  file-name variable-name changelog)
+                          (format #f "* ~a (~a): ~a."
+                                  file-name variable-name changelog))))
+    (format port
+            "~a~%~%~a~%"
+            (break-string-with-newlines message/f 72)
+            (break-string-with-newlines changelog/f 72))))
+
 (define (group-hunks-by-sexp hunks)
   "Return a list of pairs associating all hunks with the S-expression they are
 modifying."
@@ -280,6 +315,15 @@ modifying."
 (define %delay 1000)
 
 (define (main . args)
+  (define* (change-commit-message* file-name old new #:rest rest)
+    (let ((changelog #f))
+      (match args
+        ((or (message changelog) (message))
+         (apply custom-commit-message
+                file-name (second old) message changelog rest))
+        (_
+         (apply change-commit-message file-name old new rest)))))
+
   (match (diff-info)
     (()
      (display "Nothing to be done.\n" (current-error-port)))
@@ -325,13 +369,12 @@ modifying."
                                     (error "Cannot apply")))
                                 (usleep %delay))
                               hunks)
-                    (change-commit-message (hunk-file-name (first hunks))
-                                           old new
-                                           (current-output-port))
+                    (change-commit-message* (hunk-file-name (first hunks))
+                                            old new)
                     (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
-                      (change-commit-message (hunk-file-name (first hunks))
-                                             old new
-                                             port)
+                      (change-commit-message* (hunk-file-name (first hunks))
+                                              old new
+                                              port)
                       (usleep %delay)
                       (unless (eqv? 0 (status:exit-val (close-pipe port)))
                         (error "Cannot commit")))))

base-commit: daeef2e7f4f36df7a098c9aee7c03546d8691d39
-- 
2.31.1