DOM-preserving hydration — SSR DOM stays, event listeners attach in place
Scope-based cursor walks the existing SSR DOM during island hydration instead of creating new elements and calling replaceChildren. The hydration scope (sx-hydrating) propagates through define-library via scope-push!/peek/pop!, solving the env isolation that broke the previous set!-based approach. Changes: - adapter-dom.sx: hydrating?, hydrate-next-node, hydrate-enter/exit-element helpers. render-to-dom reuses text nodes. render-dom-element reuses elements by tag match, skips dom-append. reactive-text/cek-reactive-text reuse existing text nodes. render-dom-fragment/lake/marsh skip append. dispatch-render-form (if/when/cond) injects markers into existing DOM. - boot.sx: hydrate-island pushes cursor scope, skips replaceChildren. On mismatch error, falls back to full re-render. Result: zero DOM destruction, zero visual flash, event listeners attached to original SSR elements. Stepper clicks verified working. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1,17 +1,70 @@
|
||||
(import (sx dom))
|
||||
(import (sx render))
|
||||
|
||||
(define-library (web adapter-dom)
|
||||
(export SVG_NS MATH_NS island-scope? contains-deref? dom-on render-to-dom render-dom-list render-dom-element render-dom-component render-dom-fragment render-dom-raw render-dom-unknown-component RENDER_DOM_FORMS render-dom-form? dispatch-render-form render-lambda-dom render-dom-island render-dom-lake render-dom-marsh reactive-text reactive-attr reactive-spread reactive-fragment render-list-item extract-key reactive-list bind-input *use-cek-reactive* enable-cek-reactive! cek-reactive-text cek-reactive-attr render-dom-portal render-dom-error-boundary)
|
||||
(define-library
|
||||
(web adapter-dom)
|
||||
(export
|
||||
SVG_NS
|
||||
MATH_NS
|
||||
island-scope?
|
||||
hydrating?
|
||||
contains-deref?
|
||||
dom-on
|
||||
render-to-dom
|
||||
render-dom-list
|
||||
render-dom-element
|
||||
render-dom-component
|
||||
render-dom-fragment
|
||||
render-dom-raw
|
||||
render-dom-unknown-component
|
||||
RENDER_DOM_FORMS
|
||||
render-dom-form?
|
||||
dispatch-render-form
|
||||
render-lambda-dom
|
||||
render-dom-island
|
||||
render-dom-lake
|
||||
render-dom-marsh
|
||||
reactive-text
|
||||
reactive-attr
|
||||
reactive-spread
|
||||
reactive-fragment
|
||||
render-list-item
|
||||
extract-key
|
||||
reactive-list
|
||||
bind-input
|
||||
*use-cek-reactive*
|
||||
enable-cek-reactive!
|
||||
cek-reactive-text
|
||||
cek-reactive-attr
|
||||
render-dom-portal
|
||||
render-dom-error-boundary)
|
||||
(begin
|
||||
(define SVG_NS "http://www.w3.org/2000/svg")
|
||||
(define MATH_NS "http://www.w3.org/1998/Math/MathML")
|
||||
(define
|
||||
island-scope?
|
||||
(fn () (not (nil? (scope-peek "sx-island-scope")))))
|
||||
(define hydrating? (fn () (not (nil? (scope-peek "sx-hydrating")))))
|
||||
(define
|
||||
hydrate-next-node
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((cursor (scope-peek "sx-hydrating")))
|
||||
(when
|
||||
cursor
|
||||
(let
|
||||
((parent (dict-get cursor "parent"))
|
||||
(idx (dict-get cursor "index")))
|
||||
(let
|
||||
((child (host-call (host-get parent "childNodes") "item" idx)))
|
||||
(dict-set! cursor "index" (+ idx 1))
|
||||
child))))))
|
||||
(define
|
||||
hydrate-enter-element
|
||||
(fn (el) (scope-push! "sx-hydrating" (dict "parent" el "index" 0))))
|
||||
(define hydrate-exit-element (fn () (scope-pop! "sx-hydrating")))
|
||||
(begin
|
||||
|
||||
(define SVG_NS "http://www.w3.org/2000/svg")
|
||||
|
||||
(define MATH_NS "http://www.w3.org/1998/Math/MathML")
|
||||
|
||||
(define island-scope? (fn () (not (nil? (scope-peek "sx-island-scope")))))
|
||||
|
||||
(begin
|
||||
(define *memo-cache* (dict))
|
||||
(define *cyst-counter* 0)
|
||||
(define
|
||||
@@ -20,8 +73,7 @@
|
||||
()
|
||||
(set! *cyst-counter* (+ *cyst-counter* 1))
|
||||
(str "sx-cyst-" *cyst-counter*))))
|
||||
|
||||
(define
|
||||
(define
|
||||
contains-deref?
|
||||
(fn
|
||||
(expr)
|
||||
@@ -37,8 +89,7 @@
|
||||
(= (symbol-name (first expr)) "deref"))
|
||||
true
|
||||
(some contains-deref? expr))))))
|
||||
|
||||
(define
|
||||
(define
|
||||
dom-on
|
||||
:effects (io)
|
||||
(fn
|
||||
@@ -59,8 +110,7 @@
|
||||
(trampoline (call-lambda handler (list e)))
|
||||
(run-post-render-hooks)))
|
||||
handler))))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-to-dom
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -75,13 +125,22 @@
|
||||
"raw-html"
|
||||
(dom-parse-html (raw-html-content expr))
|
||||
"string"
|
||||
(create-text-node expr)
|
||||
(if
|
||||
(hydrating?)
|
||||
(or (hydrate-next-node) (create-text-node expr))
|
||||
(create-text-node expr))
|
||||
"number"
|
||||
(create-text-node (str expr))
|
||||
(if
|
||||
(hydrating?)
|
||||
(or (hydrate-next-node) (create-text-node (str expr)))
|
||||
(create-text-node (str expr)))
|
||||
"symbol"
|
||||
(render-to-dom (trampoline (eval-expr expr env)) env ns)
|
||||
"keyword"
|
||||
(create-text-node (keyword-name expr))
|
||||
(if
|
||||
(hydrating?)
|
||||
(or (hydrate-next-node) (create-text-node (keyword-name expr)))
|
||||
(create-text-node (keyword-name expr)))
|
||||
"dom-node"
|
||||
expr
|
||||
"spread"
|
||||
@@ -101,8 +160,7 @@
|
||||
(reactive-text expr)
|
||||
(create-text-node (str (deref expr))))
|
||||
(create-text-node (str expr))))))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-dom-list
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -136,7 +194,10 @@
|
||||
(render-dom-element name args env ns)
|
||||
(dispatch-render-form name expr env ns))
|
||||
(and (env-has? env name) (macro? (env-get env name)))
|
||||
(render-to-dom (expand-macro (env-get env name) args env) env ns)
|
||||
(render-to-dom
|
||||
(expand-macro (env-get env name) args env)
|
||||
env
|
||||
ns)
|
||||
(contains? HTML_TAGS name)
|
||||
(render-dom-element name args env ns)
|
||||
(and
|
||||
@@ -156,7 +217,12 @@
|
||||
((skip (get state "skip")))
|
||||
(if
|
||||
skip
|
||||
(assoc state "skip" false "i" (inc (get state "i")))
|
||||
(assoc
|
||||
state
|
||||
"skip"
|
||||
false
|
||||
"i"
|
||||
(inc (get state "i")))
|
||||
(if
|
||||
(and
|
||||
(= (type-of arg) "keyword")
|
||||
@@ -178,7 +244,10 @@
|
||||
(assoc state "i" (inc (get state "i")))))))
|
||||
(dict "i" 0 "skip" false)
|
||||
args)
|
||||
(dom-set-attr marker "data-sx-island" (component-name island))
|
||||
(dom-set-attr
|
||||
marker
|
||||
"data-sx-island"
|
||||
(component-name island))
|
||||
(when
|
||||
(not (empty-dict? kw-state))
|
||||
(dom-set-attr
|
||||
@@ -224,15 +293,25 @@
|
||||
(when (not (spread? result)) (dom-append frag result))))
|
||||
expr)
|
||||
frag)))))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-dom-element
|
||||
:effects (render)
|
||||
(fn
|
||||
((tag :as string) (args :as list) (env :as dict) (ns :as string))
|
||||
(let
|
||||
((new-ns (cond (= tag "svg") SVG_NS (= tag "math") MATH_NS :else ns))
|
||||
(el (dom-create-element tag new-ns)))
|
||||
(el
|
||||
(if
|
||||
(hydrating?)
|
||||
(let
|
||||
((existing (hydrate-next-node)))
|
||||
(if
|
||||
(and
|
||||
existing
|
||||
(= (lower (or (host-get existing "tagName") "")) tag))
|
||||
(do (hydrate-enter-element existing) existing)
|
||||
(error (str "hydrate-mismatch:" tag))))
|
||||
(dom-create-element tag new-ns))))
|
||||
(scope-push! "element-attrs" nil)
|
||||
(reduce
|
||||
(fn
|
||||
@@ -296,7 +375,7 @@
|
||||
(fn () (render-to-dom arg env new-ns)))
|
||||
(spread? child)
|
||||
nil
|
||||
:else (dom-append el child))))
|
||||
:else (when (not (hydrating?)) (dom-append el child)))))
|
||||
(assoc state "i" (inc (get state "i"))))))))
|
||||
(dict "i" 0 "skip" false)
|
||||
args)
|
||||
@@ -334,13 +413,15 @@
|
||||
(keys spread-dict)))
|
||||
(scope-emitted "element-attrs"))
|
||||
(scope-pop! "element-attrs")
|
||||
el)))
|
||||
|
||||
(define
|
||||
(do (when (hydrating?) (hydrate-exit-element)) el))))
|
||||
(define
|
||||
render-dom-component
|
||||
:effects (render)
|
||||
(fn
|
||||
((comp :as component) (args :as list) (env :as dict) (ns :as string))
|
||||
((comp :as component)
|
||||
(args :as list)
|
||||
(env :as dict)
|
||||
(ns :as string))
|
||||
(let
|
||||
((kwargs (dict)) (children (list)))
|
||||
(reduce
|
||||
@@ -389,12 +470,16 @@
|
||||
children)
|
||||
(env-bind! local "children" child-frag)))
|
||||
(render-to-dom (component-body comp) local ns)))))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-dom-fragment
|
||||
:effects (render)
|
||||
(fn
|
||||
((args :as list) (env :as dict) (ns :as string))
|
||||
(if
|
||||
(hydrating?)
|
||||
(do
|
||||
(for-each (fn (x) (render-to-dom x env ns)) args)
|
||||
(create-fragment))
|
||||
(let
|
||||
((frag (create-fragment)))
|
||||
(for-each
|
||||
@@ -404,9 +489,8 @@
|
||||
((result (render-to-dom x env ns)))
|
||||
(when (not (spread? result)) (dom-append frag result))))
|
||||
args)
|
||||
frag)))
|
||||
|
||||
(define
|
||||
frag))))
|
||||
(define
|
||||
render-dom-raw
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -427,13 +511,11 @@
|
||||
(dom-append frag (create-text-node (str val))))))
|
||||
args)
|
||||
frag)))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-dom-unknown-component
|
||||
:effects (render)
|
||||
(fn ((name :as string)) (error (str "Unknown component: " name))))
|
||||
|
||||
(define
|
||||
(define
|
||||
RENDER_DOM_FORMS
|
||||
(list
|
||||
"if"
|
||||
@@ -459,13 +541,11 @@
|
||||
"scope"
|
||||
"provide"
|
||||
"cyst"))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-dom-form?
|
||||
:effects ()
|
||||
(fn ((name :as string)) (contains? RENDER_DOM_FORMS name)))
|
||||
|
||||
(define
|
||||
(define
|
||||
dispatch-render-form
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -495,6 +575,21 @@
|
||||
(list result)))
|
||||
(dom-insert-after marker result))
|
||||
(set! initial-result result)))))
|
||||
(if
|
||||
(hydrating?)
|
||||
(do
|
||||
(when
|
||||
(and
|
||||
initial-result
|
||||
(not (nil? initial-result))
|
||||
(not (spread? initial-result)))
|
||||
(let
|
||||
((parent (dom-parent initial-result)))
|
||||
(when
|
||||
parent
|
||||
(host-call parent "insertBefore" marker initial-result)
|
||||
(set! current-nodes (list initial-result)))))
|
||||
marker)
|
||||
(if
|
||||
(spread? initial-result)
|
||||
initial-result
|
||||
@@ -510,7 +605,7 @@
|
||||
(dom-child-nodes initial-result)
|
||||
(list initial-result)))
|
||||
(dom-append frag initial-result))
|
||||
frag)))
|
||||
frag))))
|
||||
(let
|
||||
((cond-val (trampoline (eval-expr (nth expr 1) env))))
|
||||
(if
|
||||
@@ -550,15 +645,41 @@
|
||||
(dom-insert-after marker frag))))
|
||||
(when
|
||||
(trampoline (eval-expr (nth expr 1) env))
|
||||
(if
|
||||
(hydrating?)
|
||||
(let
|
||||
((nodes (list)))
|
||||
(for-each
|
||||
(fn
|
||||
(i)
|
||||
(let
|
||||
((result (render-to-dom (nth expr i) env ns)))
|
||||
(append! nodes result)))
|
||||
(range 2 (len expr)))
|
||||
(set! current-nodes nodes)
|
||||
(set! initial-result (first nodes)))
|
||||
(let
|
||||
((frag (create-fragment)))
|
||||
(for-each
|
||||
(fn
|
||||
(i)
|
||||
(dom-append frag (render-to-dom (nth expr i) env ns)))
|
||||
(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))))))
|
||||
(set! initial-result frag)))))))
|
||||
(if
|
||||
(hydrating?)
|
||||
(do
|
||||
(when
|
||||
(and initial-result (not (nil? initial-result)))
|
||||
(let
|
||||
((parent (dom-parent initial-result)))
|
||||
(when
|
||||
parent
|
||||
(host-call parent "insertBefore" marker initial-result))))
|
||||
marker)
|
||||
(if
|
||||
(spread? initial-result)
|
||||
initial-result
|
||||
@@ -566,7 +687,7 @@
|
||||
((frag (create-fragment)))
|
||||
(dom-append frag marker)
|
||||
(when initial-result (dom-append frag initial-result))
|
||||
frag)))
|
||||
frag))))
|
||||
(if
|
||||
(not (trampoline (eval-expr (nth expr 1) env)))
|
||||
(create-fragment)
|
||||
@@ -617,6 +738,21 @@
|
||||
(dom-child-nodes result)
|
||||
(list result)))
|
||||
(set! initial-result result)))))))
|
||||
(if
|
||||
(hydrating?)
|
||||
(do
|
||||
(when
|
||||
(and
|
||||
initial-result
|
||||
(not (nil? initial-result))
|
||||
(not (spread? initial-result)))
|
||||
(let
|
||||
((parent (dom-parent initial-result)))
|
||||
(when
|
||||
parent
|
||||
(host-call parent "insertBefore" marker initial-result)
|
||||
(set! current-nodes (list initial-result)))))
|
||||
marker)
|
||||
(if
|
||||
(spread? initial-result)
|
||||
initial-result
|
||||
@@ -624,7 +760,7 @@
|
||||
((frag (create-fragment)))
|
||||
(dom-append frag marker)
|
||||
(when initial-result (dom-append frag initial-result))
|
||||
frag)))
|
||||
frag))))
|
||||
(let
|
||||
((branch (eval-cond (rest expr) env)))
|
||||
(if branch (render-to-dom branch env ns) (create-fragment))))
|
||||
@@ -670,7 +806,9 @@
|
||||
bindings)
|
||||
(when
|
||||
(> (len body) 1)
|
||||
(for-each (fn (e) (trampoline (eval-expr e local))) (init body)))
|
||||
(for-each
|
||||
(fn (e) (trampoline (eval-expr e local)))
|
||||
(init body)))
|
||||
(render-to-dom (last body) local ns))
|
||||
(or (= name "begin") (= name "do"))
|
||||
(if
|
||||
@@ -771,7 +909,9 @@
|
||||
(= (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!
|
||||
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)
|
||||
@@ -787,7 +927,9 @@
|
||||
(frag (create-fragment)))
|
||||
(scope-push! prov-name prov-val)
|
||||
(for-each
|
||||
(fn (i) (dom-append frag (render-to-dom (nth expr i) env ns)))
|
||||
(fn
|
||||
(i)
|
||||
(dom-append frag (render-to-dom (nth expr i) env ns)))
|
||||
(range 3 (len expr)))
|
||||
(scope-pop! prov-name)
|
||||
frag)
|
||||
@@ -817,8 +959,7 @@
|
||||
(dict-set! *memo-cache* cyst-key container)
|
||||
container))))
|
||||
:else (render-to-dom (trampoline (eval-expr expr env)) env ns))))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-lambda-dom
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -829,12 +970,14 @@
|
||||
(fn (i p) (env-bind! local p (nth args i)))
|
||||
(lambda-params f))
|
||||
(render-to-dom (lambda-body f) local ns))))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-dom-island
|
||||
:effects (render mutation)
|
||||
(fn
|
||||
((island :as island) (args :as list) (env :as dict) (ns :as string))
|
||||
((island :as island)
|
||||
(args :as list)
|
||||
(env :as dict)
|
||||
(ns :as string))
|
||||
(let
|
||||
((kwargs (dict)) (children (list)))
|
||||
(reduce
|
||||
@@ -878,20 +1021,23 @@
|
||||
children)
|
||||
(env-bind! local "children" child-frag)))
|
||||
(let
|
||||
((container (dom-create-element "span" nil)) (disposers (list)))
|
||||
((container (dom-create-element "span" nil))
|
||||
(disposers (list)))
|
||||
(begin
|
||||
(dom-set-attr container "data-sx-island" island-name)
|
||||
(when
|
||||
(not (empty-dict? kwargs))
|
||||
(dom-set-attr container "data-sx-state" (sx-serialize kwargs))))
|
||||
(dom-set-attr
|
||||
container
|
||||
"data-sx-state"
|
||||
(sx-serialize kwargs))))
|
||||
(mark-processed! container "island-hydrated")
|
||||
(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)
|
||||
(dom-set-data container "sx-disposers" disposers)
|
||||
container))))))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-dom-lake
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -927,14 +1073,17 @@
|
||||
(dict "i" 0 "skip" false)
|
||||
args)
|
||||
(let
|
||||
((el (dom-create-element lake-tag nil)))
|
||||
((el (if (hydrating?) (let ((existing (hydrate-next-node))) (if existing (do (hydrate-enter-element existing) existing) (dom-create-element lake-tag nil))) (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)))
|
||||
(fn
|
||||
(c)
|
||||
(let
|
||||
((result (render-to-dom c env ns)))
|
||||
(when (not (hydrating?)) (dom-append el result))))
|
||||
children)
|
||||
el))))
|
||||
|
||||
(define
|
||||
(do (when (hydrating?) (hydrate-exit-element)) el)))))
|
||||
(define
|
||||
render-dom-marsh
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -975,28 +1124,30 @@
|
||||
(dict "i" 0 "skip" false)
|
||||
args)
|
||||
(let
|
||||
((el (dom-create-element marsh-tag nil)))
|
||||
((el (if (hydrating?) (let ((existing (hydrate-next-node))) (if existing (do (hydrate-enter-element existing) existing) (dom-create-element marsh-tag nil))) (dom-create-element marsh-tag nil))))
|
||||
(dom-set-attr el "data-sx-marsh" (or marsh-id ""))
|
||||
(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)))
|
||||
(fn
|
||||
(c)
|
||||
(let
|
||||
((result (render-to-dom c env ns)))
|
||||
(when (not (hydrating?)) (dom-append el result))))
|
||||
children)
|
||||
el))))
|
||||
|
||||
(define
|
||||
(do (when (hydrating?) (hydrate-exit-element)) el)))))
|
||||
(define
|
||||
reactive-text
|
||||
:effects (render mutation)
|
||||
(fn
|
||||
(sig)
|
||||
(let
|
||||
((node (create-text-node (str (deref sig)))))
|
||||
((node (if (hydrating?) (or (hydrate-next-node) (create-text-node (str (deref sig)))) (create-text-node (str (deref sig))))))
|
||||
(effect (fn () (dom-set-text-content node (str (deref sig)))))
|
||||
node)))
|
||||
|
||||
(define
|
||||
(define
|
||||
reactive-attr
|
||||
:effects (render mutation)
|
||||
(fn
|
||||
@@ -1019,8 +1170,7 @@
|
||||
(= val true)
|
||||
(dom-set-attr el attr-name "")
|
||||
:else (dom-set-attr el attr-name (str val)))))))))
|
||||
|
||||
(define
|
||||
(define
|
||||
reactive-spread
|
||||
:effects (render mutation)
|
||||
(fn
|
||||
@@ -1044,7 +1194,9 @@
|
||||
(filter (fn (c) (not (= c ""))) (split current " ")))
|
||||
(kept
|
||||
(filter
|
||||
(fn (c) (not (some (fn (pc) (= pc c)) prev-classes)))
|
||||
(fn
|
||||
(c)
|
||||
(not (some (fn (pc) (= pc c)) prev-classes)))
|
||||
tokens)))
|
||||
(if
|
||||
(empty? kept)
|
||||
@@ -1059,7 +1211,9 @@
|
||||
((attrs (spread-attrs result))
|
||||
(cls-str (or (dict-get attrs "class") ""))
|
||||
(new-classes
|
||||
(filter (fn (c) (not (= c ""))) (split cls-str " ")))
|
||||
(filter
|
||||
(fn (c) (not (= c "")))
|
||||
(split cls-str " ")))
|
||||
(extra-keys
|
||||
(filter (fn (k) (not (= k "class"))) (keys attrs))))
|
||||
(set! prev-classes new-classes)
|
||||
@@ -1079,9 +1233,10 @@
|
||||
(fn (k) (dom-set-attr el k (str (dict-get attrs k))))
|
||||
extra-keys)
|
||||
(run-post-render-hooks))
|
||||
(do (set! prev-classes (list)) (set! prev-extra-keys (list))))))))))
|
||||
|
||||
(define
|
||||
(do
|
||||
(set! prev-classes (list))
|
||||
(set! prev-extra-keys (list))))))))))
|
||||
(define
|
||||
reactive-fragment
|
||||
:effects (render mutation)
|
||||
(fn
|
||||
@@ -1090,7 +1245,8 @@
|
||||
(env :as dict)
|
||||
(ns :as string))
|
||||
(let
|
||||
((marker (create-comment "island-fragment")) (current-nodes (list)))
|
||||
((marker (create-comment "island-fragment"))
|
||||
(current-nodes (list)))
|
||||
(effect
|
||||
(fn
|
||||
()
|
||||
@@ -1103,8 +1259,7 @@
|
||||
(set! current-nodes (dom-child-nodes frag))
|
||||
(dom-insert-after marker frag)))))
|
||||
marker)))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-list-item
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -1113,8 +1268,7 @@
|
||||
(lambda? map-fn)
|
||||
(render-lambda-dom map-fn (list item) env ns)
|
||||
(render-to-dom (apply map-fn (list item)) env ns))))
|
||||
|
||||
(define
|
||||
(define
|
||||
extract-key
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -1127,8 +1281,7 @@
|
||||
(let
|
||||
((dk (dom-get-data node "key")))
|
||||
(if dk (str dk) (str "__idx_" index)))))))
|
||||
|
||||
(define
|
||||
(define
|
||||
reactive-list
|
||||
:effects (render mutation)
|
||||
(fn
|
||||
@@ -1212,15 +1365,15 @@
|
||||
(dom-append container rendered)))
|
||||
items)))))
|
||||
container)))
|
||||
|
||||
(define
|
||||
(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"))))
|
||||
(is-checkbox
|
||||
(or (= input-type "checkbox") (= input-type "radio"))))
|
||||
(if
|
||||
is-checkbox
|
||||
(dom-set-prop el "checked" (deref sig))
|
||||
@@ -1245,25 +1398,21 @@
|
||||
is-checkbox
|
||||
(reset! sig (dom-get-prop el "checked"))
|
||||
(reset! sig (dom-get-prop el "value"))))))))
|
||||
|
||||
(define *use-cek-reactive* true)
|
||||
|
||||
(define enable-cek-reactive! (fn () (set! *use-cek-reactive* true)))
|
||||
|
||||
(define
|
||||
(define *use-cek-reactive* true)
|
||||
(define enable-cek-reactive! (fn () (set! *use-cek-reactive* true)))
|
||||
(define
|
||||
cek-reactive-text
|
||||
:effects (render mutation)
|
||||
(fn
|
||||
(expr env)
|
||||
(let
|
||||
((node (create-text-node ""))
|
||||
((node (if (hydrating?) (or (hydrate-next-node) (create-text-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))))
|
||||
|
||||
(define
|
||||
(define
|
||||
cek-reactive-attr
|
||||
:effects (render mutation)
|
||||
(fn
|
||||
@@ -1278,8 +1427,7 @@
|
||||
(let
|
||||
((initial (cek-run (make-cek-state expr env (list (make-reactive-reset-frame env update-fn true))))))
|
||||
(cek-call update-fn (list initial))))))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-dom-portal
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -1302,8 +1450,7 @@
|
||||
(register-in-scope
|
||||
(fn () (for-each (fn (n) (dom-remove n)) portal-nodes))))
|
||||
marker)))))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-dom-error-boundary
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -1342,10 +1489,7 @@
|
||||
(let
|
||||
((fallback-dom (if (nil? fallback-fn) (let ((el (dom-create-element "div" nil))) (dom-set-attr el "class" "sx-render-error") (dom-set-attr el "style" "color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:0.25rem;margin:0.5rem 0;") (dom-set-text-content el (str "Render error: " err)) el) (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)))
|
||||
|
||||
|
||||
))
|
||||
container)))))
|
||||
|
||||
;; Re-export to global env
|
||||
(import (web adapter-dom))
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -330,13 +330,29 @@
|
||||
(if (dict-has? kwargs p) (dict-get kwargs p) nil)))
|
||||
(component-params comp))
|
||||
(let
|
||||
((body-dom (cek-try (fn () (with-island-scope (fn (disposable) (append! disposers disposable)) (fn () (render-to-dom (component-body comp) local nil)))) (fn (err) (log-warn (str "hydrate-island FAILED: " comp-name " — " err)) (let ((error-el (dom-create-element "div" nil))) (dom-set-attr error-el "class" "sx-island-error") (dom-set-attr error-el "style" "padding:8px;margin:4px 0;border:1px solid #ef4444;border-radius:4px;background:#fef2f2;color:#b91c1c;font-family:monospace;font-size:12px;white-space:pre-wrap") (dom-set-text-content error-el (str "Island error: " comp-name "\n" err)) error-el)))))
|
||||
(host-call el "replaceChildren" body-dom)
|
||||
((cursor (dict "parent" el "index" 0)))
|
||||
(scope-push! "sx-hydrating" cursor)
|
||||
(cek-try
|
||||
(fn
|
||||
()
|
||||
(with-island-scope
|
||||
(fn (disposable) (append! disposers disposable))
|
||||
(fn () (render-to-dom (component-body comp) local nil))))
|
||||
(fn
|
||||
(err)
|
||||
(scope-pop! "sx-hydrating")
|
||||
(log-warn
|
||||
(str "hydrate fallback: " comp-name " — " err))
|
||||
(let
|
||||
((fallback (cek-try (fn () (with-island-scope (fn (d) (append! disposers d)) (fn () (render-to-dom (component-body comp) local nil)))) (fn (err2) (let ((e (dom-create-element "div" nil))) (dom-set-text-content e (str "Island error: " comp-name "\n" err2)) e)))))
|
||||
(host-call el "replaceChildren" fallback)
|
||||
nil)))
|
||||
(scope-pop! "sx-hydrating")
|
||||
(dom-set-data el "sx-disposers" disposers)
|
||||
(set-timeout (fn () (process-elements el)) 0)
|
||||
(log-info
|
||||
(str
|
||||
"hydrated island: "
|
||||
"hydrated island: ~"
|
||||
comp-name
|
||||
" ("
|
||||
(len disposers)
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -536,6 +536,7 @@
|
||||
"SVG_NS",
|
||||
"MATH_NS",
|
||||
"island-scope?",
|
||||
"hydrating?",
|
||||
"contains-deref?",
|
||||
"dom-on",
|
||||
"render-to-dom",
|
||||
|
||||
@@ -1,17 +1,70 @@
|
||||
(import (sx dom))
|
||||
(import (sx render))
|
||||
|
||||
(define-library (web adapter-dom)
|
||||
(export SVG_NS MATH_NS island-scope? contains-deref? dom-on render-to-dom render-dom-list render-dom-element render-dom-component render-dom-fragment render-dom-raw render-dom-unknown-component RENDER_DOM_FORMS render-dom-form? dispatch-render-form render-lambda-dom render-dom-island render-dom-lake render-dom-marsh reactive-text reactive-attr reactive-spread reactive-fragment render-list-item extract-key reactive-list bind-input *use-cek-reactive* enable-cek-reactive! cek-reactive-text cek-reactive-attr render-dom-portal render-dom-error-boundary)
|
||||
(define-library
|
||||
(web adapter-dom)
|
||||
(export
|
||||
SVG_NS
|
||||
MATH_NS
|
||||
island-scope?
|
||||
hydrating?
|
||||
contains-deref?
|
||||
dom-on
|
||||
render-to-dom
|
||||
render-dom-list
|
||||
render-dom-element
|
||||
render-dom-component
|
||||
render-dom-fragment
|
||||
render-dom-raw
|
||||
render-dom-unknown-component
|
||||
RENDER_DOM_FORMS
|
||||
render-dom-form?
|
||||
dispatch-render-form
|
||||
render-lambda-dom
|
||||
render-dom-island
|
||||
render-dom-lake
|
||||
render-dom-marsh
|
||||
reactive-text
|
||||
reactive-attr
|
||||
reactive-spread
|
||||
reactive-fragment
|
||||
render-list-item
|
||||
extract-key
|
||||
reactive-list
|
||||
bind-input
|
||||
*use-cek-reactive*
|
||||
enable-cek-reactive!
|
||||
cek-reactive-text
|
||||
cek-reactive-attr
|
||||
render-dom-portal
|
||||
render-dom-error-boundary)
|
||||
(begin
|
||||
(define SVG_NS "http://www.w3.org/2000/svg")
|
||||
(define MATH_NS "http://www.w3.org/1998/Math/MathML")
|
||||
(define
|
||||
island-scope?
|
||||
(fn () (not (nil? (scope-peek "sx-island-scope")))))
|
||||
(define hydrating? (fn () (not (nil? (scope-peek "sx-hydrating")))))
|
||||
(define
|
||||
hydrate-next-node
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((cursor (scope-peek "sx-hydrating")))
|
||||
(when
|
||||
cursor
|
||||
(let
|
||||
((parent (dict-get cursor "parent"))
|
||||
(idx (dict-get cursor "index")))
|
||||
(let
|
||||
((child (host-call (host-get parent "childNodes") "item" idx)))
|
||||
(dict-set! cursor "index" (+ idx 1))
|
||||
child))))))
|
||||
(define
|
||||
hydrate-enter-element
|
||||
(fn (el) (scope-push! "sx-hydrating" (dict "parent" el "index" 0))))
|
||||
(define hydrate-exit-element (fn () (scope-pop! "sx-hydrating")))
|
||||
(begin
|
||||
|
||||
(define SVG_NS "http://www.w3.org/2000/svg")
|
||||
|
||||
(define MATH_NS "http://www.w3.org/1998/Math/MathML")
|
||||
|
||||
(define island-scope? (fn () (not (nil? (scope-peek "sx-island-scope")))))
|
||||
|
||||
(begin
|
||||
(define *memo-cache* (dict))
|
||||
(define *cyst-counter* 0)
|
||||
(define
|
||||
@@ -20,8 +73,7 @@
|
||||
()
|
||||
(set! *cyst-counter* (+ *cyst-counter* 1))
|
||||
(str "sx-cyst-" *cyst-counter*))))
|
||||
|
||||
(define
|
||||
(define
|
||||
contains-deref?
|
||||
(fn
|
||||
(expr)
|
||||
@@ -37,8 +89,7 @@
|
||||
(= (symbol-name (first expr)) "deref"))
|
||||
true
|
||||
(some contains-deref? expr))))))
|
||||
|
||||
(define
|
||||
(define
|
||||
dom-on
|
||||
:effects (io)
|
||||
(fn
|
||||
@@ -59,8 +110,7 @@
|
||||
(trampoline (call-lambda handler (list e)))
|
||||
(run-post-render-hooks)))
|
||||
handler))))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-to-dom
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -75,13 +125,22 @@
|
||||
"raw-html"
|
||||
(dom-parse-html (raw-html-content expr))
|
||||
"string"
|
||||
(create-text-node expr)
|
||||
(if
|
||||
(hydrating?)
|
||||
(or (hydrate-next-node) (create-text-node expr))
|
||||
(create-text-node expr))
|
||||
"number"
|
||||
(create-text-node (str expr))
|
||||
(if
|
||||
(hydrating?)
|
||||
(or (hydrate-next-node) (create-text-node (str expr)))
|
||||
(create-text-node (str expr)))
|
||||
"symbol"
|
||||
(render-to-dom (trampoline (eval-expr expr env)) env ns)
|
||||
"keyword"
|
||||
(create-text-node (keyword-name expr))
|
||||
(if
|
||||
(hydrating?)
|
||||
(or (hydrate-next-node) (create-text-node (keyword-name expr)))
|
||||
(create-text-node (keyword-name expr)))
|
||||
"dom-node"
|
||||
expr
|
||||
"spread"
|
||||
@@ -101,8 +160,7 @@
|
||||
(reactive-text expr)
|
||||
(create-text-node (str (deref expr))))
|
||||
(create-text-node (str expr))))))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-dom-list
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -136,7 +194,10 @@
|
||||
(render-dom-element name args env ns)
|
||||
(dispatch-render-form name expr env ns))
|
||||
(and (env-has? env name) (macro? (env-get env name)))
|
||||
(render-to-dom (expand-macro (env-get env name) args env) env ns)
|
||||
(render-to-dom
|
||||
(expand-macro (env-get env name) args env)
|
||||
env
|
||||
ns)
|
||||
(contains? HTML_TAGS name)
|
||||
(render-dom-element name args env ns)
|
||||
(and
|
||||
@@ -156,7 +217,12 @@
|
||||
((skip (get state "skip")))
|
||||
(if
|
||||
skip
|
||||
(assoc state "skip" false "i" (inc (get state "i")))
|
||||
(assoc
|
||||
state
|
||||
"skip"
|
||||
false
|
||||
"i"
|
||||
(inc (get state "i")))
|
||||
(if
|
||||
(and
|
||||
(= (type-of arg) "keyword")
|
||||
@@ -178,7 +244,10 @@
|
||||
(assoc state "i" (inc (get state "i")))))))
|
||||
(dict "i" 0 "skip" false)
|
||||
args)
|
||||
(dom-set-attr marker "data-sx-island" (component-name island))
|
||||
(dom-set-attr
|
||||
marker
|
||||
"data-sx-island"
|
||||
(component-name island))
|
||||
(when
|
||||
(not (empty-dict? kw-state))
|
||||
(dom-set-attr
|
||||
@@ -224,15 +293,25 @@
|
||||
(when (not (spread? result)) (dom-append frag result))))
|
||||
expr)
|
||||
frag)))))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-dom-element
|
||||
:effects (render)
|
||||
(fn
|
||||
((tag :as string) (args :as list) (env :as dict) (ns :as string))
|
||||
(let
|
||||
((new-ns (cond (= tag "svg") SVG_NS (= tag "math") MATH_NS :else ns))
|
||||
(el (dom-create-element tag new-ns)))
|
||||
(el
|
||||
(if
|
||||
(hydrating?)
|
||||
(let
|
||||
((existing (hydrate-next-node)))
|
||||
(if
|
||||
(and
|
||||
existing
|
||||
(= (lower (or (host-get existing "tagName") "")) tag))
|
||||
(do (hydrate-enter-element existing) existing)
|
||||
(error (str "hydrate-mismatch:" tag))))
|
||||
(dom-create-element tag new-ns))))
|
||||
(scope-push! "element-attrs" nil)
|
||||
(reduce
|
||||
(fn
|
||||
@@ -296,7 +375,7 @@
|
||||
(fn () (render-to-dom arg env new-ns)))
|
||||
(spread? child)
|
||||
nil
|
||||
:else (dom-append el child))))
|
||||
:else (when (not (hydrating?)) (dom-append el child)))))
|
||||
(assoc state "i" (inc (get state "i"))))))))
|
||||
(dict "i" 0 "skip" false)
|
||||
args)
|
||||
@@ -334,13 +413,15 @@
|
||||
(keys spread-dict)))
|
||||
(scope-emitted "element-attrs"))
|
||||
(scope-pop! "element-attrs")
|
||||
el)))
|
||||
|
||||
(define
|
||||
(do (when (hydrating?) (hydrate-exit-element)) el))))
|
||||
(define
|
||||
render-dom-component
|
||||
:effects (render)
|
||||
(fn
|
||||
((comp :as component) (args :as list) (env :as dict) (ns :as string))
|
||||
((comp :as component)
|
||||
(args :as list)
|
||||
(env :as dict)
|
||||
(ns :as string))
|
||||
(let
|
||||
((kwargs (dict)) (children (list)))
|
||||
(reduce
|
||||
@@ -389,12 +470,16 @@
|
||||
children)
|
||||
(env-bind! local "children" child-frag)))
|
||||
(render-to-dom (component-body comp) local ns)))))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-dom-fragment
|
||||
:effects (render)
|
||||
(fn
|
||||
((args :as list) (env :as dict) (ns :as string))
|
||||
(if
|
||||
(hydrating?)
|
||||
(do
|
||||
(for-each (fn (x) (render-to-dom x env ns)) args)
|
||||
(create-fragment))
|
||||
(let
|
||||
((frag (create-fragment)))
|
||||
(for-each
|
||||
@@ -404,9 +489,8 @@
|
||||
((result (render-to-dom x env ns)))
|
||||
(when (not (spread? result)) (dom-append frag result))))
|
||||
args)
|
||||
frag)))
|
||||
|
||||
(define
|
||||
frag))))
|
||||
(define
|
||||
render-dom-raw
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -427,13 +511,11 @@
|
||||
(dom-append frag (create-text-node (str val))))))
|
||||
args)
|
||||
frag)))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-dom-unknown-component
|
||||
:effects (render)
|
||||
(fn ((name :as string)) (error (str "Unknown component: " name))))
|
||||
|
||||
(define
|
||||
(define
|
||||
RENDER_DOM_FORMS
|
||||
(list
|
||||
"if"
|
||||
@@ -459,13 +541,11 @@
|
||||
"scope"
|
||||
"provide"
|
||||
"cyst"))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-dom-form?
|
||||
:effects ()
|
||||
(fn ((name :as string)) (contains? RENDER_DOM_FORMS name)))
|
||||
|
||||
(define
|
||||
(define
|
||||
dispatch-render-form
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -495,6 +575,21 @@
|
||||
(list result)))
|
||||
(dom-insert-after marker result))
|
||||
(set! initial-result result)))))
|
||||
(if
|
||||
(hydrating?)
|
||||
(do
|
||||
(when
|
||||
(and
|
||||
initial-result
|
||||
(not (nil? initial-result))
|
||||
(not (spread? initial-result)))
|
||||
(let
|
||||
((parent (dom-parent initial-result)))
|
||||
(when
|
||||
parent
|
||||
(host-call parent "insertBefore" marker initial-result)
|
||||
(set! current-nodes (list initial-result)))))
|
||||
marker)
|
||||
(if
|
||||
(spread? initial-result)
|
||||
initial-result
|
||||
@@ -510,7 +605,7 @@
|
||||
(dom-child-nodes initial-result)
|
||||
(list initial-result)))
|
||||
(dom-append frag initial-result))
|
||||
frag)))
|
||||
frag))))
|
||||
(let
|
||||
((cond-val (trampoline (eval-expr (nth expr 1) env))))
|
||||
(if
|
||||
@@ -550,15 +645,41 @@
|
||||
(dom-insert-after marker frag))))
|
||||
(when
|
||||
(trampoline (eval-expr (nth expr 1) env))
|
||||
(if
|
||||
(hydrating?)
|
||||
(let
|
||||
((nodes (list)))
|
||||
(for-each
|
||||
(fn
|
||||
(i)
|
||||
(let
|
||||
((result (render-to-dom (nth expr i) env ns)))
|
||||
(append! nodes result)))
|
||||
(range 2 (len expr)))
|
||||
(set! current-nodes nodes)
|
||||
(set! initial-result (first nodes)))
|
||||
(let
|
||||
((frag (create-fragment)))
|
||||
(for-each
|
||||
(fn
|
||||
(i)
|
||||
(dom-append frag (render-to-dom (nth expr i) env ns)))
|
||||
(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))))))
|
||||
(set! initial-result frag)))))))
|
||||
(if
|
||||
(hydrating?)
|
||||
(do
|
||||
(when
|
||||
(and initial-result (not (nil? initial-result)))
|
||||
(let
|
||||
((parent (dom-parent initial-result)))
|
||||
(when
|
||||
parent
|
||||
(host-call parent "insertBefore" marker initial-result))))
|
||||
marker)
|
||||
(if
|
||||
(spread? initial-result)
|
||||
initial-result
|
||||
@@ -566,7 +687,7 @@
|
||||
((frag (create-fragment)))
|
||||
(dom-append frag marker)
|
||||
(when initial-result (dom-append frag initial-result))
|
||||
frag)))
|
||||
frag))))
|
||||
(if
|
||||
(not (trampoline (eval-expr (nth expr 1) env)))
|
||||
(create-fragment)
|
||||
@@ -617,6 +738,21 @@
|
||||
(dom-child-nodes result)
|
||||
(list result)))
|
||||
(set! initial-result result)))))))
|
||||
(if
|
||||
(hydrating?)
|
||||
(do
|
||||
(when
|
||||
(and
|
||||
initial-result
|
||||
(not (nil? initial-result))
|
||||
(not (spread? initial-result)))
|
||||
(let
|
||||
((parent (dom-parent initial-result)))
|
||||
(when
|
||||
parent
|
||||
(host-call parent "insertBefore" marker initial-result)
|
||||
(set! current-nodes (list initial-result)))))
|
||||
marker)
|
||||
(if
|
||||
(spread? initial-result)
|
||||
initial-result
|
||||
@@ -624,7 +760,7 @@
|
||||
((frag (create-fragment)))
|
||||
(dom-append frag marker)
|
||||
(when initial-result (dom-append frag initial-result))
|
||||
frag)))
|
||||
frag))))
|
||||
(let
|
||||
((branch (eval-cond (rest expr) env)))
|
||||
(if branch (render-to-dom branch env ns) (create-fragment))))
|
||||
@@ -670,7 +806,9 @@
|
||||
bindings)
|
||||
(when
|
||||
(> (len body) 1)
|
||||
(for-each (fn (e) (trampoline (eval-expr e local))) (init body)))
|
||||
(for-each
|
||||
(fn (e) (trampoline (eval-expr e local)))
|
||||
(init body)))
|
||||
(render-to-dom (last body) local ns))
|
||||
(or (= name "begin") (= name "do"))
|
||||
(if
|
||||
@@ -771,7 +909,9 @@
|
||||
(= (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!
|
||||
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)
|
||||
@@ -787,7 +927,9 @@
|
||||
(frag (create-fragment)))
|
||||
(scope-push! prov-name prov-val)
|
||||
(for-each
|
||||
(fn (i) (dom-append frag (render-to-dom (nth expr i) env ns)))
|
||||
(fn
|
||||
(i)
|
||||
(dom-append frag (render-to-dom (nth expr i) env ns)))
|
||||
(range 3 (len expr)))
|
||||
(scope-pop! prov-name)
|
||||
frag)
|
||||
@@ -817,8 +959,7 @@
|
||||
(dict-set! *memo-cache* cyst-key container)
|
||||
container))))
|
||||
:else (render-to-dom (trampoline (eval-expr expr env)) env ns))))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-lambda-dom
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -829,12 +970,14 @@
|
||||
(fn (i p) (env-bind! local p (nth args i)))
|
||||
(lambda-params f))
|
||||
(render-to-dom (lambda-body f) local ns))))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-dom-island
|
||||
:effects (render mutation)
|
||||
(fn
|
||||
((island :as island) (args :as list) (env :as dict) (ns :as string))
|
||||
((island :as island)
|
||||
(args :as list)
|
||||
(env :as dict)
|
||||
(ns :as string))
|
||||
(let
|
||||
((kwargs (dict)) (children (list)))
|
||||
(reduce
|
||||
@@ -878,20 +1021,23 @@
|
||||
children)
|
||||
(env-bind! local "children" child-frag)))
|
||||
(let
|
||||
((container (dom-create-element "span" nil)) (disposers (list)))
|
||||
((container (dom-create-element "span" nil))
|
||||
(disposers (list)))
|
||||
(begin
|
||||
(dom-set-attr container "data-sx-island" island-name)
|
||||
(when
|
||||
(not (empty-dict? kwargs))
|
||||
(dom-set-attr container "data-sx-state" (sx-serialize kwargs))))
|
||||
(dom-set-attr
|
||||
container
|
||||
"data-sx-state"
|
||||
(sx-serialize kwargs))))
|
||||
(mark-processed! container "island-hydrated")
|
||||
(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)
|
||||
(dom-set-data container "sx-disposers" disposers)
|
||||
container))))))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-dom-lake
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -927,14 +1073,17 @@
|
||||
(dict "i" 0 "skip" false)
|
||||
args)
|
||||
(let
|
||||
((el (dom-create-element lake-tag nil)))
|
||||
((el (if (hydrating?) (let ((existing (hydrate-next-node))) (if existing (do (hydrate-enter-element existing) existing) (dom-create-element lake-tag nil))) (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)))
|
||||
(fn
|
||||
(c)
|
||||
(let
|
||||
((result (render-to-dom c env ns)))
|
||||
(when (not (hydrating?)) (dom-append el result))))
|
||||
children)
|
||||
el))))
|
||||
|
||||
(define
|
||||
(do (when (hydrating?) (hydrate-exit-element)) el)))))
|
||||
(define
|
||||
render-dom-marsh
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -975,28 +1124,30 @@
|
||||
(dict "i" 0 "skip" false)
|
||||
args)
|
||||
(let
|
||||
((el (dom-create-element marsh-tag nil)))
|
||||
((el (if (hydrating?) (let ((existing (hydrate-next-node))) (if existing (do (hydrate-enter-element existing) existing) (dom-create-element marsh-tag nil))) (dom-create-element marsh-tag nil))))
|
||||
(dom-set-attr el "data-sx-marsh" (or marsh-id ""))
|
||||
(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)))
|
||||
(fn
|
||||
(c)
|
||||
(let
|
||||
((result (render-to-dom c env ns)))
|
||||
(when (not (hydrating?)) (dom-append el result))))
|
||||
children)
|
||||
el))))
|
||||
|
||||
(define
|
||||
(do (when (hydrating?) (hydrate-exit-element)) el)))))
|
||||
(define
|
||||
reactive-text
|
||||
:effects (render mutation)
|
||||
(fn
|
||||
(sig)
|
||||
(let
|
||||
((node (create-text-node (str (deref sig)))))
|
||||
((node (if (hydrating?) (or (hydrate-next-node) (create-text-node (str (deref sig)))) (create-text-node (str (deref sig))))))
|
||||
(effect (fn () (dom-set-text-content node (str (deref sig)))))
|
||||
node)))
|
||||
|
||||
(define
|
||||
(define
|
||||
reactive-attr
|
||||
:effects (render mutation)
|
||||
(fn
|
||||
@@ -1019,8 +1170,7 @@
|
||||
(= val true)
|
||||
(dom-set-attr el attr-name "")
|
||||
:else (dom-set-attr el attr-name (str val)))))))))
|
||||
|
||||
(define
|
||||
(define
|
||||
reactive-spread
|
||||
:effects (render mutation)
|
||||
(fn
|
||||
@@ -1044,7 +1194,9 @@
|
||||
(filter (fn (c) (not (= c ""))) (split current " ")))
|
||||
(kept
|
||||
(filter
|
||||
(fn (c) (not (some (fn (pc) (= pc c)) prev-classes)))
|
||||
(fn
|
||||
(c)
|
||||
(not (some (fn (pc) (= pc c)) prev-classes)))
|
||||
tokens)))
|
||||
(if
|
||||
(empty? kept)
|
||||
@@ -1059,7 +1211,9 @@
|
||||
((attrs (spread-attrs result))
|
||||
(cls-str (or (dict-get attrs "class") ""))
|
||||
(new-classes
|
||||
(filter (fn (c) (not (= c ""))) (split cls-str " ")))
|
||||
(filter
|
||||
(fn (c) (not (= c "")))
|
||||
(split cls-str " ")))
|
||||
(extra-keys
|
||||
(filter (fn (k) (not (= k "class"))) (keys attrs))))
|
||||
(set! prev-classes new-classes)
|
||||
@@ -1079,9 +1233,10 @@
|
||||
(fn (k) (dom-set-attr el k (str (dict-get attrs k))))
|
||||
extra-keys)
|
||||
(run-post-render-hooks))
|
||||
(do (set! prev-classes (list)) (set! prev-extra-keys (list))))))))))
|
||||
|
||||
(define
|
||||
(do
|
||||
(set! prev-classes (list))
|
||||
(set! prev-extra-keys (list))))))))))
|
||||
(define
|
||||
reactive-fragment
|
||||
:effects (render mutation)
|
||||
(fn
|
||||
@@ -1090,7 +1245,8 @@
|
||||
(env :as dict)
|
||||
(ns :as string))
|
||||
(let
|
||||
((marker (create-comment "island-fragment")) (current-nodes (list)))
|
||||
((marker (create-comment "island-fragment"))
|
||||
(current-nodes (list)))
|
||||
(effect
|
||||
(fn
|
||||
()
|
||||
@@ -1103,8 +1259,7 @@
|
||||
(set! current-nodes (dom-child-nodes frag))
|
||||
(dom-insert-after marker frag)))))
|
||||
marker)))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-list-item
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -1113,8 +1268,7 @@
|
||||
(lambda? map-fn)
|
||||
(render-lambda-dom map-fn (list item) env ns)
|
||||
(render-to-dom (apply map-fn (list item)) env ns))))
|
||||
|
||||
(define
|
||||
(define
|
||||
extract-key
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -1127,8 +1281,7 @@
|
||||
(let
|
||||
((dk (dom-get-data node "key")))
|
||||
(if dk (str dk) (str "__idx_" index)))))))
|
||||
|
||||
(define
|
||||
(define
|
||||
reactive-list
|
||||
:effects (render mutation)
|
||||
(fn
|
||||
@@ -1212,15 +1365,15 @@
|
||||
(dom-append container rendered)))
|
||||
items)))))
|
||||
container)))
|
||||
|
||||
(define
|
||||
(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"))))
|
||||
(is-checkbox
|
||||
(or (= input-type "checkbox") (= input-type "radio"))))
|
||||
(if
|
||||
is-checkbox
|
||||
(dom-set-prop el "checked" (deref sig))
|
||||
@@ -1245,25 +1398,21 @@
|
||||
is-checkbox
|
||||
(reset! sig (dom-get-prop el "checked"))
|
||||
(reset! sig (dom-get-prop el "value"))))))))
|
||||
|
||||
(define *use-cek-reactive* true)
|
||||
|
||||
(define enable-cek-reactive! (fn () (set! *use-cek-reactive* true)))
|
||||
|
||||
(define
|
||||
(define *use-cek-reactive* true)
|
||||
(define enable-cek-reactive! (fn () (set! *use-cek-reactive* true)))
|
||||
(define
|
||||
cek-reactive-text
|
||||
:effects (render mutation)
|
||||
(fn
|
||||
(expr env)
|
||||
(let
|
||||
((node (create-text-node ""))
|
||||
((node (if (hydrating?) (or (hydrate-next-node) (create-text-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))))
|
||||
|
||||
(define
|
||||
(define
|
||||
cek-reactive-attr
|
||||
:effects (render mutation)
|
||||
(fn
|
||||
@@ -1278,8 +1427,7 @@
|
||||
(let
|
||||
((initial (cek-run (make-cek-state expr env (list (make-reactive-reset-frame env update-fn true))))))
|
||||
(cek-call update-fn (list initial))))))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-dom-portal
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -1302,8 +1450,7 @@
|
||||
(register-in-scope
|
||||
(fn () (for-each (fn (n) (dom-remove n)) portal-nodes))))
|
||||
marker)))))
|
||||
|
||||
(define
|
||||
(define
|
||||
render-dom-error-boundary
|
||||
:effects (render)
|
||||
(fn
|
||||
@@ -1342,10 +1489,7 @@
|
||||
(let
|
||||
((fallback-dom (if (nil? fallback-fn) (let ((el (dom-create-element "div" nil))) (dom-set-attr el "class" "sx-render-error") (dom-set-attr el "style" "color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:0.25rem;margin:0.5rem 0;") (dom-set-text-content el (str "Render error: " err)) el) (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)))
|
||||
|
||||
|
||||
))
|
||||
container)))))
|
||||
|
||||
;; Re-export to global env
|
||||
(import (web adapter-dom))
|
||||
|
||||
22
web/boot.sx
22
web/boot.sx
@@ -330,13 +330,29 @@
|
||||
(if (dict-has? kwargs p) (dict-get kwargs p) nil)))
|
||||
(component-params comp))
|
||||
(let
|
||||
((body-dom (cek-try (fn () (with-island-scope (fn (disposable) (append! disposers disposable)) (fn () (render-to-dom (component-body comp) local nil)))) (fn (err) (log-warn (str "hydrate-island FAILED: " comp-name " — " err)) (let ((error-el (dom-create-element "div" nil))) (dom-set-attr error-el "class" "sx-island-error") (dom-set-attr error-el "style" "padding:8px;margin:4px 0;border:1px solid #ef4444;border-radius:4px;background:#fef2f2;color:#b91c1c;font-family:monospace;font-size:12px;white-space:pre-wrap") (dom-set-text-content error-el (str "Island error: " comp-name "\n" err)) error-el)))))
|
||||
(host-call el "replaceChildren" body-dom)
|
||||
((cursor (dict "parent" el "index" 0)))
|
||||
(scope-push! "sx-hydrating" cursor)
|
||||
(cek-try
|
||||
(fn
|
||||
()
|
||||
(with-island-scope
|
||||
(fn (disposable) (append! disposers disposable))
|
||||
(fn () (render-to-dom (component-body comp) local nil))))
|
||||
(fn
|
||||
(err)
|
||||
(scope-pop! "sx-hydrating")
|
||||
(log-warn
|
||||
(str "hydrate fallback: " comp-name " — " err))
|
||||
(let
|
||||
((fallback (cek-try (fn () (with-island-scope (fn (d) (append! disposers d)) (fn () (render-to-dom (component-body comp) local nil)))) (fn (err2) (let ((e (dom-create-element "div" nil))) (dom-set-text-content e (str "Island error: " comp-name "\n" err2)) e)))))
|
||||
(host-call el "replaceChildren" fallback)
|
||||
nil)))
|
||||
(scope-pop! "sx-hydrating")
|
||||
(dom-set-data el "sx-disposers" disposers)
|
||||
(set-timeout (fn () (process-elements el)) 0)
|
||||
(log-info
|
||||
(str
|
||||
"hydrated island: "
|
||||
"hydrated island: ~"
|
||||
comp-name
|
||||
" ("
|
||||
(len disposers)
|
||||
|
||||
Reference in New Issue
Block a user