aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@hornquist.se>2019-04-22 18:33:32 +0200
committerHugo Hörnquist <hugo@hornquist.se>2019-04-22 18:33:32 +0200
commit6b600d3ee57f2b6ad4eda1e020d207cbfc1a817f (patch)
treec16eda62ecba1af2553a10a0816c137259a9e386
parentGeneral cleanup. (diff)
downloadcalp-6b600d3ee57f2b6ad4eda1e020d207cbfc1a817f.tar.gz
calp-6b600d3ee57f2b6ad4eda1e020d207cbfc1a817f.tar.xz
Made multi day events appear in HTML.
-rw-r--r--module/html/html.scm10
-rw-r--r--module/srfi/srfi-41/util.scm11
2 files changed, 19 insertions, 2 deletions
diff --git a/module/html/html.scm b/module/html/html.scm
index d81faaaf..bb964963 100644
--- a/module/html/html.scm
+++ b/module/html/html.scm
@@ -18,9 +18,15 @@
(stream in-stream))
(if (stream-null? stream)
stream-null
- (let ((day (stream-car days)))
+ (let* ((day (stream-car days))
+ (tomorow (add-day (date->time-utc (drop-time day)))))
(let ((head (stream-take-while (ein? day) stream))
- (tail (stream-drop-while (ein? day) stream)))
+ (tail
+ (filter-sorted-stream*
+ (lambda (e) (time<? tomorow (attr e 'DTEND)))
+ (lambda (e) (time<=? tomorow (attr e 'DTSTART)))
+ stream)))
+
(stream-cons (cons day head)
(loop (stream-cdr days)
tail)))))))
diff --git a/module/srfi/srfi-41/util.scm b/module/srfi/srfi-41/util.scm
index 2492d088..56c50ce9 100644
--- a/module/srfi/srfi-41/util.scm
+++ b/module/srfi/srfi-41/util.scm
@@ -26,6 +26,17 @@
proc (stream-drop-while
(negate proc) stream)))
+(define-public (filter-sorted-stream* pred? keep-remaining? stream)
+ (cond [(stream-null? stream) stream-null]
+ [(keep-remaining? (stream-car stream)) stream]
+ [(pred? (stream-car stream))
+ (stream-cons (stream-car stream)
+ (filter-sorted-stream*
+ pred? keep-remaining?
+ (stream-cdr stream)))]
+ [else (filter-sorted-stream* pred? keep-remaining?
+ (stream-cdr stream))]))
+
(define-public (stream-find pred stream)
(cond ((stream-null? stream) #f)
((pred (stream-car stream)) (stream-car stream))