diff options
Diffstat (limited to 'module/vcomponent')
-rw-r--r-- | module/vcomponent/datetime.scm | 86 | ||||
-rw-r--r-- | module/vcomponent/group.scm | 6 | ||||
-rw-r--r-- | module/vcomponent/parse/component.scm | 13 |
3 files changed, 58 insertions, 47 deletions
diff --git a/module/vcomponent/datetime.scm b/module/vcomponent/datetime.scm index 28d48361..057b9ca1 100644 --- a/module/vcomponent/datetime.scm +++ b/module/vcomponent/datetime.scm @@ -29,14 +29,20 @@ "Returns if the event overlaps the timespan. Event must have the DTSTART and DTEND attribute set." (timespan-overlaps? (attr event 'DTSTART) - (attr event 'DTEND) + (or (attr event 'DTEND) (attr event 'DTSTART)) begin end)) (define (overlapping? event-a event-b) (timespan-overlaps? (attr event-a 'DTSTART) - (attr event-a 'DTEND) + (or (attr event-a 'DTEND) + (if (date? (attr event-a 'DTSTART)) + (date+ (attr event-a 'DTSTART) (date day: 1)) + (attr event-a 'DTSTART))) (attr event-b 'DTSTART) - (attr event-b 'DTEND))) + (or (attr event-b 'DTEND) + (if (date? (attr event-b 'DTSTART)) + (date+ (attr event-b 'DTSTART) (date day: 1)) + (attr event-b 'DTSTART))))) (define (event-contains? ev date/-time) "Does event overlap the date that contains time." @@ -44,6 +50,10 @@ Event must have the DTSTART and DTEND attribute set." (end (add-day start))) (event-overlaps? ev start end))) +(define-public (event-zero-length? ev) + (and (datetime? (attr ev 'DTSTART)) + (not (attr ev 'DTEND)))) + (define-public (ev-time<? a b) (date/-time<? (attr a 'DTSTART) (attr b 'DTSTART))) @@ -51,42 +61,49 @@ Event must have the DTSTART and DTEND attribute set." ;; Returns length of the event @var{e}, as a time-duration object. (define-public (event-length e) (if (not (attr e 'DTEND)) - (datetime date: - (if (date? (attr e 'DTSTART)) - #24:00:00 - #01:00:00)) + (if (date? (attr e 'DTSTART)) + (date day: 1) + (datetime)) ((if (date? (attr e 'DTSTART)) date-difference datetime-difference) (attr e 'DTEND) (attr e 'DTSTART)))) (define-public (event-length/clamped start-date end-date e) - (if (date? (attr e 'DTSTART)) - (date-difference (date-min (date+ end-date (date day: 1)) - (attr e 'DTEND)) - (date-max start-date - (attr e 'DTSTART))) - (datetime-difference (datetime-min (datetime date: (date+ end-date (date day: 1))) - (attr e 'DTEND)) - (datetime-max (datetime date: start-date) - (attr e 'DTSTART))))) + (let ((end (or (attr e 'DTEND) + (if (date? (attr e 'DTSTART)) + (date+ (attr e 'DTSTART) (date day: 1)) + (attr e 'DTSTART))))) + (if (date? (attr e 'DTSTART)) + (date-difference (date-min (date+ end-date (date day: 1)) + end) + (date-max start-date + (attr e 'DTSTART))) + (datetime-difference (datetime-min (datetime date: (date+ end-date (date day: 1))) + end) + (datetime-max (datetime date: start-date) + (attr e 'DTSTART)))))) ;; Returns the length of the part of @var{e} which is within the day ;; starting at the time @var{start-of-day}. ;; currently the secund argument is a date, but should possibly be changed ;; to a datetime to allow for more explicit TZ handling? (define-public (event-length/day date e) - (let ((start (attr e 'DTSTART)) - (end (attr e 'DTEND))) - (cond [(date= date (as-date start) (as-date end)) - (time- (as-time end) (as-time start))] - ;; Starts today, end in future day - [(date= date (as-date start)) - (time- #24:00:00 (as-time start))] - ;; Ends today, start earlier day - [(date= date (as-date end)) - (as-time end)] - ;; start earlier date, end later date - [else #24:00:00]))) + (if (not (attr e 'DTEND)) + (if (date? (attr e 'DTSTART)) + #24:00:00 + (time)) + (let ((start (attr e 'DTSTART)) + (end (attr e 'DTEND))) + (cond [(date= date (as-date start) (as-date end)) + (time- (as-time end) (as-time start))] + ;; Starts today, end in future day + [(date= date (as-date start)) + (time- #24:00:00 (as-time start))] + ;; Ends today, start earlier day + [(date= date (as-date end)) + (as-time end)] + ;; start earlier date, end later date + [else #24:00:00])))) ;; 22:00 - 03:00 @@ -98,10 +115,12 @@ Event must have the DTSTART and DTEND attribute set." ;; For practical purposes, an event being long means that it shouldn't be rendered as a part ;; of a regular day. (define-public (long-event? ev) - (or (date? (attr ev 'DTSTART)) - (datetime<= (datetime date: (date day: 1)) - (datetime-difference (attr ev 'DTEND) - (attr ev 'DTSTART))))) + (if (date? (attr ev 'DTSTART)) + #t + (aif (attr ev 'DTEND) + (datetime<= (datetime date: (date day: 1)) + (datetime-difference it (attr ev 'DTSTART))) + #f))) ;; DTEND of the last instance of this event. @@ -121,7 +140,8 @@ Event must have the DTSTART and DTEND attribute set." (define-public (events-between start-date end-date events) (define (overlaps e) (timespan-overlaps? start-date (date+ end-date (date day: 1)) - (attr e 'DTSTART) (attr e 'DTEND))) + (attr e 'DTSTART) (or (attr e 'DTEND) + (attr e 'DTSTART)))) ((@ (srfi srfi-41) stream-filter) overlaps diff --git a/module/vcomponent/group.scm b/module/vcomponent/group.scm index 1e5728c6..72acbce9 100644 --- a/module/vcomponent/group.scm +++ b/module/vcomponent/group.scm @@ -26,7 +26,11 @@ ;; of tommorow, and finishes with the rest when it finds the first ;; object which begins tomorow (after midnight, exclusize). (filter-sorted-stream* - (lambda (e) (date/-time<? tomorow (attr e 'DTEND))) + (lambda (e) (date/-time<? tomorow + (or (attr e 'DTEND) + (if (date? (attr e 'DTSTART)) + (date+ (attr e 'DTSTART) (date day: 1)) + (attr e 'DTSTART))))) (lambda (e) (date/-time<=? tomorow (attr e 'DTSTART))) stream))) diff --git a/module/vcomponent/parse/component.scm b/module/vcomponent/parse/component.scm index c2d297fd..ea695696 100644 --- a/module/vcomponent/parse/component.scm +++ b/module/vcomponent/parse/component.scm @@ -109,20 +109,7 @@ (loop (cdr lst) (cons (make-vcomponent (string->symbol (cadr head))) stack))] [(string=? "END" (car head)) - ;; TODO This is an ugly hack until the rest of the code is updated - ;; to work on events without an explicit DTEND attribute. (when (eq? (type (car stack)) 'VEVENT) - (when (not (attr (car stack) 'DTEND)) - (set! (attr (car stack) 'DTEND) - (let ((start (attr (car stack) 'DTSTART))) - ;; p. 54, 3.6.1 - ;; If DTSTART is a date then it's an all - ;; day event. If DTSTART instead is a - ;; datetime then the event has a length - ;; of 0? - (if (date? start) - (date+ start (date day: 1)) - (datetime+ start (datetime time: (time hour: 1))))))) ;; This isn't part of the field values since we "need" ;; the type of DTSTART for UNTIL to work. |