From 1bed79f98e16ee2c3810f27d74b768d3da71626b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Wed, 22 Jan 2020 10:35:13 +0100
Subject: Allow user supplied description filters.

---
 config.scm | 30 ++++++++++++++++++++++++++++++
 1 file changed, 30 insertions(+)

(limited to 'config.scm')

diff --git a/config.scm b/config.scm
index f30263fd..4efdccb6 100644
--- a/config.scm
+++ b/config.scm
@@ -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)])))
-- 
cgit v1.2.3