diff options
| author | Hugo Hörnquist <hugo@hornquist.se> | 2020-01-24 20:21:41 +0100 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@hornquist.se> | 2020-01-24 20:23:04 +0100 |
| commit | e822f7b81245c919eda8bd8ad4b482df075e0508 (patch) | |
| tree | 3024a9a1a80e5c9ffd6d187a028c783dc4b7abbd /module/vcomponent/parse.scm | |
| parent | Extend define-many to allow a custom define procedure. (diff) | |
| download | calp-e822f7b81245c919eda8bd8ad4b482df075e0508.tar.gz calp-e822f7b81245c919eda8bd8ad4b482df075e0508.tar.xz | |
Start of new date structures.
Diffstat (limited to 'module/vcomponent/parse.scm')
| -rw-r--r-- | module/vcomponent/parse.scm | 36 |
1 files changed, 20 insertions, 16 deletions
diff --git a/module/vcomponent/parse.scm b/module/vcomponent/parse.scm index c4142910..646d1f72 100644 --- a/module/vcomponent/parse.scm +++ b/module/vcomponent/parse.scm @@ -3,9 +3,10 @@ :use-module (rnrs bytevectors) :use-module (srfi srfi-1) :use-module (srfi srfi-9) - :use-module (srfi srfi-19) - :use-module (srfi srfi-19 setters) - :use-module (srfi srfi-19 util) + :use-module (srfi srfi-19 alt) + ;; :use-module (srfi srfi-19 setters) + :use-module (srfi srfi-19 alt util) + :use-module (srfi srfi-26) :use-module ((ice-9 rdelim) :select (read-line)) :use-module ((ice-9 textual-ports) :select (unget-char)) :use-module ((ice-9 ftw) :select (scandir ftw)) @@ -14,6 +15,7 @@ :use-module (util strbuf) :use-module (vcomponent base) :use-module (vcomponent datetime) + :use-module (srfi srfi-19 alt util) ) (use-modules ((rnrs base) #:select (assert))) @@ -147,25 +149,27 @@ (when (and (eq? 'VEVENT (type component)) (not (attr component 'DTEND))) (set! (attr component 'DTEND) - (add-duration (attr component 'DTSTART) - (make-duration 3600)))) + (let ((start (attr component 'DTSTART))) + (if (date? start) + (date+ start (date day: 1)) + (datetime+ start (datetime time: (time hour: 1))))))) - (set! component (parent component)) - ] + (set! component (parent component))] [else ;; TODO repeated keys (let ((it (make-vline str (get-param-table ctx)))) ;; Type specific processing (case (get-line-key ctx) - [(DTSTART DTEND) - (with-vline-tz - it - ;; TODO many of these are way to low - (mod! (value it) (compose date->time-utc parse-datetime)))] - [(RECURRENCE-ID) - (with-vline-tz - it (mod! (value it) (compose date->time-utc parse-datetime)))]) + [(DTSTART DTEND RECURRENCE-ID) + + (let ((v (prop it 'VALUE))) + (mod! (value it) + (if (or (and=>> v car (cut string=? <> "DATE-TIME")) + (string-contains (value it) "T")) + parse-datetime parse-date)))] + + ) ;; From RFC 5545 §3.6.1 @@ -298,7 +302,7 @@ row ~a column ~a ctx = ~a (set! (attr head 'X-HNH-ALTERNATIVES) (sort*! rest ;; HERE - time<? (extract 'RECURRENCE-ID))) + date/-time< (extract 'RECURRENCE-ID))) (add-child! calendar head))]) ;; return |