rose-ash/shared/sx/ref/render.sx

;; ==========================================================================
;; 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?
  (fn ((name :as string))
    (or (= name "define") (= name "defcomp") (= name "defisland")
        (= name "defmacro") (= name "defstyle") (= name "defhandler"))))


(define parse-element-args
  (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
  (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
  (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
  (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
  (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
  (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-set! 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?
  (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")))))))))


;; --------------------------------------------------------------------------
;; 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
;;
;; From parser.sx:
;;   (sx-serialize val)        → SX source string (aliased as serialize above)
;; --------------------------------------------------------------------------