[bug#59318,v2] etc: committer: Add --package-directory and --help flags.

* etc/committer.scm.in (prepend-package-dir, show-help): New procedures.
(change-commit-message, add-commit-message, remove-commit-message,
custom-commit-message): Use prepend-package-dir.
(diff-info): Use the %package-dir parameter.
(main): Use SRFI-37 argument parser.
---
 etc/committer.scm.in | 54 +++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 48 insertions(+), 6 deletions(-)

Am Donnerstag, dem 30.03.2023 um 04:55 +0000 schrieb Antero Mejr:
> * etc/committer.scm.in (prepend-package-dir, show-help): New
> procedures.
> (change-commit-message, add-commit-message, remove-commit-message,
> custom-commit-message): Use prepend-package-dir.
> (diff-info): Use the %package-dir parameter.
> (main): Use SRFI-37 argument parser.
> ---
>  etc/committer.scm.in | 54 +++++++++++++++++++++++++++++++++++++++---
> --
>  1 file changed, 48 insertions(+), 6 deletions(-)
> 
> diff --git a/etc/committer.scm.in b/etc/committer.scm.in
> index e7f1ca8c45..44e9e3cef9 100755
> --- a/etc/committer.scm.in
> +++ b/etc/committer.scm.in
> @@ -7,6 +7,7 @@
>  ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
>  ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
>  ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
> +;;; Copyright © 2023 Antero Mejr <antero@mailbox.org>
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -35,13 +36,15 @@
>               (srfi srfi-9)
>               (srfi srfi-11)
>               (srfi srfi-26)
> +             (srfi srfi-37)
>               (ice-9 format)
>               (ice-9 popen)
>               (ice-9 match)
>               (ice-9 rdelim)
>               (ice-9 regex)
>               (ice-9 textual-ports)
> -             (guix gexp))
> +             (guix gexp)
> +             (guix scripts))
>  
>  (define* (break-string str #:optional (max-line-length 70))
>    "Break the string STR into lines that are no longer than MAX-LINE-
> LENGTH.
> @@ -138,7 +141,7 @@ (define (diff-info)
>                            ;; new definitions with changes to
> existing
>                            ;; definitions.
>                            "--unified=1"
> -                          "--" "gnu")))
> +                          "--" (%package-dir))))
>      (define (extract-line-number line-tag)
>        (abs (string->number
>              (car (string-split line-tag #\,)))))
> @@ -221,6 +224,9 @@ (define (new-sexp hunk)
>                          (+ (lines-to-first-change hunk)
>                             (hunk-new-line-number hunk))))))
>  
> +(define (prepend-package-dir msg)
> +  (format #f "~a: ~a" (%package-dir) msg))
> +
>  (define* (change-commit-message file-name old new #:optional (port
> (current-output-port)))
>    "Print ChangeLog commit message for changes between OLD and NEW."
>    (define (get-values expr field)
> @@ -247,7 +253,8 @@ (define version
>      (and=> ((xpath:sxpath '(// version *any*)) new)
>             first))
>    (format port
> -          "gnu: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%"
> +          (prepend-package-dir
> +           "~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%")
>            variable-name version file-name variable-name version)
>    (for-each (lambda (field)
>                (let ((old-values (get-values old field))
> @@ -276,14 +283,15 @@ (define* (add-commit-message file-name
> variable-name
>                               #:optional (port (current-output-
> port)))
>    "Print ChangeLog commit message for a change to FILE-NAME adding a
>  definition."
> -  (format port "gnu: Add ~a.~%~%* ~a (~a): New variable.~%"
> +  (format port (prepend-package-dir "Add ~a.~%~%* ~a (~a): New
> variable.~%")
>            variable-name file-name variable-name))
>  
>  (define* (remove-commit-message file-name variable-name
>                                  #:optional (port (current-output-
> port)))
>    "Print ChangeLog commit message for a change to FILE-NAME removing
> a
>  definition."
> -  (format port "gnu: Remove ~a.~%~%* ~a (~a): Delete variable.~%"
> +  (format port (prepend-package-dir
> +                "Remove ~a.~%~%* ~a (~a): Delete variable.~%")
>            variable-name file-name variable-name))
>  
>  (define* (custom-commit-message file-name variable-name message
> changelog
> @@ -301,7 +309,8 @@ (define (changelog-has-location? changelog)
>  
>    (let* ((message (trim message))
>           (changelog (if changelog (trim changelog) message))
> -         (message/f (format #f "gnu: ~a: ~a." variable-name
> message))
> +         (message/f (format #f (prepend-package-dir "~a: ~a.")
> +                            variable-name message))
>           (changelog/f (if (changelog-has-location? changelog)
>                            (format #f "* ~a (~a)~a."
>                                    file-name variable-name changelog)
> @@ -348,7 +357,40 @@ (define (new+old+hunks hunks)
>  
>  (define %delay 1000)
>  
> +;;;
> +;;; Command line options.
> +;;;
> +
> +(define (show-help)
> +  (display "Usage: committer.scm
> +Git commit unstaged package definition changes.\n")
> +  (display "
> +-p, --package-dir=DIR  specify the name of the package directory,
> +                       which is \"gnu\" by default.")
I'd use full nouns here, i.e. "--package-directory=DIRECTORY".  For the
help, something along the lines of 
"indicate, that the changes affect DIRECTORY (default: \"gnu\")" should
be a little clearer. 
> +  (newline)
> +  (display "-h, --help             display this help and exit")
> +  (newline))
> +
> +(define %options
> +  ;; Specification of the command-line options.
> +  (list (option '(#\p "package-dir") #t #f
> +                (lambda (opt name arg result)
> +                  (alist-cons 'package-dir arg result)))
> +        (option '(#\h "help") #f #f
> +                (lambda args
> +                  (show-help)
> +                  (exit 0)))))
> +
> +(define %default-options
> +  ;; Alist of default option values.
> +  '((package-dir . "gnu")))
> +
> +(define %package-dir (make-parameter #f))
> +
>  (define (main . args)
> +  (define opts (parse-command-line args %options (list %default-
> options)))
> +  (%package-dir (assoc-ref opts 'package-dir))
> +
>    (define* (change-commit-message* file-name old new #:rest rest)
>      (let ((changelog #f))
>        (match args
Cheers