diff options
Diffstat (limited to '')
-rw-r--r-- | module/vcomponent/parse.scm | 99 | ||||
-rw-r--r-- | module/vcomponent/vdir/parse.scm | 102 | ||||
-rw-r--r-- | module/vcomponent/vdir/save-delete.scm (renamed from module/output/vdir.scm) | 2 |
3 files changed, 105 insertions, 98 deletions
diff --git a/module/vcomponent/parse.scm b/module/vcomponent/parse.scm index 67d66b02..290a8d3e 100644 --- a/module/vcomponent/parse.scm +++ b/module/vcomponent/parse.scm @@ -1,107 +1,13 @@ -;;; Commentary: -;; Code for parsing vdir's and icalendar files. -;; This module handles the finding of files, while -;; (vcomponent parse ical) handles reading data from icalendar files. -;;; Code: - (define-module (vcomponent parse) - :use-module (srfi srfi-1) - - :use-module ((ice-9 hash-table) :select (alist->hash-table)) - :use-module ((ice-9 rdelim) :select (read-line)) - :use-module ((ice-9 ftw) :select (scandir ftw)) - :use-module (util) - :use-module (util time) - :use-module (util exceptions) :use-module (vcomponent base) + :use-module ((vcomponent vdir parse) :select (parse-vdir)) + :use-module ((util time) :select (report-time!)) :use-module (vcomponent ical parse) :re-export (parse-calendar) ) - - - -;; All VTIMEZONE's seem to be in "local" time in relation to -;; themselves. Therefore, a simple comparison should work, -;; and then the TZOFFSETTO properties can be subtd. -(define (parse-vdir path) - (let ((/ (lambda args (string-join args file-name-separator-string 'infix)))) - (let ((color - (catch 'system-error - (lambda () (call-with-input-file (/ path "color") read-line)) - (const "#FFFFFF"))) - (name - (catch 'system-error - (lambda () (call-with-input-file (/ path "displayname") read-line)) - (const #f)))) - - (reduce (lambda (item calendar) - - (define-values (events other) (partition (lambda (e) (eq? 'VEVENT (type e))) - (children item))) - - - ;; (assert (eq? 'VCALENDAR (type calendar))) - (assert (eq? 'VCALENDAR (type item))) - - (for child in (children item) - (set! (prop child '-X-HNH-FILENAME) - (prop (parent child) '-X-HNH-FILENAME))) - - ;; NOTE The vdir standard says that each file should contain - ;; EXACTLY one event. It can however contain multiple VEVENT - ;; components, but they are still the same event. - ;; In our case this means exceptions to reccurence rules, which - ;; is set up here, and then later handled in rrule-generate. - ;; NOTE These events also share UID, but are diferentiated - ;; by RECURRENCE-ID. As far as I can tell this goes against - ;; the standard. Section 3.8.4.4. - (case (length events) - [(0) (warning "No events in component~%~a" - (prop item '-X-HNH-FILENAME))] - [(1) - (let ((child (car events))) - (assert (memv (type child) '(VTIMEZONE VEVENT))) - (add-child! calendar child))] - - ;; two or more - [else - - ;; Sorting on SEQUENCE here would have been nice. - ;; But the patches can apparently share a sequence number - ;; of 0 with the original event! - ;; (╯°□°)╯ ┻━┻ - (let* ((head (find (negate (extract 'RECURRENCE-ID)) - events)) - (rest (delete head events eq?))) - - (set! (prop head '-X-HNH-ALTERNATIVES) - (alist->hash-table - (map cons - (map (extract 'RECURRENCE-ID) rest) - rest)) - #; - (sort*! rest ;; HERE - date/-time< (extract 'RECURRENCE-ID))) - (add-child! calendar head))]) - - ;; return - calendar) - (make-vcomponent) - (map #; (@ (ice-9 threads) par-map) - (lambda (fname) - (let ((fullname (/ path fname))) - (let ((cal (call-with-input-file fullname - parse-calendar))) - (set! (prop cal 'COLOR) color - (prop cal 'NAME) name - (prop cal '-X-HNH-FILENAME) fullname) - cal))) - (scandir path (lambda (s) (and (not (string= "." (string-take s 1))) - (string= "ics" (string-take-right s 3)))))))))) - ;; Parse a vdir or ics file at the given path. (define-public (parse-cal-path path) ;; TODO check (access? path R_OK) ? @@ -127,4 +33,3 @@ (string-append "[" (basename path) "]")))) cal) - diff --git a/module/vcomponent/vdir/parse.scm b/module/vcomponent/vdir/parse.scm new file mode 100644 index 00000000..ae4ea692 --- /dev/null +++ b/module/vcomponent/vdir/parse.scm @@ -0,0 +1,102 @@ +;;; Commentary: +;; Code for parsing vdir's and icalendar files. +;; This module handles the finding of files, while +;; (vcomponent parse ical) handles reading data from icalendar files. +;;; Code: + +(define-module (vcomponent parse) + :use-module (srfi srfi-1) + + :use-module ((ice-9 hash-table) :select (alist->hash-table)) + :use-module ((ice-9 rdelim) :select (read-line)) + :use-module ((ice-9 ftw) :select (scandir ftw)) + + :use-module (util) + :use-module (util exceptions) + :use-module (vcomponent base) + + :use-module (vcomponent ical parse) + ) + + + + +;; All VTIMEZONE's seem to be in "local" time in relation to +;; themselves. Therefore, a simple comparison should work, +;; and then the TZOFFSETTO properties can be subtd. +(define (parse-vdir path) + (let ((/ (lambda args (string-join args file-name-separator-string 'infix)))) + (let ((color + (catch 'system-error + (lambda () (call-with-input-file (/ path "color") read-line)) + (const "#FFFFFF"))) + (name + (catch 'system-error + (lambda () (call-with-input-file (/ path "displayname") read-line)) + (const #f)))) + + (reduce (lambda (item calendar) + + (define-values (events other) (partition (lambda (e) (eq? 'VEVENT (type e))) + (children item))) + + + ;; (assert (eq? 'VCALENDAR (type calendar))) + (assert (eq? 'VCALENDAR (type item))) + + (for child in (children item) + (set! (prop child '-X-HNH-FILENAME) + (prop (parent child) '-X-HNH-FILENAME))) + + ;; NOTE The vdir standard says that each file should contain + ;; EXACTLY one event. It can however contain multiple VEVENT + ;; components, but they are still the same event. + ;; In our case this means exceptions to reccurence rules, which + ;; is set up here, and then later handled in rrule-generate. + ;; NOTE These events also share UID, but are diferentiated + ;; by RECURRENCE-ID. As far as I can tell this goes against + ;; the standard. Section 3.8.4.4. + (case (length events) + [(0) (warning "No events in component~%~a" + (prop item '-X-HNH-FILENAME))] + [(1) + (let ((child (car events))) + (assert (memv (type child) '(VTIMEZONE VEVENT))) + (add-child! calendar child))] + + ;; two or more + [else + + ;; Sorting on SEQUENCE here would have been nice. + ;; But the patches can apparently share a sequence number + ;; of 0 with the original event! + ;; (╯°□°)╯ ┻━┻ + (let* ((head (find (negate (extract 'RECURRENCE-ID)) + events)) + (rest (delete head events eq?))) + + (set! (prop head '-X-HNH-ALTERNATIVES) + (alist->hash-table + (map cons + (map (extract 'RECURRENCE-ID) rest) + rest)) + #; + (sort*! rest ;; HERE + date/-time< (extract 'RECURRENCE-ID))) + (add-child! calendar head))]) + + ;; return + calendar) + (make-vcomponent) + (map #; (@ (ice-9 threads) par-map) + (lambda (fname) + (let ((fullname (/ path fname))) + (let ((cal (call-with-input-file fullname + parse-calendar))) + (set! (prop cal 'COLOR) color + (prop cal 'NAME) name + (prop cal '-X-HNH-FILENAME) fullname) + cal))) + (scandir path (lambda (s) (and (not (string= "." (string-take s 1))) + (string= "ics" (string-take-right s 3)))))))))) + diff --git a/module/output/vdir.scm b/module/vcomponent/vdir/save-delete.scm index 2541f0f9..02db9d7a 100644 --- a/module/output/vdir.scm +++ b/module/vcomponent/vdir/save-delete.scm @@ -9,7 +9,7 @@ ;;; Code: -(define-module (output vdir) +(define-module (vcomponent vdir save-delete) :use-module (util) :use-module (vcomponent ical output) :use-module (vcomponent) |