diff --git a/etc/committer.scm.in b/etc/committer.scm.in index eb8865513e..0705b29fd9 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -85,21 +85,39 @@ the expression." (seek port start SEEK_SET) result)) -(define (surrounding-sexp port line-no) +(define (lines+offsets-with-opening-parens port) + "Record all line numbers (and their offsets) where an opening parenthesis is +found in column 0. The resulting list is in reverse order." + (let loop ((acc '()) + (number 0)) + (let ((line (read-line port))) + (cond + ((eof-object? line) acc) + ((string-prefix? "(" line) + (loop (cons (cons number ;line number + (- (ftell port) + (string-length line) 1)) ;offset + acc) + (1+ number))) + (else (loop acc (1+ number))))))) + +(define (surrounding-sexp port target-line-no) "Return the top-level S-expression surrounding the change at line number -LINE-NO in PORT." - (let loop ((i (1- line-no)) - (last-top-level-sexp #f)) - (if (zero? i) - last-top-level-sexp - (match (peek-char port) - (#\( - (let ((sexp (read-excursion port))) - (read-line port) - (loop (1- i) sexp))) - (_ - (read-line port) - (loop (1- i) last-top-level-sexp)))))) +TARGET-LINE-NO in PORT." + (let* ((line-numbers+offsets + (lines+offsets-with-opening-parens port)) + (closest-offset + (or (and=> (list-index (match-lambda + ((line-number . offset) + (< line-number target-line-no))) + line-numbers+offsets) + (lambda (index) + (match (list-ref line-numbers+offsets index) + ((line-number . offset) offset)))) + (error "Could not find surrounding S-expression for line" + target-line-no)))) + (seek port closest-offset SEEK_SET) + (read port))) ;;; Whether the hunk contains a newly added package (definition), a removed ;;; package (removal) or something else (#false).