Start rework on js setup.

3 files changed, 303 insertions, 189 deletions

diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm
index 105c6cc5..4b3e9ec7 100644
--- a/module/calp/html/vcomponent.scm
+++ b/module/calp/html/vcomponent.scm
@@ -62,54 +62,56 @@
                                   optional: (attributes '())
                                   key: (fmt-header list))
   ;; (format (current-error-port) "fmt-single-event: ~a~%" (prop ev 'X-HNH-FILENAME))
-  `(div (@ ,@(assq-merge
-              attributes
-              `((data-bindby "bind_view")
-                (class " eventtext summary-tab "
-                  ,(when (and (prop ev 'PARTSTAT)
-                              (eq? 'TENTATIVE (prop ev 'PARTSTAT)))
-                     " tentative ")))))
-        (h3 ,(fmt-header
-              (when (prop ev 'RRULE)
-                `(span (@ (class "repeating")) "↺"))
-              `(span (@ (class "bind summary")
-                        (data-property "summary"))
-                     ,(prop ev 'SUMMARY))))
-        (div
-         ,(call-with-values (lambda () (fmt-time-span ev))
-            (case-lambda [(start)
-                          `(div (time (@ (class "bind dtstart")
-                                         (data-property "dtstart")
-                                         (data-fmt ,(string-append "~L" start))
-                                         (datetime ,(datetime->string
-                                                     (as-datetime (prop ev 'DTSTART))
-                                                     "~1T~3")))
-                                      ,(datetime->string
-                                        (as-datetime (prop ev 'DTSTART))
-                                        start)))]
-                         [(start end)
-                          `(div (time (@ (class "bind dtstart")
-                                         (data-property "dtstart")
-                                         (data-fmt ,(string-append "~L" start))
-                                         (datetime ,(datetime->string
-                                                     (as-datetime (prop ev 'DTSTART))
-                                                     "~1T~3")))
-                                      ,(datetime->string (as-datetime (prop ev 'DTSTART))
-                                                         start))
-                                " — "
-                                (time (@ (class "bind dtend")
-                                         (data-property "dtend")
-                                         (data-fmt ,(string-append "~L" end))
-                                         (datetime ,(datetime->string
-                                                     (as-datetime (prop ev 'DTSTART))
-                                                     "~1T~3")))
-                                      ,(datetime->string (as-datetime (prop ev 'DTEND))
-                                                         end)))]))
-
-         ;; TODO add optional fields when added in frontend
-         ;; Possibly by always having them here, just hidden.
-
-         (div (@ (class "fields"))
+  `(vevent-description
+    (@ ,@(assq-merge
+          attributes
+          `(
+            (class " vevent eventtext summary-tab "
+              ,(when (and (prop ev 'PARTSTAT)
+                          (eq? 'TENTATIVE (prop ev 'PARTSTAT)))
+                 " tentative "))
+            (data-uid ,(prop ev 'UID)))))
+    (h3 ,(fmt-header
+          (when (prop ev 'RRULE)
+            `(span (@ (class "repeating")) "↺"))
+          `(span (@ (class "bind summary")
+                    (data-property "summary"))
+                 ,(prop ev 'SUMMARY))))
+    (div
+     ,(call-with-values (lambda () (fmt-time-span ev))
+        (case-lambda [(start)
+                      `(div (time (@ (class "bind dtstart")
+                                     (data-property "dtstart")
+                                     (data-fmt ,(string-append "~L" start))
+                                     (datetime ,(datetime->string
+                                                 (as-datetime (prop ev 'DTSTART))
+                                                 "~1T~3")))
+                                  ,(datetime->string
+                                    (as-datetime (prop ev 'DTSTART))
+                                    start)))]
+                     [(start end)
+                      `(div (time (@ (class "bind dtstart")
+                                     (data-property "dtstart")
+                                     (data-fmt ,(string-append "~L" start))
+                                     (datetime ,(datetime->string
+                                                 (as-datetime (prop ev 'DTSTART))
+                                                 "~1T~3")))
+                                  ,(datetime->string (as-datetime (prop ev 'DTSTART))
+                                                     start))
+                            " — "
+                            (time (@ (class "bind dtend")
+                                     (data-property "dtend")
+                                     (data-fmt ,(string-append "~L" end))
+                                     (datetime ,(datetime->string
+                                                 (as-datetime (prop ev 'DTSTART))
+                                                 "~1T~3")))
+                                  ,(datetime->string (as-datetime (prop ev 'DTEND))
+                                                     end)))]))
+
+     ;; TODO add optional fields when added in frontend
+     ;; Possibly by always having them here, just hidden.
+
+     (div (@ (class "fields"))
           ,(when (and=> (prop ev 'LOCATION) (negate string-null?))
              `(div (b "Plats: ")
                    (div (@ (class "bind location") (data-property "location"))
@@ -118,7 +120,7 @@
           ,(awhen (prop ev 'DESCRIPTION)
                   `(div (@ (class "bind description")
                            (data-property "description"))
-                         ,(format-description ev it)))
+                        ,(format-description ev it)))
 
           ,@(awhen (prop* ev 'ATTACH)
                    ;; attach satisfies @code{vline?}
@@ -193,123 +195,127 @@
              `(div (@ (class "last-modified")) "Senast ändrad "
                    ,(datetime->string (prop ev 'LAST-MODIFIED) "~1 ~H:~M"))))
 
-         )))
+     )))
 
 (define*-public (fmt-for-edit ev
                               optional: (attributes '())
                               key: (fmt-header list))
-  `(div (@ (class " eventtext edit-tab ")
-           (data-bindby "bind_edit"))
-        (form (@ (class "edit-form"))
-              (div (@ (class "dropdown-goes-here")))
-              (h3 (input (@ (type "text")
-                            (placeholder "Sammanfattning")
-                            (name "summary") (required)
-                            (class "bind") (data-property "summary")
-                            (value ,(prop ev 'SUMMARY)))))
-
-              ,(let ((start (prop ev 'DTSTART))
-                     (end (prop ev 'DTEND)))
-                 `(div (@ (class "timeinput"))
-
-                       ,@(with-label
-                          "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"
-                 `(input (@ (placeholder "Plats")
-                            (name "location")
-                            (type "text")
-                            (class "bind") (data-property "location")
-                            (value ,(or (prop ev 'LOCATION) "")))))
-
-              ,@(with-label
-                 "Beskrivning"
-                 `(textarea (@ (placeholder "Beskrivning")
-                               (class "bind") (data-property "description")
-                               (name "description"))
-                            ,(prop ev 'DESCRIPTION)))
-
-              ,@(with-label
-                 "Kategorier"
-                 ;; It would be better if these input-list's worked on the same
-                 ;; class=bind system as the fields above. The problem with that
-                 ;; is however that each input-list requires different search
-                 ;; and join procedures. Currently this is bound in the JS, see
-                 ;; [CATEGORIES_BIND].
-                 ;; It matches on ".input-list[data-property='categories']".
-                 `(div (@ (class "input-list")
-                          (data-property "categories"))
-                       ,@(awhen (prop ev 'CATEGORIES)
-                                (map (lambda (c)
-                                       `(input (@ (size 2)
-                                                  (class "unit")
-                                                  (value ,c))))
-                                     it))
-
-                       (input (@ (class "unit final")
-                                 (size 2)
-                                 (type "text")
+  `(vevent-edit (@ (class "vevent")
+                   (data-uid ,(prop ev 'UID)))))
+
+(define-public (edit-template)
+ `(div (@ (class " eventtext edit-tab "))
+       (form (@ (class "edit-form"))
+             (div (@ (class "dropdown-goes-here")))
+             (h3 (input (@ (type "text")
+                           (placeholder "Sammanfattning")
+                           (name "summary") (required)
+                           (class "bind") (data-property "summary")
+                           ; (value ,(prop ev 'SUMMARY))
+                           )))
+
+             (div (@ (class "timeinput"))
+
+                  ,@(with-label
+                     "Starttid"
+                     `(div (@ (class "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
+                  ,@(with-label
+                     "Sluttid"
+                     `(div (@ (class "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")
+                                 (name "wholeday")
+                                 ; ,@(when (date? start) '((checked)))
                                  ))))
 
-              (hr)
-
-              ;; For custom user fields
-              ;; TODO these are currently not bound to anything, so entering data
-              ;; here does nothing. Bigest hurdle to overcome is supporting arbitrary
-              ;; fields which will come and go in the JavaScript.
-              ;; TODO also, all (most? maybe not LAST-MODIFIED) remaining properties
-              ;; should be exposed here.
-              (div (@ (class "input-list"))
-               (div (@ (class "unit final newfield"))
-                    (input (@ (type "text")
-                              (list "known-fields")
-                              (placeholder "Nytt fält")))
-                    (select (@ (name "TYPE"))
-                      (option (@ (value "TEXT")) "Text"))
-                    (span
-                     (input (@ (type "text")
-                               (placeholder "Värde"))))))
-
-              (hr)
-
-
-              (input (@ (type "submit")))
-              )))
+                  )
+
+             ,@(with-label
+                "Plats"
+                `(input (@ (placeholder "Plats")
+                           (name "location")
+                           (type "text")
+                           (data-property "location")
+                           ; (value ,(or (prop ev 'LOCATION) ""))
+                           )))
+
+             ,@(with-label
+                "Beskrivning"
+                `(textarea (@ (placeholder "Beskrivning")
+                              (data-property "description")
+                              (name "description"))
+                           ; ,(prop ev 'DESCRIPTION)
+                           ))
+
+             ,@(with-label
+                "Kategorier"
+                ;; It would be better if these input-list's worked on the same
+                ;; class=bind system as the fields above. The problem with that
+                ;; is however that each input-list requires different search
+                ;; and join procedures. Currently this is bound in the JS, see
+                ;; [CATEGORIES_BIND].
+                ;; It matches on ".input-list[data-property='categories']".
+                `(div (@ (class "input-list")
+                         (data-property "categories"))
+                      #;
+                      ,@(awhen (prop ev 'CATEGORIES)
+                               (map (lambda (c)
+                                      `(input (@ (size 2)
+                                                 (class "unit")
+                                                 (value ,c))))
+                                    it))
+
+                      (input (@ (class "unit final")
+                                (size 2)
+                                (type "text")
+                                ))))
+
+             (hr)
+
+             ;; For custom user fields
+             ;; TODO these are currently not bound to anything, so entering data
+             ;; here does nothing. Bigest hurdle to overcome is supporting arbitrary
+             ;; fields which will come and go in the JavaScript.
+             ;; TODO also, all (most? maybe not LAST-MODIFIED) remaining properties
+             ;; should be exposed here.
+             (div (@ (class "input-list"))
+                  (div (@ (class "unit final newfield"))
+                       (input (@ (type "text")
+                                 (list "known-fields")
+                                 (placeholder "Nytt fält")))
+                       (select (@ (name "TYPE"))
+                         (option (@ (value "TEXT")) "Text"))
+                       (span
+                        (input (@ (type "text")
+                                  (placeholder "Värde"))))))
+
+             (hr)
+
+
+             (input (@ (type "submit")))
+             )))
 
 
 ;; Single event in side bar (text objects)
@@ -357,12 +363,12 @@
 
   `((a (@ (href "#" ,(html-id ev))
           (class "hidelink"))
-       (div (@ ,@(assq-merge
+       (vevent-block (@ ,@(assq-merge
                   extra-attributes
                   `((id ,(html-id ev))
                     (data-calendar ,(html-attr (or (prop (parent ev) 'NAME) "unknown")))
                     ;; (data-bindon "bind_view")
-                    (class "event CAL_" ,(html-attr (or (prop (parent ev) 'NAME)
+                    (class "vevent event CAL_" ,(html-attr (or (prop (parent ev) 'NAME)
                                                         "unknown"))
                       ,(when (and (prop ev 'PARTSTAT)
                                   (eq? 'TENTATIVE (prop ev 'PARTSTAT)))
@@ -371,6 +377,7 @@
                                   (eq? 'TRANSPARENT (prop ev 'TRANSP)))
                          " transparent")
                       )
+                    (data-uid ,(prop ev 'UID))
                     (onclick "toggle_popup('popup' + this.id)")
                     )))
             ;; Inner div to prevent overflow. Previously "overflow: none"
@@ -391,10 +398,12 @@
              ,(when (and=> (prop ev 'DESCRIPTION) (negate string-null?))
                 `(span (@ (class "description"))
                        "🗎")))
+            #;
             (div (@ (style "display:none !important;"))
                  ,((@ (vcomponent xcal output) ns-wrap)
                    ((@ (vcomponent xcal output) vcomponent->sxcal)
-                    ev)))))))
+            ev)))
+            ))))
 
 
 (define (repeat-info event)
diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm
index 4574f517..00451984 100644
--- a/module/calp/html/view/calendar.scm
+++ b/module/calp/html/view/calendar.scm
@@ -111,12 +111,16 @@
     (script (@ (defer) (src "/static/clock.js")))
     (script (@ (defer) (src "/static/popup.js")))
     (script (@ (defer) (src "/static/rrule.js")))
-    (script (@ (defer) (src "/static/binders.js")))
+    ;; (script (@ (defer) (src "/static/binders.js")))
     (script (@ (defer) (src "/static/server_connect.js")))
-    (script (@ (defer) (src "/static/input_list.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/vcal.js")))
     (script (@ (defer) (src "/static/script.js")))
+    (script (@ (defer) (src "/static/globals.js")))
+
+    ;; on load
+
     ,(calendar-styles calendars)
 
     ,@(when (debug)
@@ -251,15 +255,15 @@
                                 `(li (@ (class "CAL_"
                                           ,(html-attr (prop calendar 'NAME))))
                                      (a (@ (href "/search?"
-                                            ,((@ (web uri-query) encode-query-parameters)
-                                              `((q . (and (date/-time<=?
-                                                           ,(current-datetime)
-                                                           (prop event 'DTSTART))
-                                                          ;; TODO this seems to miss some calendars,
-                                                          ;; I belive it's due to some setting X-WR-CALNAME,
-                                                          ;; which is only transfered /sometimes/ into NAME.
-                                                          (string=? ,(->string (prop calendar 'NAME))
-                                                                    (or (prop (parent event) 'NAME) ""))))))))
+                                                 ,((@ (web uri-query) encode-query-parameters)
+                                                   `((q . (and (date/-time<=?
+                                                                ,(current-datetime)
+                                                                (prop event 'DTSTART))
+                                                               ;; TODO this seems to miss some calendars,
+                                                               ;; I belive it's due to some setting X-WR-CALNAME,
+                                                               ;; which is only transfered /sometimes/ into NAME.
+                                                               (string=? ,(->string (prop calendar 'NAME))
+                                                                         (or (prop (parent event) 'NAME) ""))))))))
                                         ,(prop calendar 'NAME))))
                               calendars))
                        (div (@ (id "calendar-dropdown-template") (class "template"))
@@ -311,17 +315,19 @@
                                     ;; it.
                                     description: ""))))
              (event (car (children cal))))
-        `((div (@ (class "template event-container") (id "event-template")
-                  ;; Only needed to create a duration. So actual dates
-                  ;; dosen't matter
-                  (data-start "2020-01-01")
-                  (data-end "2020-01-02"))
-               ,(caddar          ; strip <a> tag
-                 (make-block event `((class " generated ")))))
+        `(
+          ;; (div (@ (class "template event-container") (id "event-template")
+          ;;         ;; Only needed to create a duration. So actual dates
+          ;;         ;; dosen't matter
+          ;;         (data-start "2020-01-01")
+          ;;         (data-end "2020-01-02"))
+          ;;      ,(caddar          ; strip <a> tag
+          ;;        (make-block event `((class " generated ")))))
           ;; TODO merge this into the event-set, add attribute
           ;; for non-displaying elements.
-          (div (@ (class "template") (id "popup-template"))
-               ,(popup event (string-append "popup" (html-id event))))))
+          ;; (div (@ (class "template") (id "popup-template"))
+          ;;      ,(popup event (string-append "popup" (html-id event))))
+          ))
 
     ;; Auto-complets when adding new fields to a component
     ;; Any string is however still valid.
@@ -344,4 +350,18 @@
                        RDATE RRULE ACTION REPEAT
                        TRIGGER CREATED DTSTAMP LAST-MODIFIED
                        SEQUENCE REQUEST-STATUS
-                       ))))))
+                       )))
+
+    (div (@ (style "display:none !important;")
+            (id "xcal-data"))
+         ,((@ (vcomponent xcal output) ns-wrap)
+           (map (@ (vcomponent xcal output) vcomponent->sxcal)
+                (stream->list
+                 (filter-sorted-stream
+                  (lambda (ev)
+                    ((@ (vcomponent datetime) event-overlaps?)
+                     ev start-date
+                     (date+ end-date (date day: 1))))
+                  events))))))
+
+    ))
diff --git a/module/calp/html/view/calendar/week.scm b/module/calp/html/view/calendar/week.scm
index 556c3d85..340db7d5 100644
--- a/module/calp/html/view/calendar/week.scm
+++ b/module/calp/html/view/calendar/week.scm
@@ -52,10 +52,95 @@
 
                 ,@(for event in (stream->list
                                  (events-between start-date end-date events))
-                       ((@ (calp html vcomponent ) popup) event (string-append "popup" (html-id event))))
-
-                )))))
-
+                       ((@ (calp html vcomponent ) popup)
+                        event (string-append "popup" (html-id event))))
+
+                ))
+      ;; description in sidebar / tab of popup
+      (template (@ (id "vevent-description"))
+                ,(description-template)
+                )
+
+      ;; edit tab of popup
+      (template (@ (id "vevent-edit"))
+                ,((@ (calp html vcomponent) edit-template)))
+
+      ;; "physical" block
+      (template (@ (id "vevent-block"))
+                ,(block-template)
+                )
+
+      )))
+
+;; based on the output of fmt-single-event
+(define (description-template)
+  '(div (@ (class " eventtext summary-tab " ()))
+        (h3 ((span (@ (class "repeating")) "↺")
+             (span (@ (class "bind summary")
+                      (data-property "summary"))
+                   "Test")))
+        (div (div (time (@ (class "bind dtstart")
+                           (data-property "dtstart")
+                           (data-fmt "~L~H:~M")
+                           (datetime "2021-09-29T19:56:46"))
+                        "19:56")
+                  "\xa0—\xa0"
+                  (time (@ (class "bind dtend")
+                           (data-property "dtend")
+                           (data-fmt "~L~H:~M")
+                           (datetime "2021-09-29T19:56:46"))
+                        "20:56"))
+             (div (@ (class "fields"))
+                  (div (b "Plats: ")
+                       (div (@ (class "bind location")
+                               (data-property "location"))
+                            "Alsättersgatan 13"))
+                  (div (@ (class "bind description")
+                          (data-property "description"))
+                       ("With a description"))
+                  (div (@ (class "categories"))
+                       (a (@ (class "category")
+                             (href "/search/?"
+                                   "q=%28member%20%22test%22%20%28or%20%28prop%20event%20%28quote%20CATEGORIES%29%29%20%28quote%20%28%29%29%29%29"))
+                          test))
+                  (div (@ (class "rrule"))
+                       "Upprepas "
+                       "varje vecka"
+                       ".")
+                  (div (@ (class "last-modified"))
+                       "Senast ändrad "
+                       "2021-09-29 19:56")))))
+
+(define (block-template)
+  `(div (@ ; (id ,(html-id ev))
+           (data-calendar "unknown")
+           (class "event CAL_unknown" 
+             ;; ,(when (and (prop ev 'PARTSTAT)
+             ;;             (eq? 'TENTATIVE (prop ev 'PARTSTAT)))
+             ;;    " tentative")
+             ;; ,(when (and (prop ev 'TRANSP)
+             ;;             (eq? 'TRANSPARENT (prop ev 'TRANSP)))
+             ;;    " transparent")
+             )
+           (onclick "toggle_popup('popup' + this.id)")
+           )
+        ;; Inner div to prevent overflow. Previously "overflow: none"
+        ;; was set on the surounding div, but the popup /needs/ to
+        ;; overflow (for the tabs?).
+        (div (@ (class "event-body"))
+             `(span (@ (class "repeating")) ; "↺"
+                    )
+             (span (@ (class "bind summary")
+                      (data-property "summary"))
+                   ; ,(format-summary  ev (prop ev 'SUMMARY))
+                   )
+             `(span (@ (class "bind location")
+                       (data-property "location")))
+             ;; Document symbol when we have text
+             `(span (@ (class "description"))
+                    ; "🗎"
+                    ))
+        ) )
 
 
 (define (time-marker-div)