etc/committer: Teach it how to commit package removal.
* etc/committer.scm.in (hunk-types): New variable. (<hunk>): Rename hunk-definition? getter to 'hunk-type'. (diff-info): Mute a git warning by separating file names from arguments with '--'. Rename the 'definitions?' variable to 'type'. Use the 'addition type when a new package addition is detected, 'removal when removed else #f. (add-commit-message): Re-indent. (remove-commit-message): New procedure. (main)[definitions]: Make commit message conditional depending on whether it is an addition or removal. [changes]: Adjust indentation.
Maxim Cournoyer
parent
6c956243bc
commit
5e6efdfeec
|
|
@ -101,12 +101,16 @@ LINE-NO in PORT."
|
|||
(read-line port)
|
||||
(loop (1- i) last-top-level-sexp))))))
|
||||
|
||||
;;; Whether the hunk contains a newly added package (definition), a removed
|
||||
;;; package (removal) or something else (#false).
|
||||
(define hunk-types '(addition removal #false))
|
||||
|
||||
(define-record-type <hunk>
|
||||
(make-hunk file-name
|
||||
old-line-number
|
||||
new-line-number
|
||||
diff-lines
|
||||
definition?)
|
||||
type)
|
||||
hunk?
|
||||
(file-name hunk-file-name)
|
||||
;; Line number before the change
|
||||
|
|
@ -115,8 +119,8 @@ LINE-NO in PORT."
|
|||
(new-line-number hunk-new-line-number)
|
||||
;; The full diff to be used with "git apply --cached"
|
||||
(diff-lines hunk-diff-lines)
|
||||
;; Does this hunk add a definition?
|
||||
(definition? hunk-definition?))
|
||||
;; Does this hunk add or remove a package?
|
||||
(type hunk-type)) ;one of 'hunk-types'
|
||||
|
||||
(define* (hunk->patch hunk #:optional (port (current-output-port)))
|
||||
(let ((file-name (hunk-file-name hunk)))
|
||||
|
|
@ -134,25 +138,30 @@ LINE-NO in PORT."
|
|||
;; new definitions with changes to existing
|
||||
;; definitions.
|
||||
"--unified=1"
|
||||
"gnu")))
|
||||
"--" "gnu")))
|
||||
(define (extract-line-number line-tag)
|
||||
(abs (string->number
|
||||
(car (string-split line-tag #\,)))))
|
||||
(define (read-hunk)
|
||||
(let loop ((lines '())
|
||||
(definition? #false))
|
||||
(type #false))
|
||||
(let ((line (read-line port 'concat)))
|
||||
(cond
|
||||
((eof-object? line)
|
||||
(values (reverse lines) definition?))
|
||||
(values (reverse lines) type))
|
||||
((or (string-prefix? "@@ " line)
|
||||
(string-prefix? "diff --git" line))
|
||||
(unget-string port line)
|
||||
(values (reverse lines) definition?))
|
||||
(values (reverse lines) type))
|
||||
(else
|
||||
(loop (cons line lines)
|
||||
(or definition?
|
||||
(string-prefix? "+(define" line))))))))
|
||||
(or type
|
||||
(cond
|
||||
((string-prefix? "+(define" line)
|
||||
'addition)
|
||||
((string-prefix? "-(define" line)
|
||||
'removal)
|
||||
(else #false)))))))))
|
||||
(define info
|
||||
(let loop ((acc '())
|
||||
(file-name #f))
|
||||
|
|
@ -167,13 +176,13 @@ LINE-NO in PORT."
|
|||
(match (string-split line #\space)
|
||||
((_ old-start new-start . _)
|
||||
(let-values
|
||||
(((diff-lines definition?) (read-hunk)))
|
||||
(((diff-lines type) (read-hunk)))
|
||||
(loop (cons (make-hunk file-name
|
||||
(extract-line-number old-start)
|
||||
(extract-line-number new-start)
|
||||
(cons (string-append line "\n")
|
||||
diff-lines)
|
||||
definition?) acc)
|
||||
type) acc)
|
||||
file-name)))))
|
||||
(else (loop acc file-name))))))
|
||||
(close-pipe port)
|
||||
|
|
@ -263,10 +272,18 @@ corresponding to the top-level definition containing the staged changes."
|
|||
(listify added))))))))))
|
||||
'(inputs propagated-inputs native-inputs)))
|
||||
|
||||
(define* (add-commit-message file-name variable-name #:optional (port (current-output-port)))
|
||||
"Print ChangeLog commit message for a change to FILE-NAME adding a definition."
|
||||
(format port
|
||||
"gnu: Add ~a.~%~%* ~a (~a): New variable.~%"
|
||||
(define* (add-commit-message file-name variable-name
|
||||
#:optional (port (current-output-port)))
|
||||
"Print ChangeLog commit message for a change to FILE-NAME adding a
|
||||
definition."
|
||||
(format port "gnu: Add ~a.~%~%* ~a (~a): New variable.~%"
|
||||
variable-name file-name variable-name))
|
||||
|
||||
(define* (remove-commit-message file-name variable-name
|
||||
#:optional (port (current-output-port)))
|
||||
"Print ChangeLog commit message for a change to FILE-NAME removing a
|
||||
definition."
|
||||
(format port "gnu: Remove ~a.~%~%* ~a (~a): Delete variable.~%"
|
||||
variable-name file-name variable-name))
|
||||
|
||||
(define* (custom-commit-message file-name variable-name message changelog
|
||||
|
|
@ -345,66 +362,67 @@ modifying."
|
|||
(()
|
||||
(display "Nothing to be done.\n" (current-error-port)))
|
||||
(hunks
|
||||
(let-values
|
||||
(((definitions changes)
|
||||
(partition hunk-definition? hunks)))
|
||||
(let-values (((definitions changes) (partition hunk-type hunks)))
|
||||
;; Additions/removals.
|
||||
(for-each
|
||||
(lambda (hunk)
|
||||
(and-let* ((define-line (find (cut string-match "(\\+|-)\\(define" <>)
|
||||
(hunk-diff-lines hunk)))
|
||||
(variable-name (and=> (string-tokenize define-line)
|
||||
second))
|
||||
(commit-message-proc (match (hunk-type hunk)
|
||||
('addition add-commit-message)
|
||||
('removal remove-commit-message))))
|
||||
(commit-message-proc (hunk-file-name hunk) variable-name)
|
||||
(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")))
|
||||
|
||||
;; Additions.
|
||||
(for-each (lambda (hunk)
|
||||
(and-let*
|
||||
((define-line (find (cut string-prefix? "+(define" <>)
|
||||
(hunk-diff-lines hunk)))
|
||||
(variable-name (and=> (string-tokenize define-line) second)))
|
||||
(add-commit-message (hunk-file-name hunk) variable-name)
|
||||
(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")))
|
||||
(let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
|
||||
(commit-message-proc (hunk-file-name hunk) variable-name port)
|
||||
(usleep %delay)
|
||||
(unless (eqv? 0 (status:exit-val (close-pipe port)))
|
||||
(error "Cannot commit"))))
|
||||
(usleep %delay))
|
||||
definitions))
|
||||
|
||||
(let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
|
||||
(add-commit-message (hunk-file-name hunk)
|
||||
variable-name port)
|
||||
(usleep %delay)
|
||||
;; 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 commit"))))
|
||||
(usleep %delay))
|
||||
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)))))))
|
||||
(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))))))
|
||||
|
||||
(apply main (cdr (command-line)))
|
||||
|
|
|
|||
Reference in New Issue