summaryrefslogtreecommitdiff
path: root/etc/committer.scm.in
diff options
context:
space:
mode:
Diffstat (limited to 'etc/committer.scm.in')
-rwxr-xr-xetc/committer.scm.in46
1 files changed, 32 insertions, 14 deletions
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).