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

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

[Sarah Morgensen]

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

[bug#49796] [PATCH 2/2] etc/committer: Pass command-line arguments to main.

[Sarah Morgensen]

* etc/committer.scm.in: Call main with command line arguments.
---
 etc/committer.scm.in | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index ec831643af..eaef759d81 100755
--- a/etc/committer.scm.in
+++ b/etc/committer.scm.in
@@ -382,4 +382,4 @@ modifying."
                  ;; insertions lead to offsets.
                  (new+old+hunks (diff-info)))))))
 
-(main)
+(apply main (cdr (command-line)))
-- 
2.31.1

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

[Sarah Morgensen]

Hi Ricardo,

I meant to X-Debbugs-CC you on this originally since it looks like
etc/committer.scm is mostly your work, but I forgot. Hope you don't mind
the ping.

Sarah Morgensen <iskarian@mgsn.dev> writes:

> 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

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

[Ludovic Courtès]

Hi Sarah,

Sarah Morgensen <iskarian@mgsn.dev> skribis:

> 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).

I’m not Ricardo :-) but the change makes sense to me, so I went ahead
and applied it.

Thank you!

Ludo’.