[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