From 866c063bf226a783350283d87c2e460c30771acf Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Mon, 21 Jun 2021 15:41:39 +0530
Subject: ccwl: Link source links to entire s-exp.
* ccwl/skribilo.scm (sexp-position, position->line-number,
sexp-file-lines): New functions.
(source-ref): Refer to entire s-exp, not just a single line.
---
ccwl/skribilo.scm | 68 +++++++++++++++++++++++++++++++++++++++++--------------
1 file changed, 51 insertions(+), 17 deletions(-)
diff --git a/ccwl/skribilo.scm b/ccwl/skribilo.scm
index 815448c..7894ad4 100644
--- a/ccwl/skribilo.scm
+++ b/ccwl/skribilo.scm
@@ -66,29 +66,63 @@
,@(the-options opts #:ident #:class #:short #:long)))
(body (the-body opts))))
-;; Source links
+;; S-exp source links
+(define (sexp-position str regexp)
+ "Return (START . END) where START is the start of the match to
+REGEXP in STR and END is the end of the sexp beginning at START. START
+and END are character positions indexed from 0. If multiple matches
+are found, error out."
+ (cond
+ ((string-match regexp str)
+ => (lambda (match-struct)
+ (let ((start (match:start match-struct)))
+ (if (string-match regexp (substring str (1+ start)))
+ (error "source-ref: regexp found on multiple lines" regexp)
+ (cons start
+ (1- (- (string-length str)
+ (string-length
+ (call-with-input-string (substring str start)
+ (lambda (port)
+ (read port)
+ (get-string-all port)))))))))))
+ (else
+ (error "source-sexp-ref: regexp not found" regexp))))
+
+(define (position->line-number str position)
+ "Return the line number in STR corresponding to POSITION."
+ (string-fold (lambda (c result)
+ (if (char=? c #\newline)
+ (1+ result)
+ result))
+ 1
+ (substring str 0 position)))
+
+(define (sexp-file-lines file regexp)
+ "Return (START . END) where START is the start of the match to
+REGEXP in STR and END is the end of the sexp beginning at START. START
+and END are line numbers indexed from 1."
+ (let ((str (call-with-input-file file get-string-all)))
+ (match (sexp-position str regexp)
+ ((start . end)
+ (cons (position->line-number str start)
+ (position->line-number str end))))))
+
(define (source-ref file regexp text)
(call-with-input-file file
(lambda (port)
- (ref #:url (call-with-input-file file
- (lambda (port)
- (match (port-transduce (compose (tenumerate 1)
- (tfilter-map
- (match-lambda
- ((line-number . line)
- (and (string-match regexp line)
- line-number)))))
- rcons
- get-line
- port)
- ((line-number)
+ (ref #:url (match (sexp-file-lines file regexp)
+ ((start-line . end-line)
+ (if (= start-line end-line)
+ (string-append %source-uri-base
+ file
+ "#L"
+ (number->string start-line))
(string-append %source-uri-base
file
"#L"
- (number->string line-number)))
- ((line-numbers ...)
- (error "source-ref: regexp found on multiple lines"
- regexp line-numbers)))))
+ (number->string start-line)
+ "-L"
+ (number->string end-line)))))
#:text text))))
;; HTML engine customizations
--
cgit v1.2.3