Merge branch 'jcal'

4 files changed, 77 insertions, 43 deletions

diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm
index 9764f513..ca38bdf7 100644
--- a/module/calp/html/vcomponent.scm
+++ b/module/calp/html/vcomponent.scm
@@ -160,44 +160,42 @@
                      (end (prop ev 'DTEND)))
                  `(div (@ (class "timeinput"))
 
-                       (input (@ (type "date")
-                                 (name "dtstart-date")
-                                 (style "grid-column:1;grid-row:2")
-                                 (class "bind")
-                                 (data-property "--dtstart-date")
-                                 (value ,(date->string (as-date start)))))
-
-                       (input (@ (type "date")
-                                 (name "dtend-date")
-                                 (style "grid-column:1;grid-row:3")
-                                 (class "bind")
-                                 (data-property "--dtend-date")
-                                 ,@(when end `((value ,(date->string (as-date end)))))))
-
                        ,@(with-label
-                          "Heldag?"
-                          `(input (@ (type "checkbox")
-                                     (class "bind")
-                                     (data-bindby "bind_wholeday")
-                                     (style "display:none")
-                                     (name "wholeday"))))
-
-                       (input (@ (type "time")
-                                 (name "dtstart-time")
-                                 (class "bind")
-                                 (data-property "--dtstart-time")
-                                 (style "grid-column:3;grid-row:2;"
-                                   ,(when (date? start) "display:none"))
-                                 (value ,(time->string (as-time start)))))
-
-                       (input (@ (type "time")
-                                 (name "dtend-time")
-                                 (class "bind")
-                                 (data-property "--dtend-time")
-                                 (style "grid-column:3;grid-row:3;"
-                                   ,(when (date? end) "display:none"))
-                                 ,@(when end `((value ,(time->string (as-time end)))))
-                                 ))))
+                          "Starttid"
+                          `(div (@ (class "date-time bind")
+                                   (data-bindby "bind_date_time")
+                                   (name "dtstart"))
+                                (input (@ (type "date")
+                                          (value ,(date->string (as-date start)))))
+                                (input (@ (type "time")
+                                          (value ,(time->string (as-time start) "~H:~M"))
+                                          ,@(when (date? start) '((disabled)))
+                                          ))))
+
+                       ;; TODO some way to add an endtime if missing beforehand
+                       ;; TODO, actually proper support for event without end times
+                       ,@(when end
+                           (with-label
+                           "Sluttid"
+                           `(div (@ (class "date-time bind")
+                                    (data-bindby "bind_date_time")
+                                    (name "dtend"))
+                                 (input (@ (type "date")
+                                           (value ,(date->string (as-date end)))))
+                                 (input (@ (type "time")
+                                           (value ,(time->string (as-time end) "~H:~M"))
+                                           ,@(when (date? end) '((disabled))))))))
+
+                       (div
+                        ,@(with-label
+                           "Heldag?"
+                           `(input (@ (type "checkbox")
+                                      (class "bind")
+                                      (data-bindby "bind_wholeday")
+                                      (name "wholeday")
+                                      ,@(when (date? start) '((checked)))))))
+
+                       ))
 
               ,@(with-label
                  "Plats"
@@ -544,8 +542,9 @@
                 `(("📅" title: "Översikt"
                    ,(fmt-single-event ev))
 
-                  ("📅" title: "Redigera"
-                   ,(fmt-for-edit ev))
+                  ,@(when (edit-mode)
+                     `(("📅" title: "Redigera"
+                        ,(fmt-for-edit ev))))
 
                   ("⤓" title: "Nedladdning"
                    (div (@ (class "eventtext") (style "font-family:sans"))
@@ -558,7 +557,9 @@
                              ,@(when (debug)
                                  `((ul
                                     (li (button (@ (onclick "console.log(event_to_jcal(event_from_popup(this.closest('.popup-container'))));")) "js"))
-                                    (li (button (@ (onclick "console.log(jcal_to_xcal(event_to_jcal(event_from_popup(this.closest('.popup-container')))));")) "xml"))))))
+                                    (li (button (@ (onclick "console.log(jcal_to_xcal(event_to_jcal(event_from_popup(this.closest('.popup-container')))));")) "xml"))
+                                    (li (button (@ (onclick "console.log(event_from_popup(this.closest('.popup-container')))")) "this"))
+                                    ))))
                         ))
 
                   ,@(when (prop ev 'RRULE)
diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm
index 3f607bb7..f84d2133 100644
--- a/module/calp/html/view/calendar.scm
+++ b/module/calp/html/view/calendar.scm
@@ -115,8 +115,12 @@
     (script (@ (defer) (src "/static/server_connect.js")))
     (script (@ (defer) (src "/static/input_list.js")))
     (script (@ (defer) (src "/static/date_time.js")))
+    (script (@ (defer) (src "/static/vcal.js")))
     (script (@ (defer) (src "/static/script.js")))
-    ,(calendar-styles calendars))
+    ,(calendar-styles calendars)
+
+    ,@(when (debug)
+        '((style ".root { background-color: pink; }"))))
 
    (body
     (div (@ (class "root"))
diff --git a/module/calp/repl.scm b/module/calp/repl.scm
index d4f087aa..e6fbfe3d 100644
--- a/module/calp/repl.scm
+++ b/module/calp/repl.scm
@@ -31,4 +31,9 @@
                       [(address port) (make-tcp-server-socket host: address port: port)])
                     (string-split address #\:))]
      ;; currently impossible
-     [(IPv6) (error "How did you get here?")])))
+     [(IPv6) (error "How did you get here?")]))
+
+  ;; TODO setup repl environment here
+
+
+  )
diff --git a/module/vcomponent/xcal/parse.scm b/module/vcomponent/xcal/parse.scm
index 6ae8c2f9..124a91f4 100644
--- a/module/vcomponent/xcal/parse.scm
+++ b/module/vcomponent/xcal/parse.scm
@@ -58,7 +58,31 @@
                            ((@ (vcomponent recurrence parse)
                                rfc->datetime-weekday)
                             (string->symbol v)))
-                          (else v))))))]
+                          ((freq) (string->symbol v))
+                          ((until)
+                           ;; RFC 6321 (xcal), p. 30 specifies type-until as
+                           ;;     type-until = element until {
+                           ;;         type-date |
+                           ;;         type-date-time
+                           ;;     }
+                           ;; but doesn't bother defining type-date[-time]...
+                           ;; This is acknowledged in errata 3315 [1], but
+                           ;; it lacks a solution...
+                           ;; Seeing as RFC 7265 (jcal) in Example 2 (p. 16)
+                           ;; show the date as a direct string we will roll
+                           ;; with that here to.
+                           ;; [1]: https://www.rfc-editor.org/errata/eid3315
+                           (string->date/-time v))
+                        ((byday) #|TODO|#
+                         (throw 'not-yet-implemented))
+                        ((count interval bysecond bymunite byhour
+                                bymonthday byyearday byweekno
+                                bymonth bysetpos)
+                         (string->number v))
+                        (else (throw
+                               'key-error
+                               "Invalid key ~a, with value ~a"
+                               k v)))))))]
 
     [(time) (parse-iso-time (car value))]