blob: 48c89783f559277df8ab1eb46f17a3b52d0f0cc3 (
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
|
(define-module (vcomponent datetime output)
:use-module (util)
:use-module (util config)
:use-module (util exceptions)
:use-module (datetime)
:use-module (vcomponent base)
:use-module (text util)
)
(define-config summary-filter (lambda (_ a) a)
pre: (ensure procedure?))
(define-config description-filter (lambda (_ a) a)
pre: (ensure procedure?))
;; ev → sxml
(define-public (format-recurrence-rule ev)
`("Upprepas "
,((@ (vcomponent recurrence display) format-recurrence-rule)
(prop ev 'RRULE))
,@(awhen (prop* ev 'EXDATE)
(list
", undantaget "
(add-enumeration-punctuation
(map (lambda (d)
(if (date? d)
;; NOTE possibly show year?
(date->string d "~e ~b")
;; NOTE only show time when it's different than the start time?
;; or possibly only when FREQ is hourly or lower.
(if (memv ((@ (vcomponent recurrence internal) freq)
(prop ev 'RRULE))
'(HOURLY MINUTELY SECONDLY))
(datetime->string d "~e ~b ~k:~M")
(datetime->string d "~e ~b"))))
(map value it)))))
"."))
(define-public (format-summary ev str)
((get-config 'summary-filter) ev str))
;; NOTE this should have information about context (html/term/...)
(define-public (format-description ev str)
(catch #t (lambda () ((get-config 'description-filter) ev str))
(lambda (err . args)
(warning "~a on formatting description, ~s" err args)
str)))
;; Takes an event, and returns a pretty string for the time interval
;; the event occupies.
(define-public (fmt-time-span ev)
(cond [(prop ev 'DTSTART) date?
=> (lambda (s)
(cond [(prop ev 'DTEND)
=> (lambda (e)
(if (date= e (date+ s (date day: 1)))
(date->string s) ; start = end, only return one value
(values (date->string s)
(date->string e))))]
;; no end value, just return start
[else (date->string s)]))]
[else ; guaranteed datetime
(let ((s (prop ev 'DTSTART))
(e (prop ev 'DTEND)))
(if e
(let ((fmt-str (if (date= (get-date s) (get-date e))
"~H:~M" "~Y-~m-~d ~H:~M")))
(values (datetime->string s fmt-str)
(datetime->string e fmt-str)))
(datetime->string s "~Y-~m-~d ~H:~M")))]))
|