Allow HTML output of all routes.

XHTML is still the far supperior format. However; Chrome(-like) browsers Lighthouse feature is worth quite a bit when it comes to ensuring a good web page, and Lighthouse refuses to work on anything except text/html. This is my work-around for that.
author: Hugo Hörnquist <hugo@lysator.liu.se> 2022-06-12 00:13:02 +0200
committer: Hugo Hörnquist <hugo@lysator.liu.se> 2022-06-12 00:13:02 +0200
commit: da8d1467dff8b27af7a3ae649d92ead5cbf704d8 (patch)
tree: cd4231abb8ec24d79dd3a4a8b5e563ee2bb82219
parent: Add number of TODO's. (diff)
parent: Handle error for user-additions salar. (diff)
download: calp-da8d1467dff8b27af7a3ae649d92ead5cbf704d8.tar.gz
calp-da8d1467dff8b27af7a3ae649d92ead5cbf704d8.tar.xz
11 files changed, 440 insertions, 63 deletions
diff --git a/module/calp/html/components.scm b/module/calp/html/components.scm
index 9b3e4ce0..6ff59502 100644
--- a/module/calp/html/components.scm
+++ b/module/calp/html/components.scm
@@ -12,6 +12,7 @@
     ((_ (@ attr ...) body ...)
      `(*TOP*
        (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
+       ,(lambda () (format #t "~%<!DOCTYPE html>~%"))
        (html (@ (xmlns "http://www.w3.org/1999/xhtml") attr ...)
              body ...)))
     ((_ body ...)
diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm
index 6945c5d2..dd94dc16 100644
--- a/module/calp/html/view/calendar.scm
+++ b/module/calp/html/view/calendar.scm
@@ -102,12 +102,11 @@
              (content ,(date->string  (date+ end-date (date day: 1)) "~s"))))
 
     (script
-     ,(format #f
-              "
+     ,(lambda () (format #t "
 EDIT_MODE=~:[false~;true~];
 window.default_calendar='~a';"
-              (edit-mode)
-              (base64encode ((@ (vcomponent) default-calendar)))))
+                    (edit-mode)
+                    (base64encode ((@ (vcomponent) default-calendar))))))
 
 
     (style ,(format #f "html {
diff --git a/module/calp/html/view/calendar/month.scm b/module/calp/html/view/calendar/month.scm
index 2b4c888a..205d6049 100644
--- a/module/calp/html/view/calendar/month.scm
+++ b/module/calp/html/view/calendar/month.scm
@@ -35,7 +35,7 @@
                    (events-between s e (list->stream long-events)))))
          (date-range pre-start post-end (date day: 7))))
 
-  `((script "window.VIEW='month';")
+  `((script ,(lambda () (format #t "window.VIEW='month';")))
     (header (@ (class "table-head"))
             ,(string-titlecase (date->string start-date "~B ~Y")))
     (div (@ (class "caltable")
diff --git a/module/calp/html/view/calendar/week.scm b/module/calp/html/view/calendar/week.scm
index 16337102..b68184f9 100644
--- a/module/calp/html/view/calendar/week.scm
+++ b/module/calp/html/view/calendar/week.scm
@@ -27,7 +27,7 @@
 (define*-public (render-calendar key: calendars events start-date end-date #:allow-other-keys)
   (let* ((long-events short-events (partition long-event? (stream->list (events-between start-date end-date events))))
          (range (date-range start-date end-date)))
-    `((script "window.VIEW='week';")
+    `((script ,(lambda () (format #t "window.VIEW='week';")))
       (div (@ (class "calendar"))
            (div (@ (class "days"))
                 ;; Top left area
diff --git a/module/calp/server/routes.scm b/module/calp/server/routes.scm
index 896219cd..762681d9 100644
--- a/module/calp/server/routes.scm
+++ b/module/calp/server/routes.scm
@@ -13,7 +13,8 @@
   :use-module ((web uri) :select (build-relative-ref))
   :use-module ((web uri-query) :select (encode-query-parameters))
 
-  :use-module (sxml simple)
+  :use-module ((sxml simple) :select (sxml->xml xml->sxml))
+  :use-module ((sxml html)   :select (sxml->html))
   :use-module (sxml xpath)
   :use-module (sxml namespace)
 
@@ -37,13 +38,17 @@
 
   :use-module (calp translation)
 
+  :use-module ((calp html components) :select (xhtml-doc include-css))
+
   )
 
 
 
-(define (sxml->html-string sxml)
-  (with-output-to-string
-    (lambda () (display "<!doctype html>\n") (sxml->xml sxml))))
+(define (content-type html?)
+  (if html? 'text/html 'application/xhtml+xml))
+
+(define (sxml->output html?)
+  (if html? sxml->html sxml->xml))
 
 
 
@@ -118,6 +123,7 @@
 (define ical-namespace '(IC . "urn:ietf:params:xml:ns:icalendar-2.0"))
 
 
+(define root-script "window.onload = () => document.getElementsByTagName('a')[0].click()")
 
 ;; TODO ensure encoding on all fields which take user provided data.
 ;; Possibly a fallback which strips everything unknown, and treats
@@ -127,12 +133,14 @@
 
    ;; Manual redirect to not reserve root.
    ;; Also reason for really ugly frontend redirect.
-   (GET "/" ()
-        (return '((content-type text/html))
-                (sxml->html-string
-                 `(body (a (@ (href "/today")) ,(_ "Go to Today"))
-                        (script "window.onload = function() {
-  document.getElementsByTagName('a')[0].click();}")))))
+   (GET "/" (html)
+        (return `((content-type ,(content-type html)))
+                (with-output-to-string
+                  (lambda ()
+                   ((sxml->output html)
+                    (xhtml-doc
+                     (body (a (@ (href "/today")) ,(_ "Go to Today"))
+                           (script ,(lambda () (display root-script))))))))))
 
    (GET "/favicon.ico" ()
         (return
@@ -141,14 +149,12 @@
 
    ;; TODO any exception in this causes the whole page to fail
    ;; It would be much better if most of the page could still make it.
-   (GET "/week/:start-date.html" (start-date)
-        (let* ((start-date
-                (start-of-week (parse-iso-date start-date))))
-
-          (return `((content-type application/xhtml+xml))
+   (GET "/week/:start-date.html" (start-date html)
+        (let* ((start-date (start-of-week (parse-iso-date start-date))))
+          (return `((content-type ,(content-type html)))
                   (with-output-to-string
                     (lambda ()
-                      (sxml->xml
+                      ((sxml->output html)
                        (html-generate calendars: (get-calendars global-event-object)
                                       events: (get-event-set global-event-object)
                                       start-date: start-date
@@ -159,13 +165,12 @@
                                       intervaltype: 'week
                                       )))))))
 
-   (GET "/month/:start-date.html" (start-date)
+   (GET "/month/:start-date.html" (start-date html)
         (let* ((start-date (start-of-month (parse-iso-date start-date))))
-
-          (return '((content-type application/xhtml+xml))
+          (return `((content-type ,(content-type html)))
                   (with-output-to-string
                     (lambda ()
-                      (sxml->xml
+                      ((sxml->output html)
                        (html-generate calendars: (get-calendars global-event-object)
                                       events: (get-event-set global-event-object)
                                       start-date: start-date
@@ -355,7 +360,7 @@
                                  (prop event 'SUMMARY)))))
                         ))))))
 
-   (GET "/search" (q p onlyfuture)
+   (GET "/search" (q p onlyfuture html)
         (define search-term
           (if (and q (not (string-null? q)))
               (if onlyfuture
@@ -397,10 +402,10 @@
                      (set! error
                        (format #f "~?~%" fmt arg))))))
 
-        (return '((content-type application/xhtml+xml))
+        (return `((content-type (content-type html)))
                 (with-output-to-string
                   (lambda ()
-                    (sxml->xml
+                    ((sxml->output html)
                      (search-result-page
                       error
                       (and=> q (negate string-null?))
@@ -433,16 +438,19 @@
                 (scm-error err proc fmt fmt-args data)))))
 
    ;; Note that `path' will most likely start with a slash
-   (GET "/static:path{.*}" (path)
+   (GET "/static:path{.*}" (path html)
         (catch
           'misc-error
           (lambda () (return
-                 '((content-type text/html))
-                 (sxml->html-string
-                  `(html
-                    (head (title ,(_ "Calp directory listing for ") path)
-                          ,((@ (calp html components) include-css) "/static/directory-listing.css"))
-                    (body ,(directory-table (static-dir) path))))))
+                 `((content-type ,(content-type html)))
+                 (with-output-to-string
+                   (lambda ()
+                     ((sxml->output html)
+                      (xhtml-doc
+                       (head (title ,(_ "Calp directory listing for ") path)
+                             ,(include-css
+                               "/static/directory-listing.css"))
+                       (body ,(directory-table (static-dir) path))))))))
           (lambda (err proc fmt fmt-args data)
             (return (build-response code: 404)
                     (format #f "~?" fmt fmt-args)))))
diff --git a/module/sxml/html.scm b/module/sxml/html.scm
new file mode 100644
index 00000000..473cfd9e
--- /dev/null
+++ b/module/sxml/html.scm
@@ -0,0 +1,379 @@
+;; Copyright © 2015  David Thompson <davet@gnu.org>
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3 of
+;; the License, or (at your option) any later version.
+;;
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library.  If not, see
+;; <http://www.gnu.org/licenses/>.
+
+;; https://dthompson.us/rendering-html-with-sxml-and-gnu-guile.html
+
+(define-module (sxml html)
+ #:use-module (sxml simple)
+ #:use-module (srfi srfi-26)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 format)
+ #:use-module (ice-9 hash-table)
+ #:export (sxml->html))
+
+(define %void-elements
+ '(area
+   base
+   br
+   col
+   command
+   embed
+   hr
+   img
+   input
+   keygen
+   link
+   meta
+   param
+   source
+   track
+   wbr))
+
+(define (void-element? tag)
+  "Return #t if TAG is a void element."
+  (pair? (memq tag %void-elements)))
+
+(define %escape-chars
+  (alist->hash-table
+   '((#\" . "quot")
+     (#\& . "amp")
+     (#\' . "apos")
+     (#\< . "lt")
+     (#\> . "gt")
+     (#\¡ . "iexcl")
+     (#\¢ . "cent")
+     (#\£ . "pound")
+     (#\¤ . "curren")
+     (#\¥ . "yen")
+     (#\¦ . "brvbar")
+     (#\§ . "sect")
+     (#\¨ . "uml")
+     (#\© . "copy")
+     (#\ª . "ordf")
+     (#\« . "laquo")
+     (#\¬ . "not")
+     (#\® . "reg")
+     (#\¯ . "macr")
+     (#\° . "deg")
+     (#\± . "plusmn")
+     (#\² . "sup2")
+     (#\³ . "sup3")
+     (#\´ . "acute")
+     (#\µ . "micro")
+     (#\¶ . "para")
+     (#\· . "middot")
+     (#\¸ . "cedil")
+     (#\¹ . "sup1")
+     (#\º . "ordm")
+     (#\» . "raquo")
+     (#\¼ . "frac14")
+     (#\½ . "frac12")
+     (#\¾ . "frac34")
+     (#\¿ . "iquest")
+     (#\À . "Agrave")
+     (#\Á . "Aacute")
+     (#\Â . "Acirc")
+     (#\Ã . "Atilde")
+     (#\Ä . "Auml")
+     (#\Å . "Aring")
+     (#\Æ . "AElig")
+     (#\Ç . "Ccedil")
+     (#\È . "Egrave")
+     (#\É . "Eacute")
+     (#\Ê . "Ecirc")
+     (#\Ë . "Euml")
+     (#\Ì . "Igrave")
+     (#\Í . "Iacute")
+     (#\Î . "Icirc")
+     (#\Ï . "Iuml")
+     (#\Ð . "ETH")
+     (#\Ñ . "Ntilde")
+     (#\Ò . "Ograve")
+     (#\Ó . "Oacute")
+     (#\Ô . "Ocirc")
+     (#\Õ . "Otilde")
+     (#\Ö . "Ouml")
+     (#\× . "times")
+     (#\Ø . "Oslash")
+     (#\Ù . "Ugrave")
+     (#\Ú . "Uacute")
+     (#\Û . "Ucirc")
+     (#\Ü . "Uuml")
+     (#\Ý . "Yacute")
+     (#\Þ . "THORN")
+     (#\ß . "szlig")
+     (#\à . "agrave")
+     (#\á . "aacute")
+     (#\â . "acirc")
+     (#\ã . "atilde")
+     (#\ä . "auml")
+     (#\å . "aring")
+     (#\æ . "aelig")
+     (#\ç . "ccedil")
+     (#\è . "egrave")
+     (#\é . "eacute")
+     (#\ê . "ecirc")
+     (#\ë . "euml")
+     (#\ì . "igrave")
+     (#\í . "iacute")
+     (#\î . "icirc")
+     (#\ï . "iuml")
+     (#\ð . "eth")
+     (#\ñ . "ntilde")
+     (#\ò . "ograve")
+     (#\ó . "oacute")
+     (#\ô . "ocirc")
+     (#\õ . "otilde")
+     (#\ö . "ouml")
+     (#\÷ . "divide")
+     (#\ø . "oslash")
+     (#\ù . "ugrave")
+     (#\ú . "uacute")
+     (#\û . "ucirc")
+     (#\ü . "uuml")
+     (#\ý . "yacute")
+     (#\þ . "thorn")
+     (#\ÿ . "yuml")
+     (#\Œ . "OElig")
+     (#\œ . "oelig")
+     (#\Š . "Scaron")
+     (#\š . "scaron")
+     (#\Ÿ . "Yuml")
+     (#\ƒ . "fnof")
+     (#\ˆ . "circ")
+     (#\˜ . "tilde")
+     (#\Α . "Alpha")
+     (#\Β . "Beta")
+     (#\Γ . "Gamma")
+     (#\Δ . "Delta")
+     (#\Ε . "Epsilon")
+     (#\Ζ . "Zeta")
+     (#\Η . "Eta")
+     (#\Θ . "Theta")
+     (#\Ι . "Iota")
+     (#\Κ . "Kappa")
+     (#\Λ . "Lambda")
+     (#\Μ . "Mu")
+     (#\Ν . "Nu")
+     (#\Ξ . "Xi")
+     (#\Ο . "Omicron")
+     (#\Π . "Pi")
+     (#\Ρ . "Rho")
+     (#\Σ . "Sigma")
+     (#\Τ . "Tau")
+     (#\Υ . "Upsilon")
+     (#\Φ . "Phi")
+     (#\Χ . "Chi")
+     (#\Ψ . "Psi")
+     (#\Ω . "Omega")
+     (#\α . "alpha")
+     (#\β . "beta")
+     (#\γ . "gamma")
+     (#\δ . "delta")
+     (#\ε . "epsilon")
+     (#\ζ . "zeta")
+     (#\η . "eta")
+     (#\θ . "theta")
+     (#\ι . "iota")
+     (#\κ . "kappa")
+     (#\λ . "lambda")
+     (#\μ . "mu")
+     (#\ν . "nu")
+     (#\ξ . "xi")
+     (#\ο . "omicron")
+     (#\π . "pi")
+     (#\ρ . "rho")
+     (#\ς . "sigmaf")
+     (#\σ . "sigma")
+     (#\τ . "tau")
+     (#\υ . "upsilon")
+     (#\φ . "phi")
+     (#\χ . "chi")
+     (#\ψ . "psi")
+     (#\ω . "omega")
+     (#\ϑ . "thetasym")
+     (#\ϒ . "upsih")
+     (#\ϖ . "piv")
+     (#\  . "ensp")
+     (#\  . "emsp")
+     (#\  . "thinsp")
+     (#\– . "ndash")
+     (#\— . "mdash")
+     (#\‘ . "lsquo")
+     (#\’ . "rsquo")
+     (#\‚ . "sbquo")
+     (#\“ . "ldquo")
+     (#\” . "rdquo")
+     (#\„ . "bdquo")
+     (#\† . "dagger")
+     (#\‡ . "Dagger")
+     (#\• . "bull")
+     (#\… . "hellip")
+     (#\‰ . "permil")
+     (#\′ . "prime")
+     (#\″ . "Prime")
+     (#\‹ . "lsaquo")
+     (#\› . "rsaquo")
+     (#\‾ . "oline")
+     (#\⁄ . "frasl")
+     (#\€ . "euro")
+     (#\ℑ . "image")
+     (#\℘ . "weierp")
+     (#\ℜ . "real")
+     (#\™ . "trade")
+     (#\ℵ . "alefsym")
+     (#\← . "larr")
+     (#\↑ . "uarr")
+     (#\→ . "rarr")
+     (#\↓ . "darr")
+     (#\↔ . "harr")
+     (#\↵ . "crarr")
+     (#\⇐ . "lArr")
+     (#\⇑ . "uArr")
+     (#\⇒ . "rArr")
+     (#\⇓ . "dArr")
+     (#\⇔ . "hArr")
+     (#\∀ . "forall")
+     (#\∂ . "part")
+     (#\∃ . "exist")
+     (#\∅ . "empty")
+     (#\∇ . "nabla")
+     (#\∈ . "isin")
+     (#\∉ . "notin")
+     (#\∋ . "ni")
+     (#\∏ . "prod")
+     (#\∑ . "sum")
+     (#\− . "minus")
+     (#\∗ . "lowast")
+     (#\√ . "radic")
+     (#\∝ . "prop")
+     (#\∞ . "infin")
+     (#\∠ . "ang")
+     (#\∧ . "and")
+     (#\∨ . "or")
+     (#\∩ . "cap")
+     (#\∪ . "cup")
+     (#\∫ . "int")
+     (#\∴ . "there4")
+     (#\∼ . "sim")
+     (#\≅ . "cong")
+     (#\≈ . "asymp")
+     (#\≠ . "ne")
+     (#\≡ . "equiv")
+     (#\≤ . "le")
+     (#\≥ . "ge")
+     (#\⊂ . "sub")
+     (#\⊃ . "sup")
+     (#\⊄ . "nsub")
+     (#\⊆ . "sube")
+     (#\⊇ . "supe")
+     (#\⊕ . "oplus")
+     (#\⊗ . "otimes")
+     (#\⊥ . "perp")
+     (#\⋅ . "sdot")
+     (#\⋮ . "vellip")
+     (#\⌈ . "lceil")
+     (#\⌉ . "rceil")
+     (#\⌊ . "lfloor")
+     (#\⌋ . "rfloor")
+     (#\〈 . "lang")
+     (#\〉 . "rang")
+     (#\◊ . "loz")
+     (#\♠ . "spades")
+     (#\♣ . "clubs")
+     (#\♥ . "hearts")
+     (#\♦ . "diams"))))
+
+(define (string->escaped-html s port)
+  "Write the HTML escaped form of S to PORT."
+  (define (escape c)
+    (let ((escaped (hash-ref %escape-chars c)))
+      (if escaped
+          (format port "&~a;" escaped)
+          (display c port))))
+  (string-for-each escape s))
+
+(define (object->escaped-html obj port)
+  "Write the HTML escaped form of OBJ to PORT."
+  (string->escaped-html
+   (call-with-output-string (cut display obj <>))
+   port))
+
+(define (attribute-value->html values port)
+  "Write the HTML escaped form of VALUE to PORT."
+  (for-each
+   (lambda (value)
+     (cond
+      [(string? value) (string->escaped-html value port)]
+      [(null? value) *unspecified*]
+      [else (object->escaped-html value port)]))
+   values))
+
+(define (attribute->html attr values port)
+  "Write ATTR and VALUES to PORT."
+  (format port "~a=\"" attr)
+  (attribute-value->html values port)
+  (display #\" port))
+
+(define (element->html tag attrs body port)
+  "Write the HTML TAG to PORT, where TAG has the attributes in the
+ist ATTRS and the child nodes in BODY."
+  (format port "<~a" tag)
+  (for-each (match-lambda
+              ((attr . values)
+               (display #\space port)
+               (attribute->html attr values port)))
+            attrs)
+  (if (and (null? body) (void-element? tag))
+      (display " />" port)
+      (begin
+        (display #\> port)
+        (for-each (cut sxml->html <> port) body)
+        (format port "</~a>" tag))))
+
+(define (doctype->html doctype port)
+  (format port "<!DOCTYPE ~a>" doctype))
+
+(define (pi->html type body port)
+  (format port "<?~a ~a?>" type body))
+
+(define* (sxml->html tree #:optional (port (current-output-port)))
+  "Write the serialized HTML form of TREE to PORT."
+  (match tree
+    (() *unspecified*)
+    (('doctype type)
+     (doctype->html type port))
+    ;; Unescaped, raw HTML output
+    (('raw html-fragments ...)
+     (for-each (cut display <> port)
+               html-fragments))
+    (('*PI* type body)
+     (pi->html type body port))
+    (('*TOP* nodes ...)
+     (for-each (cut sxml->html <> port) nodes))
+    ((? procedure? proc) ; is whole tree a procedure
+     (with-output-to-port port proc))
+    (((? symbol? tag) ('@ attrs ...) body ...)
+     (element->html tag attrs body port))
+    (((? symbol? tag) body ...)
+     (element->html tag '() body port))
+    ((nodes ...)
+     (for-each (cut sxml->html <> port) nodes))
+    ((? string? text)
+     (string->escaped-html text port))
+    ;; Render arbitrary Scheme objects, too.
+    (#f *unspecified*)
+    (obj (object->escaped-html obj port))))
diff --git a/static/components/vevent.ts b/static/components/vevent.ts
index b72cda90..2193eabc 100644
--- a/static/components/vevent.ts
+++ b/static/components/vevent.ts
@@ -15,7 +15,7 @@ abstract class ComponentVEvent extends HTMLElement {
 
     constructor(uid?: string) {
         super();
-        this.template = document.getElementById(this.tagName) as HTMLTemplateElement | null
+        this.template = document.getElementById(this.tagName.toLowerCase()) as HTMLTemplateElement | null
 
         let real_uid;
 
diff --git a/static/globals.ts b/static/globals.ts
index 2fc12933..ddc9113e 100644
--- a/static/globals.ts
+++ b/static/globals.ts
@@ -51,7 +51,7 @@ function find_block(uid: uid): ComponentBlock | null {
         return null;
     }
     for (let el of obj.registered) {
-        if (el.tagName === 'vevent-block') {
+        if (el.tagName.toLowerCase() === 'vevent-block') {
             return el as ComponentBlock;
         }
     }
diff --git a/static/user/user-additions.js b/static/user/user-additions.js
index 0de825e8..c0579df5 100644
--- a/static/user/user-additions.js
+++ b/static/user/user-additions.js
@@ -34,8 +34,10 @@ window.formatters.set('description', (el, d) => {
 
 window.salar = new Promise((resolve, reject) =>
     fetch('/static/user/salar.json')
-    .then(d => d.json())
-    .then(d => resolve(d)))
+    .then(resp => { if (! resp.ok) reject("404"); else resp.json() })
+    .then(d => resolve(d))
+    .catch(err => reject(err))
+)
 
 
 window.formatters.set('location', async function(el, d) {
@@ -46,7 +48,12 @@ window.formatters.set('location', async function(el, d) {
         return;
     }
 
-    let salar = await window.salar;
+    try {
+        let salar = await window.salar;
+    } catch (e) {
+        console.warn("Location formatter failed", e);
+        return;
+    }
 
     let name = m[1]
     let frag = salar[name];
diff --git a/static/vevent.ts b/static/vevent.ts
index 56c9019a..5419eb60 100644
--- a/static/vevent.ts
+++ b/static/vevent.ts
@@ -298,7 +298,7 @@ function make_vevent_value(value_tag: Element): VEventValue {
     /* TODO parameters */
     return new VEventValue(
         /* TODO error on invalid type? */
-        value_tag.tagName as ical_type,
+        value_tag.tagName.toLowerCase() as ical_type,
         make_vevent_value_(value_tag));
 }
 
@@ -441,7 +441,7 @@ function xml_to_recurrence_rule(xml: Element): RecurrenceRule {
 
 function make_vevent_value_(value_tag: Element): string | boolean | Date | number | RecurrenceRule {
     /* RFC6321 3.6. */
-    switch (value_tag.tagName) {
+    switch (value_tag.tagName.toLowerCase()) {
         case 'binary':
             /* Base64 to binary
                Seems to handle inline whitespace, which xCal standard reqires
@@ -518,10 +518,10 @@ function xml_to_vcal(xml: Element): VEvent {
             for (var j = 0; j < tag.childElementCount; j++) {
                 let child = tag.childNodes[j];
                 if (!(child instanceof Element)) continue;
-                if (child.tagName == 'parameters') {
+                if (child.tagName.toLowerCase() == 'parameters') {
                     parameters = /* TODO handle parameters */ {};
                     continue value_loop;
-                } else switch (tag.tagName) {
+                } else switch (tag.tagName.toLowerCase()) {
                     /* These can contain multiple value tags, per
                        RFC6321 3.4.1.1. */
                     case 'categories':
@@ -535,7 +535,7 @@ function xml_to_vcal(xml: Element): VEvent {
                         value = make_vevent_value(child);
                 }
             }
-            property_map.set(tag.tagName, value);
+            property_map.set(tag.tagName.toLowerCase(), value);
         }
     }
 
diff --git a/tests/test/html/component.scm b/tests/test/html/component.scm
index 777068c9..050810be 100644
--- a/tests/test/html/component.scm
+++ b/tests/test/html/component.scm
@@ -7,23 +7,6 @@
   :use-module (calp html components)
   )
 
-(test-equal '(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
-                    (html (@ (xmlns "http://www.w3.org/1999/xhtml"))
-                          body))
-  (xhtml-doc body))
-
-(test-equal '(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
-                    (html (@ (xmlns "http://www.w3.org/1999/xhtml"))
-                          (b "Hello, World!")))
-  (xhtml-doc ,'(b "Hello, World!")))
-
-(test-equal
-    '(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
-            (html (@ (xmlns "http://www.w3.org/1999/xhtml")
-                     (lang sv))
-                  body))
-    (xhtml-doc (@ (lang sv)) body))
-
 (test-equal
     '(button (@ (class "btn") (onclick "onclick")) "Body")
   (btn onclick: "onclick" "Body"))
author	Hugo Hörnquist <hugo@lysator.liu.se>	2022-06-12 00:13:02 +0200
committer	Hugo Hörnquist <hugo@lysator.liu.se>	2022-06-12 00:13:02 +0200
commit	da8d1467dff8b27af7a3ae649d92ead5cbf704d8 (patch)
tree	cd4231abb8ec24d79dd3a4a8b5e563ee2bb82219
parent	Add number of TODO's. (diff)
parent	Handle error for user-additions salar. (diff)
download	calp-da8d1467dff8b27af7a3ae649d92ead5cbf704d8.tar.gz calp-da8d1467dff8b27af7a3ae649d92ead5cbf704d8.tar.xz