;; ========================================================================== ;; render.sx — Core rendering specification ;; ;; Shared registries and utilities used by all rendering adapters. ;; This file defines WHAT is renderable (tag registries, attribute rules) ;; and HOW arguments are parsed — but not the output format. ;; ;; Adapters: ;; adapter-html.sx — HTML string output (server) ;; adapter-sx.sx — SX wire format output (server → client) ;; adapter-dom.sx — Live DOM node output (browser) ;; ;; Each adapter imports these shared definitions and provides its own ;; render entry point (render-to-html, render-to-sx, render-to-dom). ;; ========================================================================== ;; -------------------------------------------------------------------------- ;; HTML tag registry ;; -------------------------------------------------------------------------- ;; Tags known to the renderer. Unknown names are treated as function calls. ;; Void elements self-close (no children). Boolean attrs emit name only. (define HTML_TAGS (list ;; Document "html" "head" "body" "title" "meta" "link" "script" "style" "noscript" ;; Sections "header" "nav" "main" "section" "article" "aside" "footer" "h1" "h2" "h3" "h4" "h5" "h6" "hgroup" ;; Block "div" "p" "blockquote" "pre" "figure" "figcaption" "address" "details" "summary" ;; Inline "a" "span" "em" "strong" "small" "b" "i" "u" "s" "mark" "sub" "sup" "abbr" "cite" "code" "time" "br" "wbr" "hr" ;; Lists "ul" "ol" "li" "dl" "dt" "dd" ;; Tables "table" "thead" "tbody" "tfoot" "tr" "th" "td" "caption" "colgroup" "col" ;; Forms "form" "input" "textarea" "select" "option" "optgroup" "button" "label" "fieldset" "legend" "output" "datalist" ;; Media "img" "video" "audio" "source" "picture" "canvas" "iframe" ;; SVG "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" ;; Other "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")) ;; -------------------------------------------------------------------------- ;; Shared utilities ;; -------------------------------------------------------------------------- (define definition-form? :effects [] (fn ((name :as string)) (or (= name "define") (= name "defcomp") (= name "defisland") (= name "defmacro") (= name "defstyle") (= name "defhandler") (= name "deftype") (= name "defeffect")))) (define parse-element-args :effects [render] (fn ((args :as list) (env :as dict)) ;; Parse (:key val :key2 val2 child1 child2) into (attrs-dict children-list) (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)) ;; Render an attrs dict to an HTML attribute string. ;; Used by adapter-html.sx and adapter-sx.sx. (join "" (map (fn ((key :as string)) (let ((val (dict-get attrs key))) (cond ;; Boolean attrs (and (contains? BOOLEAN_ATTRS key) val) (str " " key) (and (contains? BOOLEAN_ATTRS key) (not val)) "" ;; Nil values — skip (nil? val) "" ;; Normal attr :else (str " " key "=\"" (escape-attr (str val)) "\"")))) (keys attrs))))) ;; -------------------------------------------------------------------------- ;; Render adapter helpers ;; -------------------------------------------------------------------------- ;; Shared by HTML and DOM adapters for evaluating control forms during ;; rendering. Unlike sf-cond (eval.sx) which returns a thunk for TCO, ;; eval-cond returns the unevaluated body expression so the adapter ;; can render it in its own mode (HTML string vs DOM nodes). ;; eval-cond: find matching cond branch, return unevaluated body expr. ;; Handles both scheme-style ((test body) ...) and clojure-style ;; (test body test body ...). (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 (or (and (= (type-of test) "symbol") (or (= (symbol-name test) "else") (= (symbol-name test) ":else"))) (and (= (type-of test) "keyword") (= (keyword-name test) "else"))) 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 (or (and (= (type-of test) "keyword") (= (keyword-name test) "else")) (and (= (type-of test) "symbol") (or (= (symbol-name test) "else") (= (symbol-name test) ":else")))) body (if (trampoline (eval-expr test env)) body (eval-cond-clojure (slice clauses 2) env))))))) ;; process-bindings: evaluate let-binding pairs, return extended env. ;; bindings = ((name1 expr1) (name2 expr2) ...) (define process-bindings :effects [mutation] (fn ((bindings :as list) (env :as dict)) ;; env-extend (not merge) — Env is not a dict subclass, so merge() ;; returns an empty dict, losing all parent scope bindings. (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))) ;; -------------------------------------------------------------------------- ;; is-render-expr? — check if expression is a rendering form ;; -------------------------------------------------------------------------- ;; Used by eval-list to dispatch rendering forms to the active adapter ;; (HTML, SX wire, or DOM) rather than evaluating them as function calls. (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"))))))))) ;; -------------------------------------------------------------------------- ;; Spread — attribute injection from children into parent elements ;; -------------------------------------------------------------------------- ;; ;; A spread value is a dict of attributes that, when returned as a child ;; of an HTML element, merges its attrs onto the parent element. ;; This enables components to inject classes/styles/data-attrs onto their ;; parent without the parent knowing about the specific attrs. ;; ;; merge-spread-attrs: merge a spread's attrs into an element's attrs dict. ;; Class values are joined (space-separated); others overwrite. ;; Mutates the target attrs dict in place. (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") ;; Class: join existing + new with space (let ((existing (dict-get target "class"))) (dict-set! target "class" (if (and existing (not (= existing ""))) (str existing " " val) val))) ;; Style: join with semicolons (if (= key "style") (let ((existing (dict-get target "style"))) (dict-set! target "style" (if (and existing (not (= existing ""))) (str existing ";" val) val))) ;; Everything else: overwrite (dict-set! target key val))))) (keys spread-dict)))) ;; -------------------------------------------------------------------------- ;; Platform interface (shared across adapters) ;; -------------------------------------------------------------------------- ;; ;; HTML/attribute escaping (used by HTML and SX wire adapters): ;; (escape-html s) → HTML-escaped string ;; (escape-attr s) → attribute-value-escaped string ;; (raw-html-content r) → unwrap RawHTML marker to string ;; ;; Spread (render-time attribute injection): ;; (make-spread attrs) → Spread value ;; (spread? x) → boolean ;; (spread-attrs s) → dict ;; ;; Render-time accumulators: ;; (collect! bucket value) → void ;; (collected bucket) → list ;; (clear-collected! bucket) → void ;; ;; Scoped effects (scope/provide/context/emit!): ;; (scope-push! name val) → void (general form) ;; (scope-pop! name) → void (general form) ;; (provide-push! name val) → alias for scope-push! ;; (provide-pop! name) → alias for scope-pop! ;; (context name &rest def) → value from nearest scope ;; (emit! name value) → void (append to scope accumulator) ;; (emitted name) → list of emitted values ;; ;; From parser.sx: ;; (sx-serialize val) → SX source string (aliased as serialize above) ;; --------------------------------------------------------------------------