diff options
Diffstat (limited to '')
-rw-r--r-- | config.scm | 30 | ||||
-rw-r--r-- | module/output/html.scm | 15 | ||||
-rw-r--r-- | module/parameters.scm | 4 |
3 files changed, 35 insertions, 14 deletions
@@ -2,10 +2,13 @@ ;;; Currently loaded by main, and requires that `calendar-files` ;;; is set to a list of files (or directories). +(use-modules (vcomponent)) + (use-modules (srfi srfi-26) (srfi srfi-88) (ice-9 regex) (ice-9 rdelim) + (sxml simple) (glob)) (calendar-files (glob "~/.local/var/cal/*")) @@ -28,3 +31,30 @@ #f "T[A-Z]{3}[0-9]{2}" str 'pre (lambda (m) (aref my-courses (string->symbol (match:substring m)))) 'post))) + +(define (a link) `(a (@ (href ,link)) ,link)) + +(define (parse-html str) + (xml->sxml (string-append "<div>" str "</div>") + default-entity-handler: + (lambda (port name) + (case name + [(nbsp) " "] + [else (symbol->string name)]))) ) + +(define (parse-links str) + (define regexp (make-regexp "https?://\\S+")) + (let recur ((str str)) + (let ((m (regexp-exec regexp str))) + (if (not m) + '() + (cons* (match:prefix m) + (a (match:substring m)) + (recur (match:suffix m))))))) + +(description-filter + (lambda (ev str) + (cond [(member (attr (parent ev) 'NAME) '("d_sektionen" #; "lithekod" + )) + (parse-html str)] + [else (parse-links str)]))) diff --git a/module/output/html.scm b/module/output/html.scm index 394bb476..16520f0b 100644 --- a/module/output/html.scm +++ b/module/output/html.scm @@ -12,7 +12,6 @@ #:use-module (srfi srfi-19 util) #:use-module (output general) - #:use-module (ice-9 regex) #:use-module (git) #:use-module (parameters) @@ -24,8 +23,6 @@ (cdr p))) param)) ,d))) -(define (a link) `(a (@ (href ,link)) ,link)) - (define (date-link date) (date->string date "~Y-~m-~d")) @@ -164,16 +161,6 @@ (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) @@ -188,7 +175,7 @@ `(div ,start " — " ,end)) ,(when (and=> (attr ev 'LOCATION) (negate string-null?)) `(div (b "Plats: ") ,(attr ev 'LOCATION))) - ,(and=> (attr ev 'DESCRIPTION) description-preprocess)))) + ,(and=> (attr ev 'DESCRIPTION) (lambda (str) ((description-filter) ev str)))))) ;; Single event in side bar (text objects) (define (fmt-day day) diff --git a/module/parameters.scm b/module/parameters.scm index cc91c18b..8438040d 100644 --- a/module/parameters.scm +++ b/module/parameters.scm @@ -22,3 +22,7 @@ (define-public summary-filter (make-parameter (lambda (_ a) a) (ensure procedure?))) + +;; ev x str -> sxml +(define-public description-filter + (make-parameter (lambda (_ a) a) (ensure procedure?))) |