* [bug#59318] [PATCH] etc: committer: Add --package-directory flag.
@ 2022-11-16 18:58 Antero Mejr via Guix-patches via
2022-11-17 12:27 ` Liliana Marie Prikler
` (2 more replies)
0 siblings, 3 replies; 6+ messages in thread
From: Antero Mejr via Guix-patches via @ 2022-11-16 18:58 UTC (permalink / raw)
To: 59318; +Cc: Antero Mejr
* 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
^ permalink raw reply related [flat|nested] 6+ messages in thread
* [bug#59318] [PATCH] etc: committer: Add --package-directory flag.
2022-11-16 18:58 [bug#59318] [PATCH] etc: committer: Add --package-directory flag Antero Mejr via Guix-patches via
@ 2022-11-17 12:27 ` Liliana Marie Prikler
2023-03-21 13:08 ` Maxim Cournoyer
2023-03-30 4:55 ` [bug#59318] [PATCH v2] etc: committer: Add --package-directory and --help flags Antero Mejr via Guix-patches via
2023-03-30 22:29 ` [bug#59318] [PATCH v3] " Antero Mejr via Guix-patches via
2 siblings, 1 reply; 6+ messages in thread
From: Liliana Marie Prikler @ 2022-11-17 12:27 UTC (permalink / raw)
To: Antero Mejr, 59318
Am Mittwoch, dem 16.11.2022 um 18:58 +0000 schrieb Antero Mejr:
> * 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.
This could be simplified to (diff-info, change-commit-message, ...):
Honour package-dir.
> ---
> 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".
Note that instead of forwarding as you did, you could also make
package-dir a parameter and (parameterize ) it. This has the advantage
that you don't need to forward it in places where it's not immediately
clear to be relevant.
>
> 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)
You're repeating the same work with each message style. IMHO it would
make more sense to have a procedure or syntax that prepends it instead.
> @@ -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")))
> +
Using a proper option grammar in combination with getopt-long is
probably a better idea ;)
> (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)))
Cheers
^ permalink raw reply [flat|nested] 6+ messages in thread
* [bug#59318] [PATCH] etc: committer: Add --package-directory flag.
2022-11-17 12:27 ` Liliana Marie Prikler
@ 2023-03-21 13:08 ` Maxim Cournoyer
0 siblings, 0 replies; 6+ messages in thread
From: Maxim Cournoyer @ 2023-03-21 13:08 UTC (permalink / raw)
To: Liliana Marie Prikler; +Cc: 59318, Antero Mejr
Hello Antero,
Liliana Marie Prikler <liliana.prikler@ist.tugraz.at> writes:
> Am Mittwoch, dem 16.11.2022 um 18:58 +0000 schrieb Antero Mejr:
>> * 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.
> This could be simplified to (diff-info, change-commit-message, ...):
> Honour package-dir.
>> ---
>> 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".
> Note that instead of forwarding as you did, you could also make
> package-dir a parameter and (parameterize ) it. This has the advantage
> that you don't need to forward it in places where it's not immediately
> clear to be relevant.
>>
>> 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)
> You're repeating the same work with each message style. IMHO it would
> make more sense to have a procedure or syntax that prepends it instead.
>> @@ -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")))
>> +
> Using a proper option grammar in combination with getopt-long is
> probably a better idea ;)
>> (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)))
> Cheers
Gentle ping :-). Could you please address the above review comments and
send a v2?
--
Thanks,
Maxim
^ permalink raw reply [flat|nested] 6+ messages in thread
* [bug#59318] [PATCH v2] etc: committer: Add --package-directory and --help flags.
2022-11-16 18:58 [bug#59318] [PATCH] etc: committer: Add --package-directory flag Antero Mejr via Guix-patches via
2022-11-17 12:27 ` Liliana Marie Prikler
@ 2023-03-30 4:55 ` Antero Mejr via Guix-patches via
2023-03-30 16:53 ` Liliana Marie Prikler
2023-03-30 22:29 ` [bug#59318] [PATCH v3] " Antero Mejr via Guix-patches via
2 siblings, 1 reply; 6+ messages in thread
From: Antero Mejr via Guix-patches via @ 2023-03-30 4:55 UTC (permalink / raw)
To: 59318; +Cc: liliana.prikler, maxim.cournoyer
* 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
^ permalink raw reply related [flat|nested] 6+ messages in thread
* [bug#59318] [PATCH v2] etc: committer: Add --package-directory and --help flags.
2023-03-30 4:55 ` [bug#59318] [PATCH v2] etc: committer: Add --package-directory and --help flags Antero Mejr via Guix-patches via
@ 2023-03-30 16:53 ` Liliana Marie Prikler
0 siblings, 0 replies; 6+ messages in thread
From: Liliana Marie Prikler @ 2023-03-30 16:53 UTC (permalink / raw)
To: Antero Mejr, 59318; +Cc: maxim.cournoyer
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
^ permalink raw reply [flat|nested] 6+ messages in thread
* [bug#59318] [PATCH v3] etc: committer: Add --package-directory and --help flags.
2022-11-16 18:58 [bug#59318] [PATCH] etc: committer: Add --package-directory flag Antero Mejr via Guix-patches via
2022-11-17 12:27 ` Liliana Marie Prikler
2023-03-30 4:55 ` [bug#59318] [PATCH v2] etc: committer: Add --package-directory and --help flags Antero Mejr via Guix-patches via
@ 2023-03-30 22:29 ` Antero Mejr via Guix-patches via
2 siblings, 0 replies; 6+ messages in thread
From: Antero Mejr via Guix-patches via @ 2023-03-30 22:29 UTC (permalink / raw)
To: 59318; +Cc: liliana.prikler, maxim.cournoyer
* 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.
---
v3: use/document the MESSAGE and CHANGELOG arguments and update wording.
etc/committer.scm.in | 67 ++++++++++++++++++++++++++++++++++++++------
1 file changed, 59 insertions(+), 8 deletions(-)
diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index e7f1ca8c45..dbc979a6f8 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,7 +224,11 @@ (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 (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)
(match ((xpath:sxpath `(// ,field quasiquote *)) expr)
@@ -247,7 +254,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 +284,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 +310,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,10 +358,51 @@ (define (new+old+hunks hunks)
(define %delay 1000)
+;;;
+;;; Command line options.
+;;;
+
+(define (show-help)
+ (display "Usage: committer.scm [OPTION] [MESSAGE] [CHANGELOG]
+Git commit unstaged package definition additions, removals, or changes.
+
+For changes, MESSAGE and CHANGELOG may be specified to set the message and
+body sections of the commit message, respectively.\n")
+ (display "
+-p, --package-directory=DIRECTORY search DIRECTORY for package definitions
+ (default: \"gnu\")")
+ (newline)
+ (display "
+-h, --help display this help and exit")
+ (newline))
+
+(define %options
+ ;; Specification of the command-line options.
+ (list (option '(#\p "package-directory") #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)
+ #:build-options? #f))
+ (%package-dir (assoc-ref opts 'package-dir))
+
(define* (change-commit-message* file-name old new #:rest rest)
(let ((changelog #f))
- (match args
+ (match (reverse (filter-map (match-lambda
+ (('argument . x) x)
+ (_ #f))
+ opts))
((or (message changelog) (message))
(apply custom-commit-message
file-name (second old) message changelog rest))
--
2.38.1
^ permalink raw reply related [flat|nested] 6+ messages in thread
end of thread, other threads:[~2023-03-30 22:30 UTC | newest]
Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-11-16 18:58 [bug#59318] [PATCH] etc: committer: Add --package-directory flag Antero Mejr via Guix-patches via
2022-11-17 12:27 ` Liliana Marie Prikler
2023-03-21 13:08 ` Maxim Cournoyer
2023-03-30 4:55 ` [bug#59318] [PATCH v2] etc: committer: Add --package-directory and --help flags Antero Mejr via Guix-patches via
2023-03-30 16:53 ` Liliana Marie Prikler
2023-03-30 22:29 ` [bug#59318] [PATCH v3] " Antero Mejr via Guix-patches via
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.