;; ========================================================================== ;; adapter-dom.sx — DOM rendering adapter ;; ;; Renders SX expressions to live DOM nodes. Browser-only. ;; Mirrors the render-to-html adapter but produces Element/Text/Fragment ;; nodes instead of HTML strings. ;; ;; Depends on: ;; render.sx — HTML_TAGS, VOID_ELEMENTS, BOOLEAN_ATTRS, definition-form? ;; eval.sx — eval-expr, trampoline, call-component, expand-macro ;; ========================================================================== (define SVG_NS "http://www.w3.org/2000/svg") (define MATH_NS "http://www.w3.org/1998/Math/MathML") ;; -------------------------------------------------------------------------- ;; dom-on — dom-listen with post-render hooks ;; ;; Wraps dom-listen so that run-post-render-hooks fires after every SX ;; event handler invocation. This is the SX-level hook integration; ;; the native dom-listen primitive is a clean addEventListener wrapper. ;; -------------------------------------------------------------------------- (define dom-on :effects [io] (fn (el name handler) (dom-listen el name (if (lambda? handler) (if (= 0 (len (lambda-params handler))) (fn () (trampoline (call-lambda handler (list))) (run-post-render-hooks)) (fn (e) (trampoline (call-lambda handler (list e))) (run-post-render-hooks))) handler)))) ;; -------------------------------------------------------------------------- ;; render-to-dom — main entry point ;; -------------------------------------------------------------------------- (define render-to-dom :effects [render] (fn (expr (env :as dict) (ns :as string)) (set-render-active! true) (case (type-of expr) ;; nil / boolean false / boolean true → empty fragment "nil" (create-fragment) "boolean" (create-fragment) ;; Pre-rendered raw HTML → parse into fragment "raw-html" (dom-parse-html (raw-html-content expr)) ;; String → text node "string" (create-text-node expr) ;; Number → text node "number" (create-text-node (str expr)) ;; Symbol → evaluate then render "symbol" (render-to-dom (trampoline (eval-expr expr env)) env ns) ;; Keyword → text "keyword" (create-text-node (keyword-name expr)) ;; Pre-rendered DOM node → pass through "dom-node" expr ;; Spread → emit attrs to nearest element provider, pass through for reactive-spread "spread" (do (emit! "element-attrs" (spread-attrs expr)) expr) ;; Dict → empty "dict" (create-fragment) ;; List → dispatch "list" (if (empty? expr) (create-fragment) (render-dom-list expr env ns)) ;; Signal → reactive text in island scope, deref outside :else (if (signal? expr) (if (context "sx-island-scope" nil) (reactive-text expr) (create-text-node (str (deref expr)))) (create-text-node (str expr)))))) ;; -------------------------------------------------------------------------- ;; render-dom-list — dispatch on list head ;; -------------------------------------------------------------------------- (define render-dom-list :effects [render] (fn (expr (env :as dict) (ns :as string)) (let ((head (first expr))) (cond ;; Symbol head — dispatch on name (= (type-of head) "symbol") (let ((name (symbol-name head)) (args (rest expr))) (cond ;; raw! → insert unescaped HTML (= name "raw!") (render-dom-raw args env) ;; <> → fragment (= name "<>") (render-dom-fragment args env ns) ;; lake — server-morphable slot within an island (= name "lake") (render-dom-lake args env ns) ;; marsh — reactive server-morphable slot within an island (= name "marsh") (render-dom-marsh args env ns) ;; html: prefix → force element rendering (starts-with? name "html:") (render-dom-element (slice name 5) args env ns) ;; Render-aware special forms (render-dom-form? name) (if (and (contains? HTML_TAGS name) (or (and (> (len args) 0) (= (type-of (first args)) "keyword")) ns)) ;; Ambiguous: tag name that's also a form — treat as tag ;; when keyword arg or namespace present (render-dom-element name args env ns) (dispatch-render-form name expr env ns)) ;; Macro expansion (and (env-has? env name) (macro? (env-get env name))) (render-to-dom (expand-macro (env-get env name) args env) env ns) ;; HTML tag (contains? HTML_TAGS name) (render-dom-element name args env ns) ;; Island (~name) — reactive component (and (starts-with? name "~") (env-has? env name) (island? (env-get env name))) (render-dom-island (env-get env name) args env ns) ;; Component (~name) (starts-with? name "~") (let ((comp (env-get env name))) (if (component? comp) (render-dom-component comp args env ns) (render-dom-unknown-component name))) ;; Custom element (hyphenated with keyword attrs) (and (> (index-of name "-") 0) (> (len args) 0) (= (type-of (first args)) "keyword")) (render-dom-element name args env ns) ;; Inside SVG/MathML namespace — treat as element ns (render-dom-element name args env ns) ;; deref in island scope → reactive text node (and (= name "deref") (context "sx-island-scope" nil)) (let ((sig-or-val (trampoline (eval-expr (first args) env)))) (if (signal? sig-or-val) (reactive-text sig-or-val) (create-text-node (str (deref sig-or-val))))) ;; Fallback — evaluate then render :else (render-to-dom (trampoline (eval-expr expr env)) env ns))) ;; Lambda or list head → evaluate (or (lambda? head) (= (type-of head) "list")) (render-to-dom (trampoline (eval-expr expr env)) env ns) ;; Data list :else (let ((frag (create-fragment))) (for-each (fn (x) (let ((result (render-to-dom x env ns))) (when (not (spread? result)) (dom-append frag result)))) expr) frag))))) ;; -------------------------------------------------------------------------- ;; render-dom-element — create a DOM element with attrs and children ;; -------------------------------------------------------------------------- (define render-dom-element :effects [render] (fn ((tag :as string) (args :as list) (env :as dict) (ns :as string)) ;; Detect namespace from tag (let ((new-ns (cond (= tag "svg") SVG_NS (= tag "math") MATH_NS :else ns)) (el (dom-create-element tag new-ns))) ;; Provide scope for spread emit! — deeply nested spreads emit here (scope-push! "element-attrs" nil) ;; Process args: keywords → attrs, others → children (reduce (fn (state 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))) ;; Keyword arg → attribute (let ((attr-name (keyword-name arg)) (attr-expr (nth args (inc (get state "i"))))) (cond ;; Event handler: evaluate eagerly, bind listener (starts-with? attr-name "on-") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (when (callable? attr-val) (dom-on el (slice attr-name 3) attr-val))) ;; Two-way input binding: :bind signal (= attr-name "bind") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (when (signal? attr-val) (bind-input el attr-val))) ;; ref: set ref.current to this element (= attr-name "ref") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (dict-set! attr-val "current" el)) ;; key: reconciliation hint, evaluate eagerly (not reactive) (= attr-name "key") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (dom-set-attr el "key" (str attr-val))) ;; Inside island scope: reactive attribute binding. ;; The effect tracks signal deps automatically — if none ;; are deref'd, it fires once and never again (safe). (context "sx-island-scope" nil) (reactive-attr el attr-name (fn () (trampoline (eval-expr attr-expr env)))) ;; Static attribute (outside islands) :else (let ((attr-val (trampoline (eval-expr attr-expr env)))) (cond (or (nil? attr-val) (= attr-val false)) nil (contains? BOOLEAN_ATTRS attr-name) (when attr-val (dom-set-attr el attr-name "")) (= attr-val true) (dom-set-attr el attr-name "") :else (dom-set-attr el attr-name (str attr-val))))) (assoc state "skip" true "i" (inc (get state "i")))) ;; Positional arg → child (or spread → merge attrs onto element) (do (when (not (contains? VOID_ELEMENTS tag)) (let ((child (render-to-dom arg env new-ns))) (cond ;; Reactive spread: track signal deps, update attrs on change (and (spread? child) (context "sx-island-scope" nil)) (reactive-spread el (fn () (render-to-dom arg env new-ns))) ;; Static spread: already emitted via provide, skip (spread? child) nil ;; Normal child: append to element :else (dom-append el child)))) (assoc state "i" (inc (get state "i")))))))) (dict "i" 0 "skip" false) args) ;; Collect emitted spread attrs and merge onto DOM element (for-each (fn (spread-dict) (for-each (fn ((key :as string)) (let ((val (dict-get spread-dict key))) (if (= key "class") (let ((existing (dom-get-attr el "class"))) (dom-set-attr el "class" (if (and existing (not (= existing ""))) (str existing " " val) val))) (if (= key "style") (let ((existing (dom-get-attr el "style"))) (dom-set-attr el "style" (if (and existing (not (= existing ""))) (str existing ";" val) val))) (dom-set-attr el key (str val)))))) (keys spread-dict))) (emitted "element-attrs")) (scope-pop! "element-attrs") el))) ;; -------------------------------------------------------------------------- ;; render-dom-component — expand and render a component ;; -------------------------------------------------------------------------- (define render-dom-component :effects [render] (fn ((comp :as component) (args :as list) (env :as dict) (ns :as string)) ;; Parse kwargs and children, bind into component env, render body. (let ((kwargs (dict)) (children (list))) ;; Separate keyword args from positional children (reduce (fn (state 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))) ;; Keyword arg — evaluate in caller's env (let ((val (trampoline (eval-expr (nth args (inc (get state "i"))) env)))) (dict-set! kwargs (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) ;; Build component env: closure + caller env + params (let ((local (env-merge (component-closure comp) env))) ;; Bind params from kwargs (for-each (fn (p) (env-bind! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil))) (component-params comp)) ;; If component accepts children, pre-render them to a fragment ;; Spread values are filtered out (no parent element to merge onto) (when (component-has-children? comp) (let ((child-frag (create-fragment))) (for-each (fn (c) (let ((result (render-to-dom c env ns))) (when (not (spread? result)) (dom-append child-frag result)))) children) (env-bind! local "children" child-frag))) (render-to-dom (component-body comp) local ns))))) ;; -------------------------------------------------------------------------- ;; render-dom-fragment — render children into a DocumentFragment ;; -------------------------------------------------------------------------- (define render-dom-fragment :effects [render] (fn ((args :as list) (env :as dict) (ns :as string)) (let ((frag (create-fragment))) (for-each (fn (x) (let ((result (render-to-dom x env ns))) (when (not (spread? result)) (dom-append frag result)))) args) frag))) ;; -------------------------------------------------------------------------- ;; render-dom-raw — insert unescaped content ;; -------------------------------------------------------------------------- (define render-dom-raw :effects [render] (fn ((args :as list) (env :as dict)) (let ((frag (create-fragment))) (for-each (fn (arg) (let ((val (trampoline (eval-expr arg env)))) (cond (= (type-of val) "string") (dom-append frag (dom-parse-html val)) (= (type-of val) "dom-node") (dom-append frag (dom-clone val)) (not (nil? val)) (dom-append frag (create-text-node (str val)))))) args) frag))) ;; -------------------------------------------------------------------------- ;; render-dom-unknown-component — visible warning element ;; -------------------------------------------------------------------------- (define render-dom-unknown-component :effects [render] (fn ((name :as string)) (error (str "Unknown component: " name)))) ;; -------------------------------------------------------------------------- ;; Render-aware special forms for DOM output ;; -------------------------------------------------------------------------- ;; These forms need special handling in DOM rendering because they ;; produce DOM nodes rather than evaluated values. (define RENDER_DOM_FORMS (list "if" "when" "cond" "case" "let" "let*" "begin" "do" "define" "defcomp" "defisland" "defmacro" "defstyle" "map" "map-indexed" "filter" "for-each" "portal" "error-boundary" "scope" "provide")) (define render-dom-form? :effects [] (fn ((name :as string)) (contains? RENDER_DOM_FORMS name))) (define dispatch-render-form :effects [render] (fn ((name :as string) expr (env :as dict) (ns :as string)) (cond ;; if — reactive inside islands (re-renders when signal deps change) (= name "if") (if (context "sx-island-scope" nil) (let ((marker (create-comment "r-if")) (current-nodes (list)) (initial-result nil)) ;; Effect runs synchronously on first call, tracking signal deps. ;; On first run, store result in initial-result (marker has no parent yet). ;; On subsequent runs, swap DOM nodes after marker. (effect (fn () (let ((result (let ((cond-val (trampoline (eval-expr (nth expr 1) env)))) (if cond-val (render-to-dom (nth expr 2) env ns) (if (> (len expr) 3) (render-to-dom (nth expr 3) env ns) (create-fragment)))))) (if (dom-parent marker) ;; Marker is in DOM — swap nodes (do (for-each (fn (n) (dom-remove n)) current-nodes) (set! current-nodes (if (dom-is-fragment? result) (dom-child-nodes result) (list result))) (dom-insert-after marker result)) ;; Marker not yet in DOM (first run) — just save result (set! initial-result result))))) ;; Spread pass-through: spreads aren't DOM nodes, can't live ;; in fragments. Return directly so parent element merges attrs. (if (spread? initial-result) initial-result (let ((frag (create-fragment))) (dom-append frag marker) (when initial-result (set! current-nodes (if (dom-is-fragment? initial-result) (dom-child-nodes initial-result) (list initial-result))) (dom-append frag initial-result)) frag))) ;; Static if (let ((cond-val (trampoline (eval-expr (nth expr 1) env)))) (if cond-val (render-to-dom (nth expr 2) env ns) (if (> (len expr) 3) (render-to-dom (nth expr 3) env ns) (create-fragment))))) ;; when — reactive inside islands (= name "when") (if (context "sx-island-scope" nil) (let ((marker (create-comment "r-when")) (current-nodes (list)) (initial-result nil)) (effect (fn () (if (dom-parent marker) ;; In DOM — swap nodes (do (for-each (fn (n) (dom-remove n)) current-nodes) (set! current-nodes (list)) (when (trampoline (eval-expr (nth expr 1) env)) (let ((frag (create-fragment))) (for-each (fn (i) (dom-append frag (render-to-dom (nth expr i) env ns))) (range 2 (len expr))) (set! current-nodes (dom-child-nodes frag)) (dom-insert-after marker frag)))) ;; First run — save result for fragment (when (trampoline (eval-expr (nth expr 1) env)) (let ((frag (create-fragment))) (for-each (fn (i) (dom-append frag (render-to-dom (nth expr i) env ns))) (range 2 (len expr))) (set! current-nodes (dom-child-nodes frag)) (set! initial-result frag)))))) ;; Spread pass-through (if (spread? initial-result) initial-result (let ((frag (create-fragment))) (dom-append frag marker) (when initial-result (dom-append frag initial-result)) frag))) ;; Static when (if (not (trampoline (eval-expr (nth expr 1) env))) (create-fragment) (let ((frag (create-fragment))) (for-each (fn (i) (dom-append frag (render-to-dom (nth expr i) env ns))) (range 2 (len expr))) frag))) ;; cond — reactive inside islands (= name "cond") (if (context "sx-island-scope" nil) (let ((marker (create-comment "r-cond")) (current-nodes (list)) (initial-result nil)) (effect (fn () (let ((branch (eval-cond (rest expr) env))) (if (dom-parent marker) ;; In DOM — swap nodes (do (for-each (fn (n) (dom-remove n)) current-nodes) (set! current-nodes (list)) (when branch (let ((result (render-to-dom branch env ns))) (set! current-nodes (if (dom-is-fragment? result) (dom-child-nodes result) (list result))) (dom-insert-after marker result)))) ;; First run — save result for fragment (when branch (let ((result (render-to-dom branch env ns))) (set! current-nodes (if (dom-is-fragment? result) (dom-child-nodes result) (list result))) (set! initial-result result))))))) ;; Spread pass-through (if (spread? initial-result) initial-result (let ((frag (create-fragment))) (dom-append frag marker) (when initial-result (dom-append frag initial-result)) frag))) ;; Static cond (let ((branch (eval-cond (rest expr) env))) (if branch (render-to-dom branch env ns) (create-fragment)))) ;; case (= name "case") (render-to-dom (trampoline (eval-expr expr env)) env ns) ;; let / let* — single body: pass through (spread propagates). Multi: fragment. (or (= name "let") (= name "let*")) (let ((local (process-bindings (nth expr 1) env))) (if (= (len expr) 3) (render-to-dom (nth expr 2) local ns) (let ((frag (create-fragment))) (for-each (fn (i) (let ((result (render-to-dom (nth expr i) local ns))) (when (not (spread? result)) (dom-append frag result)))) (range 2 (len expr))) frag))) ;; begin / do — single body: pass through. Multi: fragment. (or (= name "begin") (= name "do")) (if (= (len expr) 2) (render-to-dom (nth expr 1) env ns) (let ((frag (create-fragment))) (for-each (fn (i) (let ((result (render-to-dom (nth expr i) env ns))) (when (not (spread? result)) (dom-append frag result)))) (range 1 (len expr))) frag)) ;; Definition forms — eval for side effects (definition-form? name) (do (trampoline (eval-expr expr env)) (create-fragment)) ;; map — reactive-list when mapping over a signal inside an island (= name "map") (let ((coll-expr (nth expr 2))) (if (and (context "sx-island-scope" nil) (= (type-of coll-expr) "list") (> (len coll-expr) 1) (= (type-of (first coll-expr)) "symbol") (= (symbol-name (first coll-expr)) "deref")) ;; Reactive path: pass signal to reactive-list (let ((f (trampoline (eval-expr (nth expr 1) env))) (sig (trampoline (eval-expr (nth coll-expr 1) env)))) (if (signal? sig) (reactive-list f sig env ns) ;; deref on non-signal: fall through to static (let ((coll (deref sig)) (frag (create-fragment))) (for-each (fn (item) (let ((val (if (lambda? f) (render-lambda-dom f (list item) env ns) (render-to-dom (apply f (list item)) env ns)))) (dom-append frag val))) coll) frag))) ;; Static path: no island scope or no deref (let ((f (trampoline (eval-expr (nth expr 1) env))) (coll (trampoline (eval-expr (nth expr 2) env))) (frag (create-fragment))) (for-each (fn (item) (let ((val (if (lambda? f) (render-lambda-dom f (list item) env ns) (render-to-dom (apply f (list item)) env ns)))) (dom-append frag val))) coll) frag))) ;; map-indexed (= name "map-indexed") (let ((f (trampoline (eval-expr (nth expr 1) env))) (coll (trampoline (eval-expr (nth expr 2) env))) (frag (create-fragment))) (for-each-indexed (fn (i item) (let ((val (if (lambda? f) (render-lambda-dom f (list i item) env ns) (render-to-dom (apply f (list i item)) env ns)))) (dom-append frag val))) coll) frag) ;; filter — evaluate fully then render (= name "filter") (render-to-dom (trampoline (eval-expr expr env)) env ns) ;; portal — render children into a remote target element (= name "portal") (render-dom-portal (rest expr) env ns) ;; error-boundary — catch errors, render fallback (= name "error-boundary") (render-dom-error-boundary (rest expr) env ns) ;; for-each (render variant) (= name "for-each") (let ((f (trampoline (eval-expr (nth expr 1) env))) (coll (trampoline (eval-expr (nth expr 2) env))) (frag (create-fragment))) (for-each (fn (item) (let ((val (if (lambda? f) (render-lambda-dom f (list item) env ns) (render-to-dom (apply f (list item)) env ns)))) (dom-append frag val))) coll) frag) ;; scope — unified render-time dynamic scope (= name "scope") (let ((scope-name (trampoline (eval-expr (nth expr 1) env))) (rest-args (slice expr 2)) (scope-val nil) (body-exprs nil) (frag (create-fragment))) ;; Check for :value keyword (if (and (>= (len rest-args) 2) (= (type-of (first rest-args)) "keyword") (= (keyword-name (first rest-args)) "value")) (do (set! scope-val (trampoline (eval-expr (nth rest-args 1) env))) (set! body-exprs (slice rest-args 2))) (set! body-exprs rest-args)) (scope-push! scope-name scope-val) (for-each (fn (e) (dom-append frag (render-to-dom e env ns))) body-exprs) (scope-pop! scope-name) frag) ;; provide — sugar for scope with value (= name "provide") (let ((prov-name (trampoline (eval-expr (nth expr 1) env))) (prov-val (trampoline (eval-expr (nth expr 2) env))) (frag (create-fragment))) (scope-push! prov-name prov-val) (for-each (fn (i) (dom-append frag (render-to-dom (nth expr i) env ns))) (range 3 (len expr))) (scope-pop! prov-name) frag) ;; Fallback :else (render-to-dom (trampoline (eval-expr expr env)) env ns)))) ;; -------------------------------------------------------------------------- ;; render-lambda-dom — render a lambda body in DOM context ;; -------------------------------------------------------------------------- (define render-lambda-dom :effects [render] (fn ((f :as lambda) (args :as list) (env :as dict) (ns :as string)) ;; Bind lambda params and render body as DOM (let ((local (env-merge (lambda-closure f) env))) (for-each-indexed (fn (i p) (env-bind! local p (nth args i))) (lambda-params f)) (render-to-dom (lambda-body f) local ns)))) ;; -------------------------------------------------------------------------- ;; render-dom-island — render a reactive island ;; -------------------------------------------------------------------------- ;; ;; Islands render like components but wrapped in a reactive context. ;; The island container element gets data-sx-island and data-sx-state ;; attributes for identification and hydration. ;; ;; Inside the island body, deref calls create reactive DOM subscriptions: ;; - Text bindings: (deref sig) in text position → reactive text node ;; - Attribute bindings: (deref sig) in attr → reactive attribute ;; - Conditional fragments: (when (deref sig) ...) → reactive show/hide (define render-dom-island :effects [render mutation] (fn ((island :as island) (args :as list) (env :as dict) (ns :as string)) ;; Parse kwargs and children (same as component) (let ((kwargs (dict)) (children (list))) (reduce (fn (state 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! kwargs (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) ;; Build island env: closure + caller env + params (let ((local (env-merge (component-closure island) env)) (island-name (component-name island))) ;; Bind params from kwargs (for-each (fn (p) (env-bind! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil))) (component-params island)) ;; If island accepts children, pre-render them to a fragment (when (component-has-children? island) (let ((child-frag (create-fragment))) (for-each (fn (c) (dom-append child-frag (render-to-dom c env ns))) children) (env-bind! local "children" child-frag))) ;; Create the island container element (let ((container (dom-create-element "span" nil)) (disposers (list))) ;; Mark as island + already hydrated (so boot.sx skips it) (dom-set-attr container "data-sx-island" island-name) (mark-processed! container "island-hydrated") ;; Render island body inside a scope that tracks disposers (let ((body-dom (with-island-scope (fn (disposable) (append! disposers disposable)) (fn () (render-to-dom (component-body island) local ns))))) (dom-append container body-dom) ;; Store disposers on the container for cleanup (dom-set-data container "sx-disposers" disposers) container)))))) ;; -------------------------------------------------------------------------- ;; render-dom-lake — server-morphable slot within an island ;; -------------------------------------------------------------------------- ;; ;; (lake :id "name" children...) ;; ;; Renders as
children
. ;; During morph, the server can replace lake content while the surrounding ;; reactive island DOM is preserved. This is the "water around the rocks" — ;; server substance flowing through client territory. ;; ;; Supports :tag keyword to change wrapper element (default "div"). (define render-dom-lake :effects [render] (fn ((args :as list) (env :as dict) (ns :as string)) (let ((lake-id nil) (lake-tag "div") (children (list))) (reduce (fn (state 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 ((kname (keyword-name arg)) (kval (trampoline (eval-expr (nth args (inc (get state "i"))) env)))) (cond (= kname "id") (set! lake-id kval) (= kname "tag") (set! lake-tag kval)) (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) (let ((el (dom-create-element lake-tag nil))) (dom-set-attr el "data-sx-lake" (or lake-id "")) (for-each (fn (c) (dom-append el (render-to-dom c env ns))) children) el)))) ;; -------------------------------------------------------------------------- ;; render-dom-marsh — reactive server-morphable slot within an island ;; -------------------------------------------------------------------------- ;; ;; (marsh :id "name" :tag "div" :transform fn children...) ;; ;; Like a lake but reactive: during morph, new content is parsed as SX and ;; re-evaluated in the island's signal scope. The :transform function (if ;; present) reshapes server content before evaluation. ;; ;; Renders as
children
. ;; Stores the island env and transform on the element for morph retrieval. (define render-dom-marsh :effects [render] (fn ((args :as list) (env :as dict) (ns :as string)) (let ((marsh-id nil) (marsh-tag "div") (marsh-transform nil) (children (list))) (reduce (fn (state 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 ((kname (keyword-name arg)) (kval (trampoline (eval-expr (nth args (inc (get state "i"))) env)))) (cond (= kname "id") (set! marsh-id kval) (= kname "tag") (set! marsh-tag kval) (= kname "transform") (set! marsh-transform kval)) (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) (let ((el (dom-create-element marsh-tag nil))) (dom-set-attr el "data-sx-marsh" (or marsh-id "")) ;; Store transform function and island env for morph retrieval (when marsh-transform (dom-set-data el "sx-marsh-transform" marsh-transform)) (dom-set-data el "sx-marsh-env" env) (for-each (fn (c) (dom-append el (render-to-dom c env ns))) children) el)))) ;; -------------------------------------------------------------------------- ;; Reactive DOM rendering helpers ;; -------------------------------------------------------------------------- ;; ;; These functions create reactive bindings between signals and DOM nodes. ;; They are called by the platform's renderDOM when it detects deref ;; calls inside an island context. ;; reactive-text — create a text node bound to a signal ;; Used when (deref sig) appears in a text position inside an island. (define reactive-text :effects [render mutation] (fn (sig) (let ((node (create-text-node (str (deref sig))))) (effect (fn () (dom-set-text-content node (str (deref sig))))) node))) ;; reactive-attr — bind an element attribute to a signal expression ;; Used when an attribute value contains (deref sig) inside an island. ;; Marks the attribute name on the element via data-sx-reactive-attrs so ;; the morph algorithm knows not to overwrite it with server content. (define reactive-attr :effects [render mutation] (fn (el (attr-name :as string) (compute-fn :as lambda)) ;; Mark this attribute as reactively managed (let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") "")) (updated (if (empty? existing) attr-name (str existing "," attr-name)))) (dom-set-attr el "data-sx-reactive-attrs" updated)) (effect (fn () (let ((raw (compute-fn))) ;; If compute-fn returned a signal (e.g. from computed), deref it ;; to get the actual value and track the dependency (let ((val (if (signal? raw) (deref raw) raw))) (cond (or (nil? val) (= val false)) (dom-remove-attr el attr-name) (= val true) (dom-set-attr el attr-name "") :else (dom-set-attr el attr-name (str val))))))))) ;; reactive-spread — reactively bind spread attrs to parent element. ;; Used when a child of an element produces a spread inside an island. ;; Tracks signal deps in the spread expression. When signals change: ;; old classes are removed, new ones applied. Non-class attrs (data-tw etc.) ;; are overwritten. Flushes newly collected CSS rules to live stylesheet. ;; ;; Multiple reactive spreads on the same element are safe — each tracks ;; its own class contribution and only removes/adds its own tokens. (define reactive-spread :effects [render mutation] (fn (el (render-fn :as lambda)) (let ((prev-classes (list)) (prev-extra-keys (list))) ;; Mark for morph protection (let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") ""))) (dom-set-attr el "data-sx-reactive-attrs" (if (empty? existing) "_spread" (str existing ",_spread")))) (effect (fn () ;; 1. Remove previously applied classes from element's class list (when (not (empty? prev-classes)) (let ((current (or (dom-get-attr el "class") "")) (tokens (filter (fn (c) (not (= c ""))) (split current " "))) (kept (filter (fn (c) (not (some (fn (pc) (= pc c)) prev-classes))) tokens))) (if (empty? kept) (dom-remove-attr el "class") (dom-set-attr el "class" (join " " kept))))) ;; 2. Remove previously applied extra attrs (for-each (fn (k) (dom-remove-attr el k)) prev-extra-keys) ;; 3. Re-evaluate the spread expression (tracks signal deps) (let ((result (render-fn))) (if (spread? result) (let ((attrs (spread-attrs result)) (cls-str (or (dict-get attrs "class") "")) (new-classes (filter (fn (c) (not (= c ""))) (split cls-str " "))) (extra-keys (filter (fn (k) (not (= k "class"))) (keys attrs)))) (set! prev-classes new-classes) (set! prev-extra-keys extra-keys) ;; Append new classes to element (when (not (empty? new-classes)) (let ((current (or (dom-get-attr el "class") ""))) (dom-set-attr el "class" (if (and current (not (= current ""))) (str current " " cls-str) cls-str)))) ;; Set extra attrs (data-tw, etc.) — simple overwrite (for-each (fn (k) (dom-set-attr el k (str (dict-get attrs k)))) extra-keys) ;; Flush any newly collected CSS rules to live stylesheet (run-post-render-hooks)) ;; No longer a spread — clear tracked state (do (set! prev-classes (list)) (set! prev-extra-keys (list)))))))))) ;; reactive-fragment — conditionally render a fragment based on a signal ;; Used for (when (deref sig) ...) or (if (deref sig) ...) inside an island. (define reactive-fragment :effects [render mutation] (fn ((test-fn :as lambda) (render-fn :as lambda) (env :as dict) (ns :as string)) (let ((marker (create-comment "island-fragment")) (current-nodes (list))) (effect (fn () ;; Remove previous nodes (for-each (fn (n) (dom-remove n)) current-nodes) (set! current-nodes (list)) ;; If test passes, render and insert after marker (when (test-fn) (let ((frag (render-fn))) (set! current-nodes (dom-child-nodes frag)) (dom-insert-after marker frag))))) marker))) ;; reactive-list — render a keyed list bound to a signal ;; Used for (map fn (deref items)) inside an island. ;; ;; Keyed reconciliation: if rendered elements have a "key" attribute, ;; existing DOM nodes are reused across updates. Only additions, removals, ;; and reorderings touch the DOM. Without keys, falls back to clear+rerender. (define render-list-item :effects [render] (fn ((map-fn :as lambda) item (env :as dict) (ns :as string)) (if (lambda? map-fn) (render-lambda-dom map-fn (list item) env ns) (render-to-dom (apply map-fn (list item)) env ns)))) (define extract-key :effects [render] (fn (node (index :as number)) ;; Extract key from rendered node: :key attr, data-key, or index fallback (let ((k (dom-get-attr node "key"))) (if k (do (dom-remove-attr node "key") k) (let ((dk (dom-get-data node "key"))) (if dk (str dk) (str "__idx_" index))))))) (define reactive-list :effects [render mutation] (fn ((map-fn :as lambda) (items-sig :as signal) (env :as dict) (ns :as string)) (let ((container (create-fragment)) (marker (create-comment "island-list")) (key-map (dict)) (key-order (list))) (dom-append container marker) (effect (fn () (let ((items (deref items-sig))) (if (dom-parent marker) ;; Marker in DOM: reconcile (let ((new-map (dict)) (new-keys (list)) (has-keys false)) ;; Render or reuse each item (for-each-indexed (fn (idx item) (let ((rendered (render-list-item map-fn item env ns)) (key (extract-key rendered idx))) (when (and (not has-keys) (not (starts-with? key "__idx_"))) (set! has-keys true)) ;; Reuse existing node if key matches, else use new (if (dict-has? key-map key) (dict-set! new-map key (dict-get key-map key)) (dict-set! new-map key rendered)) (append! new-keys key))) items) (if (not has-keys) ;; No keys: simple clear and re-render (original strategy) (do (dom-remove-children-after marker) (let ((frag (create-fragment))) (for-each (fn (k) (dom-append frag (dict-get new-map k))) new-keys) (dom-insert-after marker frag))) ;; Keyed reconciliation (do ;; Remove stale nodes (for-each (fn (old-key) (when (not (dict-has? new-map old-key)) (dom-remove (dict-get key-map old-key)))) key-order) ;; Reorder/insert to match new key order (let ((cursor marker)) (for-each (fn (k) (let ((node (dict-get new-map k)) (next (dom-next-sibling cursor))) (when (not (identical? node next)) (dom-insert-after cursor node)) (set! cursor node))) new-keys)))) ;; Update state for next render (set! key-map new-map) (set! key-order new-keys)) ;; First run (marker not in DOM yet): render initial items into container (for-each-indexed (fn (idx item) (let ((rendered (render-list-item map-fn item env ns)) (key (extract-key rendered idx))) (dict-set! key-map key rendered) (append! key-order key) (dom-append container rendered))) items))))) container))) ;; -------------------------------------------------------------------------- ;; bind-input — two-way signal binding for form elements ;; -------------------------------------------------------------------------- ;; ;; (bind-input el sig) creates a bidirectional link: ;; Signal → element: effect updates el.value (or el.checked) when sig changes ;; Element → signal: input/change listener updates sig when user types ;; ;; Handles: input[text/number/email/...], textarea, select, checkbox, radio (define bind-input :effects [render mutation] (fn (el (sig :as signal)) (let ((input-type (lower (or (dom-get-attr el "type") ""))) (is-checkbox (or (= input-type "checkbox") (= input-type "radio")))) ;; Set initial value from signal (if is-checkbox (dom-set-prop el "checked" (deref sig)) (dom-set-prop el "value" (str (deref sig)))) ;; Signal → element (reactive effect) (effect (fn () (if is-checkbox (dom-set-prop el "checked" (deref sig)) (let ((v (str (deref sig)))) (when (!= (dom-get-prop el "value") v) (dom-set-prop el "value" v)))))) ;; Element → signal (event listener) (dom-on el (if is-checkbox "change" "input") (fn (e) (if is-checkbox (reset! sig (dom-get-prop el "checked")) (reset! sig (dom-get-prop el "value")))))))) ;; -------------------------------------------------------------------------- ;; CEK-based reactive rendering (opt-in, deref-as-shift) ;; -------------------------------------------------------------------------- ;; ;; When enabled, (deref sig) inside a reactive-reset boundary performs ;; continuation capture: "the rest of this expression" becomes the subscriber. ;; No explicit effect() wrapping needed for text/attr bindings. (define *use-cek-reactive* true) (define enable-cek-reactive! (fn () (set! *use-cek-reactive* true))) ;; cek-reactive-text — create a text node bound via continuation capture (define cek-reactive-text :effects [render mutation] (fn (expr env) (let ((node (create-text-node "")) (update-fn (fn (val) (dom-set-text-content node (str val))))) (let ((initial (cek-run (make-cek-state expr env (list (make-reactive-reset-frame env update-fn true)))))) (dom-set-text-content node (str initial)) node)))) ;; cek-reactive-attr — bind an attribute via continuation capture (define cek-reactive-attr :effects [render mutation] (fn (el attr-name expr env) (let ((update-fn (fn (val) (cond (or (nil? val) (= val false)) (dom-remove-attr el attr-name) (= val true) (dom-set-attr el attr-name "") :else (dom-set-attr el attr-name (str val)))))) ;; Mark for morph protection (let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") "")) (updated (if (empty? existing) attr-name (str existing "," attr-name)))) (dom-set-attr el "data-sx-reactive-attrs" updated)) ;; Initial render via CEK with ReactiveResetFrame (let ((initial (cek-run (make-cek-state expr env (list (make-reactive-reset-frame env update-fn true)))))) (cek-call update-fn (list initial)))))) ;; -------------------------------------------------------------------------- ;; render-dom-portal — render children into a remote target element ;; -------------------------------------------------------------------------- ;; ;; (portal "#modal-root" (div "content")) ;; ;; Renders children into the DOM node matched by the selector, rather than ;; into the current position. Returns a comment marker at the original ;; position. Registers a disposer to clean up portal content on island ;; teardown. (define render-dom-portal :effects [render] (fn ((args :as list) (env :as dict) (ns :as string)) (let ((selector (trampoline (eval-expr (first args) env))) (target (or (dom-query selector) (dom-ensure-element selector)))) (if (not target) (create-comment (str "portal: " selector " (not found)")) (let ((marker (create-comment (str "portal: " selector))) (frag (create-fragment))) ;; Render children into the fragment (for-each (fn (child) (dom-append frag (render-to-dom child env ns))) (rest args)) ;; Track portal nodes for disposal (let ((portal-nodes (dom-child-nodes frag))) ;; Append into remote target (dom-append target frag) ;; Register disposer: remove portal content on island teardown (register-in-scope (fn () (for-each (fn (n) (dom-remove n)) portal-nodes)))) ;; Return marker at original position marker))))) ;; -------------------------------------------------------------------------- ;; render-dom-error-boundary — catch errors, render fallback UI ;; -------------------------------------------------------------------------- ;; ;; (error-boundary fallback-fn body...) ;; ;; Renders body children inside a try/catch. If any child throws during ;; rendering, the fallback function is called with the error object, and ;; its result is rendered instead. Effects within the boundary are disposed ;; on error. ;; ;; The fallback function receives the error and a retry thunk: ;; (fn (err retry) ...) ;; Calling (retry) re-renders the body, replacing the fallback. (define render-dom-error-boundary :effects [render] (fn ((args :as list) (env :as dict) (ns :as string)) (let ((fallback-expr (first args)) (body-exprs (rest args)) (container (dom-create-element "div" nil)) ;; retry-version: bump this signal to force re-render after fallback (retry-version (signal 0))) (dom-set-attr container "data-sx-boundary" "true") ;; The entire body is rendered inside ONE effect + try-catch. ;; Body renders WITHOUT island scope so that if/when/cond use static ;; paths — their signal reads become direct deref calls tracked by THIS ;; effect. Errors from signal changes throw synchronously within try-catch. ;; The error boundary's own effect handles all reactivity for its subtree. (effect (fn () ;; Touch retry-version so the effect re-runs when retry is called (deref retry-version) ;; Clear container (dom-set-prop container "innerHTML" "") ;; Push nil island scope to suppress reactive rendering in body. ;; Pop in both success and error paths. (scope-push! "sx-island-scope" nil) (try-catch (fn () ;; Body renders statically — signal reads tracked by THIS effect, ;; throws propagate to our try-catch. (let ((frag (create-fragment))) (for-each (fn (child) (dom-append frag (render-to-dom child env ns))) body-exprs) (dom-append container frag)) (scope-pop! "sx-island-scope")) (fn (err) ;; Pop scope first, then render fallback (scope-pop! "sx-island-scope") (let ((fallback-fn (trampoline (eval-expr fallback-expr env))) (retry-fn (fn () (swap! retry-version (fn (n) (+ n 1)))))) (let ((fallback-dom (if (lambda? fallback-fn) (render-lambda-dom fallback-fn (list err retry-fn) env ns) (render-to-dom (apply fallback-fn (list err retry-fn)) env ns)))) (dom-append container fallback-dom))))))) container))) ;; -------------------------------------------------------------------------- ;; Platform interface — DOM adapter ;; -------------------------------------------------------------------------- ;; ;; Element creation: ;; (dom-create-element tag ns) → Element (ns=nil for HTML, string for SVG/MathML) ;; (create-text-node s) → Text node ;; (create-fragment) → DocumentFragment ;; (create-comment s) → Comment node ;; ;; Tree mutation: ;; (dom-append parent child) → void (appendChild) ;; (dom-set-attr el name val) → void (setAttribute) ;; (dom-remove-attr el name) → void (removeAttribute) ;; (dom-get-attr el name) → string or nil (getAttribute) ;; (dom-set-text-content n s) → void (set textContent) ;; (dom-remove node) → void (remove from parent) ;; (dom-insert-after ref node) → void (insert node after ref) ;; (dom-parent node) → parent Element or nil ;; (dom-child-nodes frag) → list of child nodes ;; (dom-remove-children-after m)→ void (remove all siblings after marker) ;; (dom-set-data el key val) → void (store arbitrary data on element) ;; (dom-get-data el key) → any (retrieve data stored on element) ;; ;; Property access (for input binding): ;; (dom-set-prop el name val) → void (set JS property: el[name] = val) ;; (dom-get-prop el name) → any (read JS property: el[name]) ;; ;; Query (for portals): ;; (dom-query selector) → Element or nil (document.querySelector) ;; ;; Event handling: ;; (dom-listen el name handler) → remove-fn (addEventListener, returns remover) ;; (dom-dispatch el name detail)→ boolean (dispatch CustomEvent, bubbles: true) ;; ;; Content parsing: ;; (dom-parse-html s) → DocumentFragment from HTML string ;; (dom-clone node) → deep clone of a DOM node ;; ;; Type checking: ;; DOM nodes have type-of → "dom-node" ;; ;; From render.sx: ;; HTML_TAGS, VOID_ELEMENTS, BOOLEAN_ATTRS, definition-form? ;; ;; From eval.sx: ;; eval-expr, trampoline, expand-macro, process-bindings, eval-cond ;; env-has?, env-get, env-set!, env-merge ;; lambda?, component?, island?, macro? ;; lambda-closure, lambda-params, lambda-body ;; component-params, component-body, component-closure, ;; component-has-children?, component-name ;; ;; From signals.sx: ;; signal, deref, reset!, swap!, computed, effect, batch ;; signal?, with-island-scope, register-in-scope ;; ;; Pure primitives used: ;; keys, get, str ;; ;; Iteration: ;; (for-each-indexed fn coll) → call fn(index, item) for each element ;; --------------------------------------------------------------------------