giles
1da55f14e0
Some checks failed
Build and Deploy / build-and-deploy (push) Has been cancelled
Cache the style element reference in _cssx-style-el so flush-cssx-to-dom never creates more than one. Previous code called dom-query on every flush, which could miss the element during rapid successive calls, creating duplicates. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
1315 lines
55 KiB
Plaintext
1315 lines
55 KiB
Plaintext
;; ==========================================================================
|
|
;; 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")
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 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-listen 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-set! 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-set! 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" "defhandler"
|
|
"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-set! 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-set! 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-set! 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 <div data-sx-lake="name">children</div>.
|
|
;; 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 <div data-sx-marsh="name">children</div>.
|
|
;; 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-listen 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
|
|
;; --------------------------------------------------------------------------
|