Move time procedures from main to where they belong.

3 files changed, 44 insertions, 40 deletions

diff --git a/main.scm b/main.scm
index 54d23d19..95647810 100755
--- a/main.scm
+++ b/main.scm
@@ -12,6 +12,7 @@
              (texinfo string-utils)     ; string->wrapped-lines
              (util)
              (vcalendar)
+             (vcalendar datetime)
              (vcalendar output)
              (terminal escape)
              (terminal util))
@@ -25,44 +26,6 @@
 
 #; (define pizza-event (search cal "pizza"))
 
-;;    A          B          C          D         ¬E
-;; |s1|     :     |s2| : |s1|     :     |s2| : |s1|
-;; |  |     :     |  | : |  ||s2| : |s1||  | : |  |
-;; |  ||s2| : |s1||  | : |  ||  | : |  ||  | :
-;;     |  | : |  |     : |  ||  | : |  ||  | :     |s2|
-;;     |  | : |  |     : |  |     :     |  | :     |  |
-(define (timespan-overlaps? s1-begin s1-end s2-begin s2-end)
-  "Return whetever or not two timespans overlap."
-  (or
-   ;; A
-   (and (time<=? s2-begin s1-end)
-        (time<=? s1-begin s2-end))
-
-   ;; B
-   (and (time<=? s1-begin s2-end)
-        (time<=? s2-begin s1-end))
-
-   ;; C
-   (and (time<=? s1-begin s2-begin)
-        (time<=? s2-end s1-end))
-
-   ;; D
-   (and (time<=? s2-begin s1-begin)
-        (time<=? s1-end s2-end))))
-
-(define (event-overlaps? event begin end)
-  "Returns if the event overlaps the timespan.
-Event must have the DTSTART and DTEND attribute set."
-  (timespan-overlaps? (attr event 'DTSTART)
-                      (attr event 'DTEND)
-                      begin end))
-
-(define-public (event-in? ev time)
-  (let* ((date (time-utc->date time))
-         (start (date->time-utc (drop-time date)))
-         (end (add-duration start (make-duration (* 60 60 24)))))
-    (event-overlaps? ev start end)))
-
 (define (trim-to-width str len)
   (let ((trimmed (string-pad-right str len)))
     (if (< (string-length trimmed)
diff --git a/srfi/srfi-19/util.scm b/srfi/srfi-19/util.scm
index 2ec7140d..f1346f78 100644
--- a/srfi/srfi-19/util.scm
+++ b/srfi/srfi-19/util.scm
@@ -56,3 +56,28 @@ attribute set to 0. Can also be seen as \"Start of day\""
 
 (define (remove-day time)
   (add-duration time (make-time time-duration 0 (- (* 60 60 24)))))
+
+;;    A          B          C          D         ¬E
+;; |s1|     :     |s2| : |s1|     :     |s2| : |s1|
+;; |  |     :     |  | : |  ||s2| : |s1||  | : |  |
+;; |  ||s2| : |s1||  | : |  ||  | : |  ||  | :
+;;     |  | : |  |     : |  ||  | : |  ||  | :     |s2|
+;;     |  | : |  |     : |  |     :     |  | :     |  |
+(define-public (timespan-overlaps? s1-begin s1-end s2-begin s2-end)
+  "Return whetever or not two timespans overlap."
+  (or
+   ;; A
+   (and (time<=? s2-begin s1-end)
+        (time<=? s1-begin s2-end))
+
+   ;; B
+   (and (time<=? s1-begin s2-end)
+        (time<=? s2-begin s1-end))
+
+   ;; C
+   (and (time<=? s1-begin s2-begin)
+        (time<=? s2-end s1-end))
+
+   ;; D
+   (and (time<=? s2-begin s1-begin)
+        (time<=? s1-end s2-end))))
diff --git a/vcalendar/datetime.scm b/vcalendar/datetime.scm
index 9f47f5c3..360b8348 100644
--- a/vcalendar/datetime.scm
+++ b/vcalendar/datetime.scm
@@ -1,14 +1,16 @@
 (define-module (vcalendar datetime)
+  #:use-module (vcalendar)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-19 util)
 
-  #:export (parse-datetime)
+  #:export (parse-datetime
+            event-overlaps?
+            event-in?)
   )
 
 (define (parse-datetime dtime)
   "Parse the given date[time] string into a date object."
   ;; localize-date
-  
   (date->time-utc
    (string->date
     dtime
@@ -16,3 +18,17 @@
       ((8) "~Y~m~d")
       ((15) "~Y~m~dT~H~M~S")
       ((16) "~Y~m~dT~H~M~S~z")))))
+
+(define (event-overlaps? event begin end)
+  "Returns if the event overlaps the timespan.
+Event must have the DTSTART and DTEND attribute set."
+  (timespan-overlaps? (attr event 'DTSTART)
+                      (attr event 'DTEND)
+                      begin end))
+
+(define (event-in? ev time)
+  "Does event overlap the date that contains time."
+  (let* ((date (time-utc->date time))
+         (start (date->time-utc (drop-time date)))
+         (end (add-duration start (make-duration (* 60 60 24)))))
+    (event-overlaps? ev start end)))