aboutsummaryrefslogtreecommitdiff
path: root/etc
diff options
context:
space:
mode:
authorSarah Morgensen <iskarian@mgsn.dev>2021-07-31 14:00:42 -0700
committerLudovic Courtès <ludo@gnu.org>2021-08-10 17:32:19 +0200
commit73177859bc271e65c7d3c0a44dd7d5103ed8a6db (patch)
treeeb521730af6e382861f86c03cd1ba215ce2bd8c9 /etc
parent75e117bac713134c060b1276849cc1c8cd6ae183 (diff)
etc/committer: Support custom commit messages.
Allow custom change commit messages by supplying a commit message and optionally a changelog message as arguments. * etc/committer.scm.in (break-string-with-newlines) (custom-commit-message): New procedures. (main)[change-commit-message*]: New sub-procedure. Use them. (main): Use it. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Diffstat (limited to 'etc')
-rwxr-xr-xetc/committer.scm.in55
1 files changed, 49 insertions, 6 deletions
diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index 5696df8b8e..16f21f63b9 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,6 +37,7 @@
(ice-9 popen)
(ice-9 match)
(ice-9 rdelim)
+ (ice-9 regex)
(ice-9 textual-ports)
(guix gexp))
@@ -66,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."
@@ -253,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."
@@ -281,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)))
@@ -326,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")))))