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

  • Open
  • quality assurance status badge
Details
4 participants
  • Antero Mejr
  • Liliana Marie Prikler
  • Liliana Marie Prikler
  • Maxim Cournoyer
Owner
unassigned
Submitted by
Antero Mejr
Severity
normal

Debbugs page

A
A
Antero Mejr wrote on 16 Nov 2022 10:58
(address . guix-patches@gnu.org)(name . Antero Mejr)(address . antero@mailbox.org)
20221116185853.13957-1-antero@mailbox.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(-)

Toggle diff (137 lines)
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
L
L
Liliana Marie Prikler wrote on 17 Nov 2022 04:27
5fea7098e0e3a0452d6f99a62a2ece83e93c640e.camel@ist.tugraz.at
Am Mittwoch, dem 16.11.2022 um 18:58 +0000 schrieb Antero Mejr:
Toggle quote (7 lines)
> * 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.
Toggle quote (5 lines)
> ---
> 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.
Toggle quote (100 lines)
>
>  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.
Toggle quote (11 lines)
> @@ -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 ;)
Toggle quote (54 lines)
>    (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
M
M
Maxim Cournoyer wrote on 21 Mar 2023 06:08
Re: bug#59318: [PATCH] etc: committer: Add --package-directory flag.
(name . Liliana Marie Prikler)(address . liliana.prikler@ist.tugraz.at)
87a606s14u.fsf_-_@gmail.com
Hello Antero,

Liliana Marie Prikler <liliana.prikler@ist.tugraz.at> writes:

Toggle quote (190 lines)
> 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
M
M
Maxim Cournoyer wrote on 21 Mar 2023 06:08
control message for bug #59318
(address . control@debbugs.gnu.org)
878rfqs14o.fsf@gmail.com
tags 59318 + moreinfo
quit
A
A
Antero Mejr wrote on 29 Mar 2023 21:55
[PATCH v2] etc: committer: Add --package-directory and --help flags.
(address . 59318@debbugs.gnu.org)
20230330045512.18858-1-antero@mailbox.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(-)

Toggle diff (129 lines)
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
L
L
Liliana Marie Prikler wrote on 30 Mar 2023 09:53
(address . maxim.cournoyer@gmail.com)
d08037ca57a5326cd2c4a86d20a80d1824834dc3.camel@gmail.com
Am Donnerstag, dem 30.03.2023 um 04:55 +0000 schrieb Antero Mejr:
Toggle quote (121 lines)
> * 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.
Toggle quote (28 lines)
> +  (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
A
A
Antero Mejr wrote on 30 Mar 2023 15:29
[PATCH v3] etc: committer: Add --package-directory and --help flags.
(address . 59318@debbugs.gnu.org)
20230330222924.11606-1-antero@mailbox.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.
---
v3: use/document the MESSAGE and CHANGELOG arguments and update wording.

etc/committer.scm.in | 67 ++++++++++++++++++++++++++++++++++++++------
1 file changed, 59 insertions(+), 8 deletions(-)

Toggle diff (144 lines)
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
?
Your comment

Commenting via the web interface is currently disabled.

To comment on this conversation send an email to 59318@patchwise.org

To respond to this issue using the mumi CLI, first switch to it
mumi current 59318
Then, you may apply the latest patchset in this issue (with sign off)
mumi am -- -s
Or, compose a reply to this issue
mumi compose
Or, send patches to this issue
mumi send-email *.patch