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

[Antero Mejr via Guix-patches via <guix-patches@gnu.org>]

* 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.")
+  (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
-- 
2.38.1