giles
7efd1b401b
- suspense render-dom form: shows fallback while resource loads, swaps to body content when resource signal resolves - resource async signal: wraps promise into signal with loading/data/error dict, auto-transitions on resolve/reject via promise-then - transition: defers signal writes to requestIdleCallback, sets pending signal for UI feedback during expensive operations - Added schedule-idle, promise-then platform functions - All Phase 2 features now marked Done in status tables Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
955 lines
36 KiB
Plaintext
955 lines
36 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
|
|
(fn (expr env ns)
|
|
(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
|
|
|
|
;; Dict → empty
|
|
"dict" (create-fragment)
|
|
|
|
;; List → dispatch
|
|
"list"
|
|
(if (empty? expr)
|
|
(create-fragment)
|
|
(render-dom-list expr env ns))
|
|
|
|
;; Fallback
|
|
:else (create-text-node (str expr)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; render-dom-list — dispatch on list head
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define render-dom-list
|
|
(fn (expr env ns)
|
|
(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)
|
|
|
|
;; 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") *island-scope*)
|
|
(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) (dom-append frag (render-to-dom x env ns))) expr)
|
|
frag)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; render-dom-element — create a DOM element with attrs and children
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define render-dom-element
|
|
(fn (tag args env ns)
|
|
;; 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)))
|
|
|
|
;; 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-val (trampoline
|
|
(eval-expr
|
|
(nth args (inc (get state "i")))
|
|
env))))
|
|
(cond
|
|
;; nil or false → skip
|
|
(or (nil? attr-val) (= attr-val false))
|
|
nil
|
|
;; Event handler: on-click, on-submit, on-input, etc.
|
|
;; Value must be callable (lambda/function)
|
|
(and (starts-with? attr-name "on-")
|
|
(callable? attr-val))
|
|
(dom-listen el (slice attr-name 3) attr-val)
|
|
;; Two-way input binding: :bind signal
|
|
(and (= attr-name "bind") (signal? attr-val))
|
|
(bind-input el attr-val)
|
|
;; ref: set ref.current to this element
|
|
(= attr-name "ref")
|
|
(ref-set! attr-val el)
|
|
;; Boolean attr
|
|
(contains? BOOLEAN_ATTRS attr-name)
|
|
(when attr-val (dom-set-attr el attr-name ""))
|
|
;; true → empty attr
|
|
(= attr-val true)
|
|
(dom-set-attr el attr-name "")
|
|
;; Normal attr
|
|
:else
|
|
(dom-set-attr el attr-name (str attr-val)))
|
|
(assoc state "skip" true "i" (inc (get state "i"))))
|
|
|
|
;; Positional arg → child
|
|
(do
|
|
(when (not (contains? VOID_ELEMENTS tag))
|
|
(dom-append el (render-to-dom arg env new-ns)))
|
|
(assoc state "i" (inc (get state "i"))))))))
|
|
(dict "i" 0 "skip" false)
|
|
args)
|
|
|
|
el)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; render-dom-component — expand and render a component
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define render-dom-component
|
|
(fn (comp args env ns)
|
|
;; 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
|
|
(when (component-has-children? comp)
|
|
(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)))
|
|
|
|
(render-to-dom (component-body comp) local ns)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; render-dom-fragment — render children into a DocumentFragment
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define render-dom-fragment
|
|
(fn (args env ns)
|
|
(let ((frag (create-fragment)))
|
|
(for-each
|
|
(fn (x) (dom-append frag (render-to-dom x env ns)))
|
|
args)
|
|
frag)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; render-dom-raw — insert unescaped content
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define render-dom-raw
|
|
(fn (args env)
|
|
(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
|
|
(fn (name)
|
|
(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" "suspense"))
|
|
|
|
(define render-dom-form?
|
|
(fn (name)
|
|
(contains? RENDER_DOM_FORMS name)))
|
|
|
|
(define dispatch-render-form
|
|
(fn (name expr env ns)
|
|
(cond
|
|
;; if
|
|
(= name "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
|
|
(= name "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
|
|
(= name "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*
|
|
(or (= name "let") (= name "let*"))
|
|
(let ((local (process-bindings (nth expr 1) env))
|
|
(frag (create-fragment)))
|
|
(for-each
|
|
(fn (i)
|
|
(dom-append frag (render-to-dom (nth expr i) local ns)))
|
|
(range 2 (len expr)))
|
|
frag)
|
|
|
|
;; begin / do
|
|
(or (= name "begin") (= name "do"))
|
|
(let ((frag (create-fragment)))
|
|
(for-each
|
|
(fn (i)
|
|
(dom-append frag (render-to-dom (nth expr i) env ns)))
|
|
(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 *island-scope*
|
|
(= (type-of coll-expr) "list")
|
|
(> (len coll-expr) 1)
|
|
(= (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 args env ns)
|
|
|
|
;; error-boundary — catch errors, render fallback
|
|
(= name "error-boundary")
|
|
(render-dom-error-boundary args env ns)
|
|
|
|
;; suspense — show fallback while resource is loading
|
|
(= name "suspense")
|
|
(render-dom-suspense args 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)
|
|
|
|
;; 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
|
|
(fn (f args env ns)
|
|
;; 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
|
|
(fn (island args env ns)
|
|
;; 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 "div" nil))
|
|
(disposers (list)))
|
|
|
|
;; Mark as island
|
|
(dom-set-attr container "data-sx-island" island-name)
|
|
|
|
;; 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))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 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
|
|
(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.
|
|
(define reactive-attr
|
|
(fn (el attr-name compute-fn)
|
|
(effect (fn ()
|
|
(let ((val (compute-fn)))
|
|
(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-fragment — conditionally render a fragment based on a signal
|
|
;; Used for (when (deref sig) ...) or (if (deref sig) ...) inside an island.
|
|
(define reactive-fragment
|
|
(fn (test-fn render-fn env ns)
|
|
(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
|
|
(fn (map-fn item env ns)
|
|
(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
|
|
(fn (node index)
|
|
;; 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
|
|
(fn (map-fn items-sig env ns)
|
|
(let ((container (create-fragment))
|
|
(marker (create-comment "island-list"))
|
|
(key-map (dict))
|
|
(key-order (list)))
|
|
(dom-append container marker)
|
|
(effect (fn ()
|
|
(let ((parent (dom-parent marker))
|
|
(items (deref items-sig)))
|
|
(when parent
|
|
(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))))))
|
|
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
|
|
(fn (el sig)
|
|
(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"))))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 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
|
|
(fn (args env ns)
|
|
(let ((selector (trampoline (eval-expr (first args) env)))
|
|
(target (dom-query selector)))
|
|
(if (not target)
|
|
;; Target not found — render nothing, log warning
|
|
(do
|
|
(log-warn (str "Portal target not found: " selector))
|
|
(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
|
|
(fn (args env ns)
|
|
(let ((fallback-expr (first args))
|
|
(body-exprs (rest args))
|
|
(container (dom-create-element "div" nil))
|
|
(boundary-disposers (list)))
|
|
(dom-set-attr container "data-sx-boundary" "true")
|
|
|
|
;; Render body with its own island scope for disposal
|
|
(let ((render-body
|
|
(fn ()
|
|
;; Dispose old boundary content
|
|
(for-each (fn (d) (d)) boundary-disposers)
|
|
(set! boundary-disposers (list))
|
|
|
|
;; Clear container
|
|
(dom-set-prop container "innerHTML" "")
|
|
|
|
;; Try to render body
|
|
(try-catch
|
|
(fn ()
|
|
;; Render body children, tracking disposers
|
|
(with-island-scope
|
|
(fn (disposable)
|
|
(append! boundary-disposers disposable)
|
|
(register-in-scope disposable))
|
|
(fn ()
|
|
(let ((frag (create-fragment)))
|
|
(for-each
|
|
(fn (child)
|
|
(dom-append frag (render-to-dom child env ns)))
|
|
body-exprs)
|
|
(dom-append container frag)))))
|
|
(fn (err)
|
|
;; Dispose any partially-created effects
|
|
(for-each (fn (d) (d)) boundary-disposers)
|
|
(set! boundary-disposers (list))
|
|
|
|
;; Render fallback with error + retry
|
|
(let ((fallback-fn (trampoline (eval-expr fallback-expr env)))
|
|
(retry-fn (fn () (render-body))))
|
|
(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))))))))
|
|
|
|
;; Initial render
|
|
(render-body)
|
|
|
|
;; Register boundary disposers with parent island scope
|
|
(register-in-scope
|
|
(fn ()
|
|
(for-each (fn (d) (d)) boundary-disposers)
|
|
(set! boundary-disposers (list))))
|
|
|
|
container))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; render-dom-suspense — show fallback while resource is loading
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; (suspense fallback-expr body...)
|
|
;;
|
|
;; Renders fallback-expr initially. When used with a resource signal,
|
|
;; an effect watches the resource state and swaps in the body content
|
|
;; once loading is complete. If the resource errors, renders the error.
|
|
;;
|
|
;; The simplest pattern: wrap a resource deref in suspense.
|
|
;;
|
|
;; (suspense
|
|
;; (div "Loading...")
|
|
;; (let ((data (get (deref user-resource) "data")))
|
|
;; (div (get data "name"))))
|
|
|
|
(define render-dom-suspense
|
|
(fn (args env ns)
|
|
(let ((fallback-expr (first args))
|
|
(body-exprs (rest args))
|
|
(container (dom-create-element "div" nil)))
|
|
(dom-set-attr container "data-sx-suspense" "true")
|
|
;; Render fallback immediately
|
|
(dom-append container (render-to-dom fallback-expr env ns))
|
|
;; Try to render body — if it works, replace fallback
|
|
;; The body typically derefs a resource signal, which triggers
|
|
;; an effect that re-renders when the resource resolves
|
|
(let ((body-disposers (list)))
|
|
(effect (fn ()
|
|
;; Dispose previous body renders
|
|
(for-each (fn (d) (d)) body-disposers)
|
|
(set! body-disposers (list))
|
|
;; Try rendering the body
|
|
(try-catch
|
|
(fn ()
|
|
(let ((frag (create-fragment)))
|
|
(with-island-scope
|
|
(fn (disposable)
|
|
(append! body-disposers disposable)
|
|
(register-in-scope disposable))
|
|
(fn ()
|
|
(for-each
|
|
(fn (child)
|
|
(dom-append frag (render-to-dom child env ns)))
|
|
body-exprs)))
|
|
;; Success — replace container content with body
|
|
(dom-set-prop container "innerHTML" "")
|
|
(dom-append container frag)))
|
|
(fn (err)
|
|
;; Body threw — keep showing fallback (or show error)
|
|
nil))))
|
|
;; Register cleanup
|
|
(register-in-scope
|
|
(fn ()
|
|
(for-each (fn (d) (d)) body-disposers)
|
|
(set! body-disposers (list)))))
|
|
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
|
|
;; ref, ref-get, ref-set!
|
|
;;
|
|
;; Pure primitives used:
|
|
;; keys, get, str
|
|
;;
|
|
;; Iteration:
|
|
;; (for-each-indexed fn coll) → call fn(index, item) for each element
|
|
;; --------------------------------------------------------------------------
|