blob: c2e65d191c20420d083e7a8d00a5f340936ba82a (
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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
(define-module (vcomponent)
#:use-module ((vcomponent primitive) :select (parse-cal-path (make-vcomponent . primitive-make-vcomponent)))
#:use-module (vcomponent datetime)
#:use-module (vcomponent recurrence)
#:use-module (vcomponent timezone)
#:use-module (vcomponent base)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-19 util)
#:use-module (srfi srfi-19 setters)
#:use-module (srfi srfi-26)
#:use-module (util)
#:export (make-vcomponent)
#:re-export (repeating?))
;; All VTIMEZONE's seem to be in "local" time in relation to
;; themselves. Therefore, a simple comparison should work,
;; and then the TZOFFSETTO attribute can be subtracted from
;; the event DTSTART to get UTC time.
(re-export-modules (vcomponent base))
(define string->time-utc
(compose date->time-utc parse-datetime))
(define (parse-dates! cal)
"Parse all start times into scheme date objects."
(for tz in (filter (lambda (o) (eq? 'VTIMEZONE (type o))) (children cal))
(format #t "TZ = ~a~%" tz)
(for-each (lambda (p) (mod! (attr p "DTSTART") string->time-utc))
(children tz))
;; TZSET is the generated recurrence set of a timezone
(set! (attr tz 'X-HNH-TZSET)
(make-tz-set tz)
#;
((@ (srfi srfi-41) stream)
(list
(car (children tz))
(cadr (children tz))))
))
(for ev in (filter (lambda (o) (eq? 'VEVENT (type o))) (children cal))
(define dptr (attr* ev 'DTSTART))
(define eptr (attr* ev 'DTEND))
(define date (parse-datetime (value dptr)))
(define end-date
(begin (format #t "end-date, file = ~a~%" (attr ev 'X-HNH-FILENAME))
;; It's here it crashes!
;; (value eptr)
;; /home/hugo/.local/var/cal/lithekod_styrelse/9cd19ed2ac0f68f68c405010e43bcf3a5fd6ca01e8f2e0ccf909a0f2fa96532f.ics
;; An object apparently doesn't need to have a DTEND...
(aif (value eptr)
(parse-datetime it)
(set (date-hour date) = (+ 1)))))
(format #t "ev = ~a~%file = ~a~%" ev (attr ev 'X-HNH-FILENAME))
;; (format #t "ev = ~a~%file = ~a~%" ev (attr ev 'X-HNH-FILENAME))
(set! (value dptr) (date->time-utc date)
(value eptr) (date->time-utc end-date))
(when (prop (attr* ev 'DTSTART) 'TZID)
(set! (zone-offset date) (get-tz-offset ev)
(value dptr) (date->time-utc date)
;; The standard says that DTEND must have the same
;; timezone as DTSTART. Here we trust that blindly.
(zone-offset end-date) (zone-offset date)
(value eptr) (date->time-utc end-date)))))
;; (define-public value caar)
;; (define-public next cdr)
;; (define-public next! pop!)
;; (define-public (reset! attr-list)
;; (while (not (car attr-list))
;; (next! attr-list))
;; (next! attr-list))
;; value
;; (define-public v
;; (make-procedure-with-setter car set-car!))
(define* (make-vcomponent #:optional path)
(if (not path)
(primitive-make-vcomponent)
(let ((root (parse-cal-path path)))
(format #t "root = ~a~%" root )
(let* ((component
(case (string->symbol (or (attr root "X-HNH-SOURCETYPE") "no-type"))
;; == Single ICS file ==
;; Remove the abstract ROOT component,
;; returning the wanted VCALENDAR component
((file)
;; TODO test this when an empty file is given.
(display "Hello\n")
(car (children root)))
;; == Assume vdir ==
;; Also removes the abstract ROOT component, but also
;; merges all VCALENDAR's children into the a newly
;; created VCALENDAR component, and return that component.
;;
;; TODO the other VCALENDAR components might not get thrown away,
;; this since I protect them from the GC in the C code.
((vdir)
(let ((accum (primitive-make-vcomponent 'VCALENDAR))
(ch (children root)))
;; What does this even do?
(unless (null? ch)
(format #t "Looping over attributes~%")
(for key in (attributes (car ch))
(set! (attr accum key) (attr (car ch) key))))
(format #t "Looping over children, again")
(for cal in ch
(for component in (children cal)
(case (type component)
((VTIMEZONE)
(unless (find (lambda (z)
(string=? (attr z "TZID")
(attr component "TZID")))
(filter (lambda (o) (eq? 'VTIMEZONE (type o))) (children accum)))
(push-child! accum component)))
(else (push-child! accum component)))))
;; return
accum))
((no-type) (throw 'no-type)))))
(display "Here?\n")
(parse-dates! component)
(display "Theren")
(unless (attr component "NAME")
(set! (attr component "NAME")
(or (attr component "X-WR-CALNAME")
(attr root "NAME"))))
(unless (attr component "COLOR")
(set! (attr component "COLOR")
(attr root "COLOR")))
;; return
component))))
|
