blob: c0e4e639d4f52927c5c72c08229203b106f249b0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
;;; Preliminary config file for the system.
;;; Currently loaded by main, and requires that `calendar-files`
;;; is set to a list of files (or directories).
(use-modules (calp config-base)
(sxml simple)
(sxml xpath)
)
(when (getenv "SYSTEMD")
((@ (calp entry-points server) port) 58080)
((@ (calp html config) debug) #f)
((@ (calp html config) edit-mode) #t)
)
((@ (vcomponent config) calendar-files) (glob "~/.local/var/cal/*"))
(define my-courses
'((TSEA82 . "Datorteknik")
(TFYA19 . "Kvantdatorer")
(TATA42 . "Tvåvarren")
(TSRT04 . "Matlab")
(TDDC78 . "Paralellprogrammering")
(TDDB68 . "Pintos")))
(define* (aref alist key optional: default)
(or (assoc-ref alist key) default key))
((@ (calp html filter) summary-filter)
(lambda (ev str)
(regexp-substitute/global
#f "T[A-Z]{3}[0-9]{2}" str
'pre (lambda (m) (aref my-courses (string->symbol (match:substring m))))
'post)))
(define (parse-html str)
(catch 'misc-error
;; resolve-interface throws misc-error on missing module.
;; TODO what does html->sxml throw?
(lambda ()
(let* ((gumbo (resolve-interface '(sxml gumbo)))
(html->sxml (module-ref gumbo 'html->sxml)))
;; html->sxml always gives us (html (head ...) (body <content>))
;; this strips it down to just <content>
(cdar ((sxpath '(// body)) (html->sxml str)))))
;; Give up on parsing
(lambda _ str)))
(define (a link) `(a (@ (href ,link)) ,link))
(define (parse-links str)
(define regexp (make-regexp "https?://\\S+"))
(let recur ((str str))
(let ((m (regexp-exec regexp str)))
(if (not m)
(list str)
(cons* (match:prefix m)
(a (match:substring m))
(recur (match:suffix m)))))))
(define (parse-teams-description str)
(map (lambda (line)
(let loop ((line line))
(cond [(string-match "^_+$" line)
'((hr) (br))]
;; hyperlinks go from start of line,
;; or from last pipe character
[(string-match "([^|<]*)<([^>]*)>" line)
=> (lambda (m)
(cons*
(match:prefix m)
`(a (@ (href ,(match:substring m 2)))
,(match:substring m 1))
(loop (match:suffix m))))]
;; square brackets are images
[(string-match "\\[([^]]+)\\]" line)
=> (lambda (m)
(cons*
(match:prefix m)
`(img (@ (src ,(match:substring m 1))))
(loop (match:suffix m))))]
;; Either the full line, or the remainder
;; after hyperlink and img match.
[else (list line '(br))])))
(string-split str #\newline)))
(define html-rx
(make-regexp "</?\\w+( +\\w+(=[\"']?\\w+[\"']?)?)* */?>"))
((@ (calp html filter) description-filter)
(lambda (ev str)
(cond [(prop ev 'X-MICROSOFT-SKYPETEAMSMEETINGURL)
(parse-teams-description str)]
[(regexp-exec html-rx str)
(parse-html str)]
[else (parse-links str)])))
((@ (datetime) week-start) mon)
((@ (vcomponent config) default-calendar) "Calendar")
;; (set-config! 'path-prefix (car (glob "~/.local")))
|
