diff options
| -rw-r--r-- | web/sxml.scm | 553 |
1 files changed, 276 insertions, 277 deletions
diff --git a/web/sxml.scm b/web/sxml.scm index de30b3f..29eeee3 100644 --- a/web/sxml.scm +++ b/web/sxml.scm @@ -30,277 +30,274 @@ #:export (sxml->html)) (define %self-closing-tags - '(area - base - br - col - command - embed - hr - img - input - keygen - link - meta - param - source - track - wbr)) + '(area base + br + col + command + embed + hr + img + input + keygen + link + meta + param + source + track + wbr)) (define (self-closing-tag? tag) "Return #t if TAG is self-closing." (pair? (memq tag %self-closing-tags))) (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")))) + (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") + (#\20002 . "ensp") + (#\20003 . "emsp") + (#\20011 . "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." @@ -313,9 +310,7 @@ (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)) + (string->escaped-html (call-with-output-string (cut display obj <>)) port)) (define (attribute-value->html value port) "Write the HTML escaped form of VALUE to PORT." @@ -334,11 +329,11 @@ list ATTRS and the child nodes in BODY." (format port "<~a" tag) (for-each (match-lambda - ((attr value) - (display #\space port) - (attribute->html attr value port))) - attrs) - (if (and (null? body) (self-closing-tag? tag)) + ((attr value) + (display #\space port) + (attribute->html attr value port))) attrs) + (if (and (null? body) + (self-closing-tag? tag)) (display " />" port) (begin (display #\> port) @@ -348,7 +343,8 @@ list ATTRS and the child nodes in BODY." (define (doctype->html doctype port) (format port "<!DOCTYPE ~a>" doctype)) -(define* (sxml->html tree #:optional (port (current-output-port))) +(define* (sxml->html tree + #:optional (port (current-output-port))) "Write the serialized HTML form of TREE to PORT." (match tree (() *unspecified*) @@ -357,10 +353,13 @@ list ATTRS and the child nodes in BODY." ;; Unescaped, raw HTML output (('raw html) (display html port)) - (((? symbol? tag) ('@ attrs ...) body ...) + (((? symbol? tag) + ('@ attrs ...) body ...) (element->html tag attrs body port)) - (((? symbol? tag) body ...) - (element->html tag '() body port)) + (((? symbol? tag) + body ...) + (element->html tag + '() body port)) ((nodes ...) (for-each (cut sxml->html <> port) nodes)) ((? string? text) |