summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2021-06-19 17:44:15 +0530
committerArun Isaac2021-06-19 17:44:15 +0530
commit4b77884224a916c177a7ad95c2d1c82ac39315d9 (patch)
tree884f998706f617f3622ad50194f574b8937cd8ec
parentffa9ad433e3910986bfc7f6cfe8c50fdd911006a (diff)
downloadccwl-4b77884224a916c177a7ad95c2d1c82ac39315d9.tar.gz
ccwl-4b77884224a916c177a7ad95c2d1c82ac39315d9.tar.lz
ccwl-4b77884224a916c177a7ad95c2d1c82ac39315d9.zip
ccwl: Add source links.
* ccwl/skribilo.scm: Import (rnrs io ports), (ice-9 match), (ice-9 regex) and (srfi srfi-171). (%source-uri-base): New variable. (source-ref): New public function.
-rw-r--r--ccwl/skribilo.scm38
1 files changed, 37 insertions, 1 deletions
diff --git a/ccwl/skribilo.scm b/ccwl/skribilo.scm
index 8e4b198..815448c 100644
--- a/ccwl/skribilo.scm
+++ b/ccwl/skribilo.scm
@@ -23,6 +23,10 @@
;;; Code:
(define-module (ccwl skribilo)
+ #:use-module (rnrs io ports)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 regex)
+ #:use-module (srfi srfi-171)
#:use-module (skribilo ast)
#:use-module (skribilo engine)
#:use-module (skribilo lib)
@@ -30,7 +34,14 @@
#:use-module (skribilo source lisp)
#:use-module (skribilo utils keywords)
#:use-module (skribilo writer)
- #:export (command file scheme-source))
+ #:export (command
+ file
+ scheme-source
+ source-ref))
+
+;; Constants
+(define %source-uri-base
+ "https://github.com/arunisaac/ccwl/blob/main/")
;; Aliases
(define file samp)
@@ -55,6 +66,31 @@
,@(the-options opts #:ident #:class #:short #:long)))
(body (the-body opts))))
+;; Source links
+(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)
+ (string-append %source-uri-base
+ file
+ "#L"
+ (number->string line-number)))
+ ((line-numbers ...)
+ (error "source-ref: regexp found on multiple lines"
+ regexp line-numbers)))))
+ #:text text))))
+
;; HTML engine customizations
(let ((html-engine (find-engine 'html)))
(engine-custom-set! html-engine 'css "/style.css")