blob: 2ce5a438cf837b021733365c5b80dd67232661be (
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
|
(define-module (vcalendar)
#:use-module (vcalendar primitive)
#:use-module (vcalendar datetime)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (util))
(define (parse-dates! cal)
"Parse all start times into scheme date objects."
(for-each-in (children cal 'VEVENT)
(lambda (ev)
(mod! (attr ev "DTSTART") parse-datetime)
(mod! (attr ev "DTEND") parse-datetime)))
cal)
(define-public (make-vcomponent path)
(parse-dates!
(if (string-ci=? ".ics" (string-take-right path 4))
;; == Single ICS file ==
;; Remove the abstract ROOT component,
;; returning the wanted VCALENDAR component
(car (%vcomponent-children
(%vcomponent-make path)))
;; == Assume vdir ==
;; Also removes the abstract ROOT component, but also
;; merges all VCALENDAR's children into the first
;; VCALENDAR, and return that VCALENDAR.
;;
;; TODO the other VCALENDAR components might not get thrown away,
;; this since I protect them from the GC in the C code.
(reduce (lambda (cal accum)
(for-each (cut %vcomponent-push-child! accum <>)
(%vcomponent-children cal))
accum)
'() (%vcomponent-children (%vcomponent-make path))))))
(define-public (type-filter t lst)
(filter (lambda (e) (eqv? t (type e)))
lst))
(define* (children component #:optional only-type)
(let ((childs (%vcomponent-children component)))
(if only-type
(type-filter only-type childs)
childs)))
(export children)
(define set-attr! %vcomponent-set-attribute!)
(define get-attr %vcomponent-get-attribute)
;; Enables symmetric get and set:
;; (set! (attr ev "KEY") 10)
(define-public attr (make-procedure-with-setter get-attr set-attr!))
(define-public type %vcomponent-type)
(define-public parent %vcomponent-parent)
(define-public push-child! %vcomponent-push-child!)
(define-public attributes %vcomponent-attribute-list)
(define-public copy-vcomponent %vcomponent-shallow-copy)
(define-public filter-children! %vcomponent-filter-children!)
(define-public (search cal term)
(cdr (let ((events (filter (lambda (ev) (eq? 'VEVENT (type ev)))
(children cal))))
(find (lambda (ev) (string-contains-ci (car ev) term))
(map cons (map (cut get-attr <> "SUMMARY")
events)
events)))))
(define-public (extract field)
(cut get-attr <> field))
|