[bug#59318] [PATCH] etc: committer: Add --package-directory flag.

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

* etc/committer.scm.in (main)[pkg-dir]: New variable.
(main): Use it.
(diff-info)[package-dir]: New argument.
(change-commit-message)[package-dir]: New argument.
(add-commit-message)[package-dir]: New argument.
(remove-commit-message)[package-dir]: New argument.
(custom-commit-message)[package-dir]: New argument.
---
Make the hard-coded "gnu" part of the package directory path into a flag.
This allows committer.scm to be used for channels where the package directory
is not "gnu".

 etc/committer.scm.in | 46 +++++++++++++++++++++++++++-----------------
 1 file changed, 28 insertions(+), 18 deletions(-)

diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index e7f1ca8c45..13021891aa 100755
--- a/etc/committer.scm.in
+++ b/etc/committer.scm.in
@@ -129,7 +129,7 @@ (define* (hunk->patch hunk #:optional (port (current-output-port)))
             file-name file-name file-name file-name
             (string-join (hunk-diff-lines hunk) ""))))
 
-(define (diff-info)
+(define (diff-info package-dir)
   "Read the diff and return a list of <hunk> values."
   (let ((port (open-pipe* OPEN_READ
                           "git" "diff-files"
@@ -138,7 +138,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,7 +221,8 @@ (define (new-sexp hunk)
                         (+ (lines-to-first-change hunk)
                            (hunk-new-line-number hunk))))))
 
-(define* (change-commit-message file-name old new #:optional (port (current-output-port)))
+(define* (change-commit-message file-name old new package-dir
+                                #:optional (port (current-output-port)))
   "Print ChangeLog commit message for changes between OLD and NEW."
   (define (get-values expr field)
     (match ((xpath:sxpath `(// ,field quasiquote *)) expr)
@@ -247,8 +248,8 @@ (define version
     (and=> ((xpath:sxpath '(// version *any*)) new)
            first))
   (format port
-          "gnu: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%"
-          variable-name version file-name variable-name version)
+          "~a: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%"
+          package-dir variable-name version file-name variable-name version)
   (for-each (lambda (field)
               (let ((old-values (get-values old field))
                     (new-values (get-values new field)))
@@ -272,21 +273,22 @@ (define version
                                           (listify added))))))))))
             '(inputs propagated-inputs native-inputs)))
 
-(define* (add-commit-message file-name variable-name
+(define* (add-commit-message file-name variable-name package-dir
                              #: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.~%"
-          variable-name file-name variable-name))
+  (format port "~a: Add ~a.~%~%* ~a (~a): New variable.~%"
+          package-dir variable-name file-name variable-name))
 
-(define* (remove-commit-message file-name variable-name
+(define* (remove-commit-message file-name variable-name package-dir
                                 #: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.~%"
-          variable-name file-name variable-name))
+  (format port "~a: Remove ~a.~%~%* ~a (~a): Delete variable.~%"
+          package-dir variable-name file-name variable-name))
 
 (define* (custom-commit-message file-name variable-name message changelog
+                                package-dir
                                 #: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
@@ -301,7 +303,7 @@ (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 "~a: ~a: ~a." package-dir variable-name message))
          (changelog/f (if (changelog-has-location? changelog)
                           (format #f "* ~a (~a)~a."
                                   file-name variable-name changelog)
@@ -349,16 +351,23 @@ (define (new+old+hunks hunks)
 (define %delay 1000)
 
 (define (main . args)
+  (define pkg-dir
+    (match args
+      (("--package-directory" pkg-dir ...)
+       (begin (set! args (cddr args))
+              (car pkg-dir)))
+      (_ "gnu")))
+
   (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))
+                file-name (second old) message changelog pkg-dir rest))
         (_
-         (apply change-commit-message file-name old new rest)))))
+         (apply change-commit-message file-name old new pkg-dir rest)))))
 
-  (match (diff-info)
+  (match (diff-info pkg-dir)
     (()
      (display "Nothing to be done.\n" (current-error-port)))
     (hunks
@@ -373,7 +382,7 @@ (define* (change-commit-message* file-name old new #:rest rest)
                      (commit-message-proc (match (hunk-type hunk)
                                             ('addition add-commit-message)
                                             ('removal remove-commit-message))))
-            (commit-message-proc (hunk-file-name hunk) variable-name)
+            (commit-message-proc (hunk-file-name hunk) variable-name pkg-dir)
             (let ((port (open-pipe* OPEN_WRITE
                                     "git" "apply"
                                     "--cached"
@@ -383,7 +392,8 @@ (define* (change-commit-message* file-name old new #:rest rest)
                 (error "Cannot apply")))
 
             (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
-              (commit-message-proc (hunk-file-name hunk) variable-name port)
+              (commit-message-proc (hunk-file-name hunk) variable-name pkg-dir
+                                   port)
               (usleep %delay)
               (unless (eqv? 0 (status:exit-val (close-pipe port)))
                 (error "Cannot commit"))))
@@ -423,6 +433,6 @@ (define copyright-line
                (error "Cannot commit")))))))
       ;; XXX: we recompute the hunks here because previous
       ;; insertions lead to offsets.
-      (new+old+hunks (diff-info))))))
+      (new+old+hunks (diff-info pkg-dir))))))
 
 (apply main (cdr (command-line)))
-- 
2.38.1