diff options
author | Hugo Hörnquist <hugo@hornquist.se> | 2019-03-08 10:42:59 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@hornquist.se> | 2019-03-08 10:42:59 +0100 |
commit | 7c81b056a56eb0f142b99423509994fa2ed4cf71 (patch) | |
tree | 94d17346d50beaeeab5c29b393c8191267df62c7 | |
parent | Varius minor fixes. (diff) | |
download | calp-7c81b056a56eb0f142b99423509994fa2ed4cf71.tar.gz calp-7c81b056a56eb0f142b99423509994fa2ed4cf71.tar.xz |
Got DAILY repeating event!
-rw-r--r-- | strbuf.c | 4 | ||||
-rwxr-xr-x | test.scm | 37 | ||||
-rw-r--r-- | testcal/repeating-event.ics | 28 | ||||
-rw-r--r-- | vcalendar/recur.scm | 33 |
4 files changed, 85 insertions, 17 deletions
@@ -69,6 +69,10 @@ int DEEP_COPY(strbuf)(strbuf* dest, strbuf* src) { retval = 1; } + if (src->scm != NULL) { + dest->scm = src->scm; + } + dest->len = src->len; memcpy(dest->mem, src->mem, src->len); return retval; diff --git a/test.scm b/test.scm new file mode 100755 index 00000000..ac0308ad --- /dev/null +++ b/test.scm @@ -0,0 +1,37 @@ +#!/usr/bin/guile -s +!# + +(add-to-load-path (dirname (current-filename))) + +(use-modules (rnrs base) ; assert + (srfi srfi-1) + (srfi srfi-19) + (srfi srfi-41) + (code) + (vcalendar) + (vcalendar recur) + (vcalendar datetime)) + +(define cal (make-vcomponent "testcal/repeating-event.ics")) + +(define ev (find (lambda (ev) (eq? 'VEVENT (type ev))) + (children cal))) + +(define ev-copy (copy-vcomponent ev)) + +(assert (equal? (children ev) + (children ev-copy))) + +(transform-attr! ev "DTSTART" parse-datetime) + + +(stream-for-each + (lambda (ev) + (display (date->string (attr ev "DTSTART") "~1 ~3")) (newline)) + (stream-take 10 (recur-event ev))) + +(define stream-cadr (compose stream-car stream-cdr)) + +(newline) +(display (date->string (attr ev "DTSTART") "~1 ~3")) (newline) +(display (date->string (attr (stream-cadr (recur-event ev)) "DTSTART") "~1 ~3")) (newline) diff --git a/testcal/repeating-event.ics b/testcal/repeating-event.ics new file mode 100644 index 00000000..2605d3e1 --- /dev/null +++ b/testcal/repeating-event.ics @@ -0,0 +1,28 @@ +BEGIN:VCALENDAR
+VERSION:2.0
+PRODID:-//PIMUTILS.ORG//NONSGML khal / icalendar //EN
+BEGIN:VTIMEZONE
+TZID:Europe/Stockholm
+BEGIN:STANDARD
+DTSTART;VALUE=DATE-TIME:20181028T020000
+TZNAME:CET
+TZOFFSETFROM:+0200
+TZOFFSETTO:+0100
+END:STANDARD
+BEGIN:DAYLIGHT
+DTSTART;VALUE=DATE-TIME:20190331T030000
+TZNAME:CEST
+TZOFFSETFROM:+0100
+TZOFFSETTO:+0200
+END:DAYLIGHT
+END:VTIMEZONE
+BEGIN:VEVENT
+SUMMARY:Repeating event
+DTSTART;TZID=Europe/Stockholm;VALUE=DATE-TIME:20190302T160000
+DTEND;TZID=Europe/Stockholm;VALUE=DATE-TIME:20190302T170000
+DTSTAMP;VALUE=DATE-TIME:20190302T165849Z
+UID:USG7HSRFJSZ6YURWCNSH3UCKI2PHP19SWGBG
+SEQUENCE:0
+RRULE:FREQ=DAILY
+END:VEVENT
+END:VCALENDAR
diff --git a/vcalendar/recur.scm b/vcalendar/recur.scm index 15afdd26..a480d946 100644 --- a/vcalendar/recur.scm +++ b/vcalendar/recur.scm @@ -10,7 +10,7 @@ #:use-module (vcalendar) #:use-module (vcalendar datetime) #:use-module (util) - #:export (<recur-rule> build-recur-rules)) + #:export (<recur-rule> build-recur-rules recur-event)) (define-immutable-record-type <recur-rule> (make-recur-rules @@ -122,29 +122,28 @@ (define (generate-next event rule) - (match rule - (($ <recur-rule> freq until count interval bysecond byminute byhour wkst) - (case freq - ((WEEKLY) - ;; TODO implement copy-event - (let ((new-event (copy-event event))) - (transform-attr! new-event "DTSTART" - (cut date-add <> 1 weeks))))) - - )) - - ) + (let ((new-event (copy-vcomponent event))) + (match rule + (($ <recur-rule> freq until count interval bysecond byminute byhour wkst) + (case freq + ((WEEKLY) (transform-attr! new-event "DTSTART" (cut date-add <> 1 weeks)) + (values new-event rule)) + ((DAILY) (transform-attr! new-event "DTSTART" (cut date-add <> 1 days)) + (values new-event rule)) + (else (values '() rule)))) + (_ (values event rule))))) (define-stream (recur-event-stream event rule-obj) (stream-cons event - (receive (next-event next-rule) (generate-next event rule-obj) - (recur-event-stream next-event next-rule)))) + (receive (next-event next-rule) + (generate-next event rule-obj) + (if (null? next-event) + stream-null + (recur-event-stream next-event next-rule))))) (define (recur-event event) (recur-event-stream event (build-recur-rules (get-attr event "RRULE")))) - - (define tzero (make-time time-utc 0 0)) (define dzero (time-utc->date tzero)) |