From 88e14917882b0c3f79e942b61027882fe9a7fe87 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Sun, 24 May 2020 22:31:08 +0200
Subject: Handle events with no DTEND.

---
 module/output/html.scm                | 20 +++++---
 module/vcomponent/datetime.scm        | 86 +++++++++++++++++++++--------------
 module/vcomponent/group.scm           |  6 ++-
 module/vcomponent/parse/component.scm | 13 ------
 static/style.css                      |  9 ++++
 5 files changed, 80 insertions(+), 54 deletions(-)

diff --git a/module/output/html.scm b/module/output/html.scm
index 64859c2d..8ca831f0 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -97,10 +97,12 @@
         [else ; guaranteed datetime
          (let ((s (attr ev 'DTSTART))
                (e (attr ev 'DTEND)))
-           (let ((fmt-str (if (date= (get-date s) (get-date e))
-                              "~H:~M" "~Y-~m-~d ~H:~M")))
-             (values (datetime->string s fmt-str)
-                     (datetime->string e fmt-str))))]))
+           (if e
+               (let ((fmt-str (if (date= (get-date s) (get-date e))
+                                  "~H:~M" "~Y-~m-~d ~H:~M")))
+                 (values (datetime->string s fmt-str)
+                         (datetime->string e fmt-str)))
+               (datetime->string s "~Y-~m-~d ~H:~M")))]))
 
 
 
@@ -241,7 +243,7 @@
    ev `((class
           ,(when (date<? (as-date (attr ev 'DTSTART)) date)
              " continued")
-          ,(when (date<? date (as-date (attr ev 'DTEND)))
+          ,(when (and (attr ev 'DTEND) (date<? date (as-date (attr ev 'DTEND))))
              " continuing"))
         (style ,style))))
 
@@ -282,7 +284,8 @@
    ev `((class
           ,(when (date/-time< (attr ev 'DTSTART) start-date)
              " continued")
-          ,(when (date/-time< (date+ end-date (date day: 1)) (attr ev 'DTEND))
+          ,(when (and (attr ev 'DTEND)
+                      (date/-time< (date+ end-date (date day: 1)) (attr ev 'DTEND)))
              " continuing"))
         (style ,style))))
 
@@ -292,7 +295,8 @@
 (define (lay-out-day day)
   (let* (((day-date . events) day)
          (time-obj (datetime date: day-date))
-         (short-events (stream->list events)))
+         (zero-length-events short-events
+                             (partition event-zero-length? (stream->list events))))
 
     (fix-event-widths! short-events event-length-key:
                        (lambda (e) (event-length/day day-date e)))
@@ -301,6 +305,8 @@
           ,@(map (lambda (time)
                    `(div (@ (class "clock clock-" ,time)) ""))
                  (iota 12 0 2))
+          (div (@ (class "zero-width-events"))
+               ,(map make-block zero-length-events))
           ,@(map (lambda (e) (create-block day-date e)) short-events))))
 
 
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.
diff --git a/static/style.css b/static/style.css
index 875adc18..9b680a52 100644
--- a/static/style.css
+++ b/static/style.css
@@ -499,6 +499,15 @@ along with their colors.
     width: 100%;
 }
 
+.zero-width-events .event {
+    width: initial;
+    padding: 0.5em;
+    margin: 0.2em;
+    border-radius: 1ex;
+    position: relative;
+    float: left;
+}
+
 .events .event.continuing {
     border-bottom: none;
     background-image: linear-gradient(to top, #0007 0%,#FFF0 2em);
-- 
cgit v1.2.3