etc: Break long lines in commit messages.

* etc/committer.scm.in (break-string): New procedure.
(change-commit-message): Use it.
This commit is contained in:
Ricardo Wurmus 2021-05-04 11:49:07 +02:00
parent 7694acebd1
commit 570b3d32b9
No known key found for this signature in database
GPG key ID: 197A5888235FACAC

View file

@ -38,6 +38,33 @@
(ice-9 rdelim) (ice-9 rdelim)
(ice-9 textual-ports)) (ice-9 textual-ports))
(define* (break-string str #:optional (max-line-length 70))
"Break the string STR into lines that are no longer than MAX-LINE-LENGTH.
Return a single string."
(define (restore-line words)
(string-join (reverse words) " "))
(if (<= (string-length str) max-line-length)
str
(let ((words+lengths (map (lambda (word)
(cons word (string-length word)))
(string-tokenize str))))
(match (fold (match-lambda*
(((word . length)
(count current lines))
(let ((new-count (+ count length 1)))
(if (< new-count max-line-length)
(list new-count
(cons word current)
lines)
(list length
(list word)
(cons (restore-line current) lines))))))
'(0 () ())
words+lengths)
((_ last-words lines)
(string-join (reverse (cons (restore-line last-words) lines))
"\n"))))))
(define (read-excursion port) (define (read-excursion port)
"Read an expression from PORT and reset the port position before returning "Read an expression from PORT and reset the port position before returning
the expression." the expression."
@ -204,18 +231,19 @@ (define version
(added (lset-difference equal? new-values old-values))) (added (lset-difference equal? new-values old-values)))
(format port (format port
"[~a]: ~a~%" field "[~a]: ~a~%" field
(match (list (map symbol->string removed) (break-string
(map symbol->string added)) (match (list (map symbol->string removed)
((() added) (map symbol->string added))
(format #f "Add ~a." ((() added)
(listify added))) (format #f "Add ~a."
((removed ()) (listify added)))
(format #f "Remove ~a." ((removed ())
(listify removed))) (format #f "Remove ~a."
((removed added) (listify removed)))
(format #f "Remove ~a; add ~a." ((removed added)
(listify removed) (format #f "Remove ~a; add ~a."
(listify added))))))))) (listify removed)
(listify added))))))))))
'(inputs propagated-inputs native-inputs))) '(inputs propagated-inputs native-inputs)))
(define* (add-commit-message file-name variable-name #:optional (port (current-output-port))) (define* (add-commit-message file-name variable-name #:optional (port (current-output-port)))