diff options
author | Hugo Hörnquist <hugo@hornquist.se> | 2019-12-28 00:26:23 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@hornquist.se> | 2019-12-28 00:26:23 +0100 |
commit | dc0c762dd36c5580e0a35f13885ed8c033f942c3 (patch) | |
tree | 615d99b0c08cb1ea62d6feee0d1c60be73f43c1d /module/output | |
parent | Minor fixups. (diff) | |
download | calp-dc0c762dd36c5580e0a35f13885ed8c033f942c3.tar.gz calp-dc0c762dd36c5580e0a35f13885ed8c033f942c3.tar.xz |
HTML Add hyperlink parsing.
Diffstat (limited to '')
-rw-r--r-- | module/output/html.scm | 30 |
1 files changed, 22 insertions, 8 deletions
diff --git a/module/output/html.scm b/module/output/html.scm index 242ee714..fb00b36f 100644 --- a/module/output/html.scm +++ b/module/output/html.scm @@ -12,10 +12,20 @@ #:use-module (srfi srfi-19 util) #:use-module (output general) + #:use-module (ice-9 regex) + #:use-module (git) #:use-module (parameters) #:use-module (config)) +(define (td param) + (lambda (d) `(td (@ ,(map (lambda (p) + (cons `(quote ,(car p)) + (cdr p))) + param)) ,d))) + +(define (a link) `(a (@ (href ,link)) ,link)) + (define (date-link date) (date->string date "~Y-~m-~d")) @@ -178,6 +188,17 @@ (end (time->string (attr ev 'DTEND) fmt))) (values start end))) +(define (description-preprocess text) + (define regexp (make-regexp "https?://\\S+")) + + (let recur ((str text)) + (let ((m (regexp-exec regexp str))) + (if (not m) + '() + (cons* (match:prefix m) + (a (match:substring m)) + (recur (match:suffix m))))))) + ;; For sidebar, just text (define (fmt-single-event ev) `(article (@ (id ,(UID ev)) @@ -191,7 +212,7 @@ `(div ,start " — " ,end)) ,(when (and=> (attr ev 'LOCATION) (negate string-null?)) `(div (b "Plats: ") ,(attr ev 'LOCATION))) - ,(attr ev 'DESCRIPTION)))) + ,(and=> (attr ev 'DESCRIPTION) description-preprocess)))) ;; Single event in side bar (text objects) (define (fmt-day day) @@ -221,13 +242,6 @@ (define (previous-month n) (1+ (modulo (- n 2) 12))) -(define (td param) - (lambda (d) `(td (@ ,(map (lambda (p) - (cons `(quote ,(car p)) - (cdr p))) - param)) ,d))) - - ;; 0 indexed, starting at monday. (define (week-day date) (modulo (1- (date-week-day date)) 7)) |