summaryrefslogtreecommitdiff
path: root/etc
diff options
context:
space:
mode:
authorMarius Bakke <marius@gnu.org>2021-08-12 00:30:27 +0200
committerMarius Bakke <marius@gnu.org>2021-08-12 00:30:27 +0200
commitc4133c43c7cfe2476ebfae87f9e4d10d96de9bc7 (patch)
tree47bd773d2f434384b54e56916c1a287dd8e51511 /etc
parentffa01e68859bb7a6daa9fcffdc8d77ca35db4bc0 (diff)
parent4eb0a5146ae5a195a29c79f586fcc1e58f7fa69b (diff)
Merge branch 'master' into core-updates-frozen
Conflicts: gnu/packages/algebra.scm gnu/packages/games.scm gnu/packages/golang.scm gnu/packages/kerberos.scm gnu/packages/mail.scm gnu/packages/python.scm gnu/packages/ruby.scm gnu/packages/scheme.scm gnu/packages/tex.scm gnu/packages/tls.scm gnu/packages/version-control.scm
Diffstat (limited to 'etc')
-rwxr-xr-xetc/committer.scm.in60
1 files changed, 52 insertions, 8 deletions
diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index 96cd1fbf0b..e81ce16611 100755
--- a/etc/committer.scm.in
+++ b/etc/committer.scm.in
@@ -4,6 +4,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -36,7 +37,9 @@
(ice-9 popen)
(ice-9 match)
(ice-9 rdelim)
- (ice-9 textual-ports))
+ (ice-9 regex)
+ (ice-9 textual-ports)
+ (guix gexp))
(define* (break-string str #:optional (max-line-length 70))
"Break the string STR into lines that are no longer than MAX-LINE-LENGTH.
@@ -65,6 +68,13 @@ Return a single string."
(string-join (reverse (cons (restore-line last-words) lines))
"\n"))))))
+(define* (break-string-with-newlines str #:optional (max-line-length 70))
+ "Break the lines of string STR into lines that are no longer than
+MAX-LINE-LENGTH. Return a single string."
+ (string-join (map (cut break-string <> max-line-length)
+ (string-split str #\newline))
+ "\n"))
+
(define (read-excursion port)
"Read an expression from PORT and reset the port position before returning
the expression."
@@ -252,6 +262,32 @@ corresponding to the top-level definition containing the staged changes."
"gnu: Add ~a.~%~%* ~a (~a): New variable.~%"
variable-name file-name variable-name))
+(define* (custom-commit-message file-name variable-name message changelog
+ #: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
+entry. If CHANGELOG is #f, the commit message is reused. If CHANGELOG already
+contains ': ', no colon is inserted between the location and body of the
+ChangeLog entry."
+ (define (trim msg)
+ (string-trim-right (string-trim-both msg) (char-set #\.)))
+
+ (define (changelog-has-location? changelog)
+ (->bool (string-match "^[[:graph:]]+:[[:blank:]]" changelog)))
+
+ (let* ((message (trim message))
+ (changelog (if changelog (trim changelog) message))
+ (message/f (format #f "gnu: ~a: ~a." variable-name message))
+ (changelog/f (if (changelog-has-location? changelog)
+ (format #f "* ~a (~a)~a."
+ file-name variable-name changelog)
+ (format #f "* ~a (~a): ~a."
+ file-name variable-name changelog))))
+ (format port
+ "~a~%~%~a~%"
+ (break-string-with-newlines message/f 72)
+ (break-string-with-newlines changelog/f 72))))
+
(define (group-hunks-by-sexp hunks)
"Return a list of pairs associating all hunks with the S-expression they are
modifying."
@@ -280,6 +316,15 @@ modifying."
(define %delay 1000)
(define (main . args)
+ (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))
+ (_
+ (apply change-commit-message file-name old new rest)))))
+
(match (diff-info)
(()
(display "Nothing to be done.\n" (current-error-port)))
@@ -325,13 +370,12 @@ modifying."
(error "Cannot apply")))
(usleep %delay))
hunks)
- (change-commit-message (hunk-file-name (first hunks))
- old new
- (current-output-port))
+ (change-commit-message* (hunk-file-name (first hunks))
+ old new)
(let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
- (change-commit-message (hunk-file-name (first hunks))
- old new
- port)
+ (change-commit-message* (hunk-file-name (first hunks))
+ old new
+ port)
(usleep %delay)
(unless (eqv? 0 (status:exit-val (close-pipe port)))
(error "Cannot commit")))))
@@ -339,4 +383,4 @@ modifying."
;; insertions lead to offsets.
(new+old+hunks (diff-info)))))))
-(main)
+(apply main (cdr (command-line)))