Calendar colors now handled through html datasets.

Previously css rules for each calendar (governing color) where handled
through CSS classes. This however had the problem that all calendar
names needed to be mapped unto valid classnames, and it brought some
problems with updating it.

This change places the calendar information in the dataset.calendar
attribute. It's still base64 encoded, so special characters don't need
escaping, and XML doesn't trip up.

5 files changed, 31 insertions, 62 deletions

diff --git a/module/calp/html/util.scm b/module/calp/html/util.scm
index cd5aaeab..40852279 100644
--- a/module/calp/html/util.scm
+++ b/module/calp/html/util.scm
@@ -1,42 +1,11 @@
 (define-module (calp html util)
-  :use-module ((base64) :select (base64encode base64decode))
   :use-module (calp util))
 
-;;; @var{html-attr} & @var{html-unattr} used to just strip any
-;;; attributes not valid in css. That allowed a human reader to
-;;; quickly see what data it was. The downside was that it was one
-;;; way. The new base64 based system supports both an encode and a
-;;; decode without problem.
-;;;
-;;; The encoded string substitutes { + => å, / => ä, = => ö } to be
-;;; valid CSS selector names.
-
-;; Retuns an HTML-safe version of @var{str}.
-(define-public (html-attr str)
-  (string-map (lambda (c)
-                (case c
-                  ((#\+) #\å)
-                  ((#\/) #\ä)
-                  ((#\=) #\ö)
-                  (else c)))
-              (base64encode str)))
-
-(define-public (html-unattr str)
-  (base64decode
-    (string-map (lambda (c)
-                  (case c
-                    ((#\å) #\+)
-                    ((#\ä) #\/)
-                    ((#\ö) #\=)
-                    (else c)))
-                str)))
-
 
 (define-public (date-link date)
   ((@ (datetime) date->string) date "~Y-~m-~d"))
 
 
-
 ;; Generate an html id for an event.
 ;; TODO? same event placed multiple times, when spanning multiple cells
 (define-public html-id
diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm
index d1cd4886..b2959df5 100644
--- a/module/calp/html/vcomponent.scm
+++ b/module/calp/html/vcomponent.scm
@@ -23,6 +23,7 @@
                         format-recurrence-rule
                                       ))
   :use-module ((calp util config) :select (get-config))
+  :use-module ((base64) :select (base64encode))
   )
 
 (define-public (compact-event-list list)
@@ -35,11 +36,12 @@
 
   (define (summary event)
     `(summary (div (@ (class "summary-line "))
-                   (span (@ (class "square CAL_"
-                              ,(html-attr
-                                (or (prop (parent event)
-                                          'NAME)
-                                    "unknown")))))
+                   (span (@ (class "square")
+                            (data-calendar
+                             ,(base64encode
+                               (or (prop (parent event)
+                                         'NAME)
+                                   "unknown")))))
                    (time ,(let ((dt (prop event 'DTSTART)))
                             (if (datetime? dt)
                                 (datetime->string dt "~Y-~m-~d ~H:~M")
@@ -212,7 +214,7 @@
                ,@(let ((dflt (get-config 'default-calendar)))
                    (map (lambda (calendar)
                           (define name (prop calendar 'NAME))
-                          `(option (@ (value ,(html-attr name))
+                          `(option (@ (value ,(base64encode name))
                                       ,@(when (string=? name dflt)
                                           '((selected))))
                                    ,name))
@@ -363,7 +365,7 @@
                   (lambda (ev)
                     (fmt-single-event
                       ev `((id ,(html-id ev))
-                           (class "CAL_" ,(html-attr (or (prop (parent ev) 'NAME) "unknown"))))
+                           (data-calendar ,(base64encode (or (prop (parent ev) 'NAME) "unknown"))))
                       fmt-header:
                       (lambda body
                         `(a (@ (href "#" ,(html-id ev) #; (date-link (as-date (prop ev 'DTSTART)))
@@ -382,14 +384,14 @@
 
 (define-public (calendar-styles calendars)
   `(style
-     ,(format #f "~:{.CAL_~a { --color: ~a; --complement: ~a }~%~}"
-              (map (lambda (c)
-                     (let* ((name (html-attr (prop c 'NAME)))
-                            (bg-color (prop c 'COLOR))
-                            (fg-color (and=> (prop c 'COLOR)
-                                             calculate-fg-color)))
-                       (list name (or bg-color 'white) (or fg-color 'black))))
-                   calendars))))
+       ,(lambda () (format #t "~:{ [data-calendar=\"~a\"] { --color: ~a; --complement: ~a }~%~}"
+                      (map (lambda (c)
+                             (let* ((name (base64encode (prop c 'NAME)))
+                                    (bg-color (prop c 'COLOR))
+                                    (fg-color (and=> (prop c 'COLOR)
+                                                     calculate-fg-color)))
+                               (list name (or bg-color 'white) (or fg-color 'black))))
+                           calendars)))))
 
 ;; "Physical" block in calendar view
 (define*-public (make-block ev optional: (extra-attributes '()))
@@ -399,10 +401,9 @@
        (vevent-block (@ ,@(assq-merge
                   extra-attributes
                   `((id ,(html-id ev))
-                    (data-calendar ,(html-attr (or (prop (parent ev) 'NAME) "unknown")))
+                    (data-calendar ,(base64encode (or (prop (parent ev) 'NAME) "unknown")))
                     ;; (data-bindon "bind_view")
-                    (class "vevent event CAL_" ,(html-attr (or (prop (parent ev) 'NAME)
-                                                        "unknown"))
+                    (class "vevent event"
                       ,(when (and (prop ev 'PARTSTAT)
                                   (eq? 'TENTATIVE (prop ev 'PARTSTAT)))
                          " tentative")
@@ -619,9 +620,11 @@
 
 (define-public (popup ev id)
   (warning "popup is deprecated")
-  `(div (@ (id ,id) (class "popup-container CAL_"
-                           ,(html-attr (or (prop (parent ev) 'NAME)
-                                           "unknown")))
+  `(div (@ (id ,id)
+           (class "popup-container")
+           (data-calendar
+            ,(base64encode (or (prop (parent ev) 'NAME)
+                                "unknown")))
            (onclick "event.stopPropagation()"))
         ;; TODO all (?) code uses .popup-container as the popup, while .popup sits and does nothing.
         ;; Do something about this?
diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm
index 82cccdf3..634f6a69 100644
--- a/module/calp/html/view/calendar.scm
+++ b/module/calp/html/view/calendar.scm
@@ -27,6 +27,7 @@
 
   :use-module ((vcomponent group)
                :select (group-stream get-groups-between))
+  :use-module ((base64) :select (base64encode))
   )
 
 
@@ -260,8 +261,7 @@
                        (summary "Calendar list")
                        (ul ,@(map
                               (lambda (calendar)
-                                `(li (@ (class "CAL_"
-                                          ,(html-attr (prop calendar 'NAME))))
+                                `(li (@ (data-calendar ,(base64encode (prop calendar 'NAME))))
                                      (a (@ (href "/search?"
                                                  ,((@ (web uri-query) encode-query-parameters)
                                                    `((q . (and (date/-time<=?
diff --git a/module/calp/html/view/calendar/week.scm b/module/calp/html/view/calendar/week.scm
index cc89d77b..f6461f2f 100644
--- a/module/calp/html/view/calendar/week.scm
+++ b/module/calp/html/view/calendar/week.scm
@@ -86,10 +86,7 @@
       (template
        (@ (id "popup-template"))
        (div (@ ; (id ,id)
-             (class "popup-container CAL_"
-               #; 
-               ,(html-attr (or (prop (parent ev) 'NAME) ;
-               "unknown")))
+             (class "popup-container")
              (onclick "event.stopPropagation()"))
             (div (@ (class "popup"))
                  (nav (@ (class "popup-control"))
@@ -203,6 +200,7 @@
 (define (block-template)
   `(div (@ ; (id ,(html-id ev))
            (data-calendar "unknown")
+           #;
            (class " CAL_unknown"
              ;; ,(when (and (prop ev 'PARTSTAT)
              ;;             (eq? 'TENTATIVE (prop ev 'PARTSTAT)))
diff --git a/module/calp/server/routes.scm b/module/calp/server/routes.scm
index b024ed4f..0bbd1579 100644
--- a/module/calp/server/routes.scm
+++ b/module/calp/server/routes.scm
@@ -20,7 +20,7 @@
   :use-module ((rnrs io ports) :select (get-bytevector-all))
   :use-module ((xdg basedir) :prefix xdg-)
 
-  :use-module ((calp html util) :select (html-unattr))
+  :use-module ((base64) :select (base64decode))
 
   :use-module (web http make-routes)
 
@@ -162,8 +162,7 @@
                       (format #f "No event with UID '~a'" uid))))
 
    ;; TODO this fails when dtstart is <date>.
-   ;; @var{cal} should be the name of the calendar encoded with
-   ;; modified base64. See (calp html util).
+   ;; @var{cal} should be the name of the calendar encoded in base64.
    (POST "/insert" (cal data)
 
          (unless (and cal data)
@@ -174,7 +173,7 @@
          ;; NOTE that this leaks which calendar exists,
          ;; but you can only query for existance.
          ;; also, the calendar view already show all calendars.
-         (let* ((calendar-name (html-unattr cal))
+         (let* ((calendar-name (base64decode cal))
                 (calendar
                   (find (lambda (c) (string=? calendar-name (prop c 'NAME)))
                         (get-calendars global-event-object))))