diff options
Diffstat (limited to '')
-rw-r--r-- | module/vcomponent/data-stores/sqlite.scm | 2 | ||||
-rw-r--r-- | module/vcomponent/data-stores/vdir.scm | 50 | ||||
-rw-r--r-- | module/vcomponent/data-stores/virtual.scm | 22 |
3 files changed, 49 insertions, 25 deletions
diff --git a/module/vcomponent/data-stores/sqlite.scm b/module/vcomponent/data-stores/sqlite.scm index b5b566a8..5d487028 100644 --- a/module/vcomponent/data-stores/sqlite.scm +++ b/module/vcomponent/data-stores/sqlite.scm @@ -113,7 +113,7 @@ CREATE TABLE IF NOT EXISTS event_instances_valid_range (define-method (get-calendar (this <sqlite-data-store>)) (let ((db (database this)) - (calendar (make-vcomponent 'VCALENDAR))) + (calendar (vcomponent type: 'VCALENDAR))) (let ((stmt (sqlite-prepare db " SELECT key, value FROM calendar_properties cp LEFT JOIN calendar c ON cp.calendar = c.id diff --git a/module/vcomponent/data-stores/vdir.scm b/module/vcomponent/data-stores/vdir.scm index f0ed0fdc..9320c44e 100644 --- a/module/vcomponent/data-stores/vdir.scm +++ b/module/vcomponent/data-stores/vdir.scm @@ -7,6 +7,9 @@ :use-module (hnh util path) :use-module ((vcomponent formats ical) :select (serialize deserialize)) :use-module ((ice-9 ftw) :select (scandir)) + :use-module (ice-9 rdelim) + :use-module (srfi srfi-1) + :use-module (vcomponent base) :export ()) (define-class <vdir-data-store> (<calendar-data-store>) @@ -29,23 +32,23 @@ (define-method (get-all (this <vdir-data-store>)) (let ((files (scandir (path this) (lambda (item) (string-ci=? "ics" (filename-extension item))))) - (calendar (make-vcomponent 'VCALENDAR))) - (set! (prop calendar 'NAME) (get-attribute (path this) "displayname") - (prop calendar 'COLOR) (get-attribute (path this) "color" "#FFFFFF")) - (for-each (lambda (item) (reparent! calendar item)) - (append-map (lambda (file) - (define cal - (call-with-input-file (path-append (path this) file) - deserialize)) - (unless (eq? 'VCALENDAR (type cal)) - (scm-error 'misc-error "get-all<vdir-data-store>" - "Unexpected top level component. Expected VCALENDAR, got ~a. In file ~s" - (list (type cal) file))) - (for-each (lambda (child) - (set! (prop child '-X-HNH-FILENAME) file)) - (children cal)) - ) - files)) + (calendar + (fold (swap add-child) + (set-properties (vcomponent type: 'VCALENDAR) + (cons 'NAME (get-attribute (path this) "displayname")) + (cons 'COLOR (get-attribute (path this) "color" "#FFFFFF"))) + (append-map (lambda (file) + (define cal + (call-with-input-file (path-append (path this) file) + deserialize)) + (unless (eq? 'VCALENDAR (type cal)) + (scm-error 'misc-error "get-all<vdir-data-store>" + "Unexpected top level component. Expected VCALENDAR, got ~a. In file ~s" + (list (type cal) file))) + (each cal children + (lambda (child) + (prop child '-X-HNH-FILENAME file)))) + files)))) (set! (loaded-calendar this) calendar) calendar)) @@ -63,13 +66,12 @@ (define (wrap-for-output . vcomponents) - (let ((calendar (make-vcomponent 'VCALENDAR))) - (set! (prop calendar 'VERSION) "2.0" - (prop calendar 'PRODID) (prodid) - (prop calendar 'CALSCALE) "GREGORIAN") - (for-each (lambda (vcomponent) (reparent! calendar vcomponent)) - vcomponents) - calendar)) + (fold (swap add-child) + (set-properties (vcomponent type: 'VCALENDAR) + (cons 'VERSION "2.0") + (cons 'PRODID (prodid)) + (cons 'CALSCALE "GREGORIAN")) + vcomponents)) (define-method (queue-write (this <vdir-data-store>) vcomponent) ;; TODO Multiple components diff --git a/module/vcomponent/data-stores/virtual.scm b/module/vcomponent/data-stores/virtual.scm new file mode 100644 index 00000000..03c115f5 --- /dev/null +++ b/module/vcomponent/data-stores/virtual.scm @@ -0,0 +1,22 @@ +(define-module (vcomponent data-stores virtual) + :use-module (oop goops) + :use-module ((srfi srfi-88) :select ()) + :use-module (vcomponent data-stores common) + :export (make-file-store)) + +(define-class <virtual-data-store> (<calendar-data-store>) + ) + +(define-method (get-all (this <virtual-data-store>)) + #f) + +(define-method (get-by-uid (this <virtual-data-store>) + (uid <string>)) + #f) + + +(define-method (color (this <virtual-data-store>)) + "") + +(define-method (displayname (this <virtual-data-store>)) + "Virtual Calendar") |