blob: ab1985b6959bcd5c6c3290d39e950181400af4a9 (
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
|
;;; Commentary:
;;; Module for writing components to the vdir storage format.
;;; Currently also has some cases for "big" icalendar files,
;;; but those are currently unsupported.
;;; TODO generalize save-event and remove-event into a general interface,
;;; which different database backends can implement. Actually, do that for all
;;; loading and writing.
;;; Code:
(define-module (vcomponent formats vdir save-delete)
:use-module (hnh util)
:use-module (hnh util uuid)
:use-module ((hnh util path) :select (path-append))
:use-module (vcomponent formats ical output)
:use-module (vcomponent)
:use-module (calp translation)
:use-module ((hnh util io) :select (with-atomic-output-to-file))
:export (save-event remove-event)
)
(define (save-event event)
(define calendar (parent event))
(unless calendar
(scm-error 'wrong-type-arg "save-event"
(G_ "Can only save events belonging to calendars, event uid = ~s")
(list (prop event 'UID))
#f))
(unless (eq? 'vdir (prop calendar '-X-HNH-SOURCETYPE))
(scm-error 'wrong-type-arg "save-event"
(string-append
(G_ "Can only save events belonging to vdir calendars.")
" "
(G_ "Calendar is of type ~s"))
(list (prop calendar '-X-HNH-SOURCETYPE))
#f))
(let ((uid (or (prop event 'UID) (uuid))))
(set! (prop event 'UID) uid)
(unless (prop event 'X-HNH-FILENAME)
(set! (prop event '-X-HNH-FILENAME)
(path-append
(prop calendar '-X-HNH-DIRECTORY)
(string-append uid ".ics"))))
(with-atomic-output-to-file (prop event '-X-HNH-FILENAME)
(lambda () (print-components-with-fake-parent (list event))))
uid))
(define (remove-event event)
(define calendar (parent event))
(unless (eq? 'vdir (prop calendar '-X-HNH-SOURCETYPE))
(scm-error 'wrong-type-arg "remove-event"
(string-append (G_ "Can only remove events belonging to vdir calendars.")
" "
(G_ "Calendar is of type ~s"))
(list (prop calendar '-X-HNH-SOURCETYPE))
#f))
(delete-file (prop event '-X-HNH-FILENAME))
(remove-child! parent event))
|
