blob: 11633e524b45bc7d9a7aa832e0d9e38e125bdabf (
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
|
(define-module (output ical)
:use-module (ice-9 getopt-long)
:use-module (ice-9 format)
:use-module (util)
:use-module (vcomponent)
:use-module (srfi srfi-19)
:use-module (srfi srfi-19 util)
:use-module (srfi srfi-41)
:use-module (srfi srfi-41 util)
)
(define opt-spec
'((from (value #t) (single-char #\f))
(to (value #t) (single-char #\t))))
(define (value-format key value)
;; TODO remove once key's are normalized to symbols.
(case key
((DTSTART DTEND)
(time->string value "~Y~m~dT~H~M~SZ"))
((DURATION)
#; (time->string value "~H~M~S")
(let ((s (time-second value)))
(format #f "~a~a~a"
(floor/ s 3600)
(floor/ (modulo s 3600) 60)
(modulo s 60))
))
(else value)))
(define (escape-chars str)
(with-output-to-string
(lambda ()
(string-for-each (lambda (ch)
(case ch
((#\, #\; #\\) => (lambda (c) (display "\\") (display c)))
((#\newline) (display "\\n"))
(else (display ch)))
) str))))
(define (component->ical-string component)
(format #t "BEGIN:~a~%" (type component))
(hash-for-each (lambda (key vline)
;; key;p1=v;p3=10:value
(format #t "~a~:{;~a=~@{~a~^,~}~}:~a~%"
key (properties vline)
;; TODO wrap lines
(escape-chars (value-format key (value vline)))))
(attributes component))
(for-each component->ical-string (children component))
(format #t "END:~a~%" (type component))
)
(define (print-header)
(format #t
"BEGIN:VCALENDAR
PRODID:-//hugo//Calparse 0.5//EN
VERSION:2.0
CALSCALE:GREGORIAN
"
))
(define (print-footer)
(format #t "END:VCALENDAR~%"))
(define-public (ical-main calendars events args)
(define opts (getopt-long args opt-spec))
(define start (cond [(option-ref opts 'from #f) => parse-freeform-date]
[else (start-of-month (current-date))]))
(define end (cond [(option-ref opts 'to #f) => parse-freeform-date]
[else (normalize-date* (set (date-month start) = (+ 1)))]))
(print-header)
(stream-for-each
component->ical-string
(filter-sorted-stream (lambda (ev) ((in-date-range? start end)
(time-utc->date (attr ev 'DTSTART))))
events))
(print-footer))
|