(define HTML_TAGS (list "html" "head" "body" "title" "meta" "link" "script" "style" "noscript" "header" "nav" "main" "section" "article" "aside" "footer" "h1" "h2" "h3" "h4" "h5" "h6" "hgroup" "div" "p" "blockquote" "pre" "figure" "figcaption" "address" "details" "summary" "a" "span" "em" "strong" "small" "b" "i" "u" "s" "mark" "sub" "sup" "abbr" "cite" "code" "kbd" "samp" "var" "time" "br" "wbr" "hr" "ul" "ol" "li" "dl" "dt" "dd" "table" "thead" "tbody" "tfoot" "tr" "th" "td" "caption" "colgroup" "col" "form" "input" "textarea" "select" "option" "optgroup" "button" "label" "fieldset" "legend" "output" "datalist" "img" "video" "audio" "source" "picture" "canvas" "iframe" "svg" "math" "path" "circle" "ellipse" "rect" "line" "polyline" "polygon" "text" "tspan" "g" "defs" "use" "clipPath" "mask" "pattern" "linearGradient" "radialGradient" "stop" "filter" "feGaussianBlur" "feOffset" "feBlend" "feColorMatrix" "feComposite" "feMerge" "feMergeNode" "feTurbulence" "feComponentTransfer" "feFuncR" "feFuncG" "feFuncB" "feFuncA" "feDisplacementMap" "feFlood" "feImage" "feMorphology" "feSpecularLighting" "feDiffuseLighting" "fePointLight" "feSpotLight" "feDistantLight" "animate" "animateTransform" "foreignObject" "template" "slot" "dialog" "menu")) (define VOID_ELEMENTS (list "area" "base" "br" "col" "embed" "hr" "img" "input" "link" "meta" "param" "source" "track" "wbr")) (define BOOLEAN_ATTRS (list "async" "autofocus" "autoplay" "checked" "controls" "default" "defer" "disabled" "formnovalidate" "hidden" "inert" "ismap" "loop" "multiple" "muted" "nomodule" "novalidate" "open" "playsinline" "readonly" "required" "reversed" "selected")) (define *definition-form-extensions* (list)) (define definition-form? :effects () (fn ((name :as string)) (or (= name "define") (= name "defcomp") (= name "defisland") (= name "defmacro") (= name "defstyle") (= name "deftype") (= name "defeffect") (contains? *definition-form-extensions* name)))) (define parse-element-args :effects (render) (fn ((args :as list) (env :as dict)) (let ((attrs (dict)) (children (list))) (reduce (fn ((state :as dict) arg) (let ((skip (get state "skip"))) (if skip (assoc state "skip" false "i" (inc (get state "i"))) (if (and (= (type-of arg) "keyword") (< (inc (get state "i")) (len args))) (let ((val (trampoline (eval-expr (nth args (inc (get state "i"))) env)))) (dict-set! attrs (keyword-name arg) val) (assoc state "skip" true "i" (inc (get state "i")))) (do (append! children arg) (assoc state "i" (inc (get state "i")))))))) (dict "i" 0 "skip" false) args) (list attrs children)))) (define render-attrs :effects () (fn ((attrs :as dict)) (join "" (map (fn ((key :as string)) (let ((val (dict-get attrs key))) (cond (and (contains? BOOLEAN_ATTRS key) val) (str " " key) (and (contains? BOOLEAN_ATTRS key) (not val)) "" (nil? val) "" :else (str " " key "=\"" (escape-attr (str val)) "\"")))) (keys attrs))))) (define eval-cond :effects () (fn ((clauses :as list) (env :as dict)) (if (cond-scheme? clauses) (eval-cond-scheme clauses env) (eval-cond-clojure clauses env)))) (define eval-cond-scheme :effects () (fn ((clauses :as list) (env :as dict)) (if (empty? clauses) nil (let ((clause (first clauses)) (test (first clause)) (body (nth clause 1))) (if (is-else-clause? test) body (if (trampoline (eval-expr test env)) body (eval-cond-scheme (rest clauses) env))))))) (define eval-cond-clojure :effects () (fn ((clauses :as list) (env :as dict)) (if (< (len clauses) 2) nil (let ((test (first clauses)) (body (nth clauses 1))) (if (is-else-clause? test) body (if (trampoline (eval-expr test env)) body (eval-cond-clojure (slice clauses 2) env))))))) (define process-bindings :effects (mutation) (fn ((bindings :as list) (env :as dict)) (let ((local (env-extend env))) (for-each (fn ((pair :as list)) (when (and (= (type-of pair) "list") (>= (len pair) 2)) (let ((name (if (= (type-of (first pair)) "symbol") (symbol-name (first pair)) (str (first pair))))) (env-bind! local name (trampoline (eval-expr (nth pair 1) local)))))) bindings) local))) (define is-render-expr? :effects () (fn (expr) (if (or (not (= (type-of expr) "list")) (empty? expr)) false (let ((h (first expr))) (if (not (= (type-of h) "symbol")) false (let ((n (symbol-name h))) (or (= n "<>") (= n "raw!") (starts-with? n "~") (starts-with? n "html:") (contains? HTML_TAGS n) (and (> (index-of n "-") 0) (> (len expr) 1) (= (type-of (nth expr 1)) "keyword"))))))))) (define merge-spread-attrs :effects (mutation) (fn ((target :as dict) (spread-dict :as dict)) (for-each (fn ((key :as string)) (let ((val (dict-get spread-dict key))) (if (= key "class") (let ((existing (dict-get target "class"))) (dict-set! target "class" (if (and existing (not (= existing ""))) (str existing " " val) val))) (if (= key "style") (let ((existing (dict-get target "style"))) (dict-set! target "style" (if (and existing (not (= existing ""))) (str existing ";" val) val))) (dict-set! target key val))))) (keys spread-dict)))) (define escape-html (fn (s) (let ((r (str s))) (set! r (replace r "&" "&")) (set! r (replace r "<" "<")) (set! r (replace r ">" ">")) (set! r (replace r "\"" """)) r))) (define escape-attr (fn (s) (escape-html s)))