etc/committer: Do not recompute changes when there are no definitions.

* etc/committer.scm.in (main): Reuse previously computed changes if there are
no changes to the number of definitions.
This commit is contained in:
Ricardo Wurmus 2023-09-21 16:00:24 +02:00
parent 0792d99466
commit 0836af9a3b
No known key found for this signature in database
GPG key ID: 197A5888235FACAC

View file

@ -388,41 +388,46 @@ (define* (change-commit-message* file-name old new #:rest rest)
(unless (eqv? 0 (status:exit-val (close-pipe port))) (unless (eqv? 0 (status:exit-val (close-pipe port)))
(error "Cannot commit")))) (error "Cannot commit"))))
(usleep %delay)) (usleep %delay))
definitions)) definitions)
;; Changes. ;; Changes.
(for-each (for-each
(match-lambda (match-lambda
((new old . hunks) ((new old . hunks)
(for-each (lambda (hunk) (for-each (lambda (hunk)
(let ((port (open-pipe* OPEN_WRITE (let ((port (open-pipe* OPEN_WRITE
"git" "apply" "git" "apply"
"--cached" "--cached"
"--unidiff-zero"))) "--unidiff-zero")))
(hunk->patch hunk port) (hunk->patch hunk port)
(unless (eqv? 0 (status:exit-val (close-pipe port))) (unless (eqv? 0 (status:exit-val (close-pipe port)))
(error "Cannot apply"))) (error "Cannot apply")))
(usleep %delay)) (usleep %delay))
hunks) hunks)
(define copyright-line (define copyright-line
(any (lambda (line) (and=> (string-prefix? "+;;; Copyright ©" line) (any (lambda (line) (and=> (string-prefix? "+;;; Copyright ©" line)
(const line))) (const line)))
(hunk-diff-lines (first hunks)))) (hunk-diff-lines (first hunks))))
(cond (cond
(copyright-line (copyright-line
(add-copyright-line copyright-line)) (add-copyright-line copyright-line))
(else (else
(let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-"))) (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
(change-commit-message* (hunk-file-name (first hunks)) (change-commit-message* (hunk-file-name (first hunks))
old new) old new)
(change-commit-message* (hunk-file-name (first hunks)) (change-commit-message* (hunk-file-name (first hunks))
old new old new
port) port)
(usleep %delay) (usleep %delay)
(unless (eqv? 0 (status:exit-val (close-pipe port))) (unless (eqv? 0 (status:exit-val (close-pipe port)))
(error "Cannot commit"))))))) (error "Cannot commit")))))))
;; XXX: we recompute the hunks here because previous (new+old+hunks (match definitions
;; insertions lead to offsets. ('() changes) ;reuse
(new+old+hunks (diff-info)))))) (_
;; XXX: we recompute the hunks here because previous
;; insertions lead to offsets.
(let-values (((definitions changes)
(partition hunk-type (diff-info))))
changes)))))))))
(apply main (cdr (command-line))) (apply main (cdr (command-line)))