TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
1 changed files with 40 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
etc/committer.scm.in
View File

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