Package: guix-patches;
Reported by: Antero Mejr <antero <at> mailbox.org>
Date: Wed, 16 Nov 2022 19:00:02 UTC
Severity: normal
Tags: moreinfo, patch
View this message in rfc822 format
From: Antero Mejr <antero <at> mailbox.org> To: 59318 <at> debbugs.gnu.org Cc: Antero Mejr <antero <at> mailbox.org> Subject: [bug#59318] [PATCH] etc: committer: Add --package-directory flag. Date: Wed, 16 Nov 2022 18:58:53 +0000
* 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.