giles
4b733e71b0
Added contains-deref? predicate to adapter-dom.sx. When rendering a text expression that contains (deref ...) inside an island scope, the adapter now wraps it in (reactive-text (computed (fn () (eval-expr expr env)))). This tracks signal dependencies through arbitrary expressions like (str (deref celsius) "°C") and (+ (* (deref celsius) 1.8) 32). Previously only bare (deref sig) was reactive. Now compound expressions like string interpolation and arithmetic over signals update in real time. The temperature converter preview in sx-tools is fully reactive: clicking +5/-5 updates both °C and °F displays live. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
66 lines
26 KiB
Plaintext
66 lines
26 KiB
Plaintext
(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 contains-deref? (fn (expr) (if (not (list? expr)) false (if (empty? expr) false (if (and (= (type-of (first expr)) "symbol") (= (symbol-name (first expr)) "deref")) true (some contains-deref? expr))))))
|
|
|
|
(define dom-on :effects (io) (fn (el name handler) (dom-listen el name (if (lambda? handler) (if (= 0 (len (lambda-params handler))) (fn (_e) (trampoline (call-lambda handler (list))) (run-post-render-hooks)) (fn (e) (trampoline (call-lambda handler (list e))) (run-post-render-hooks))) handler))))
|
|
|
|
(define render-to-dom :effects (render) (fn (expr (env :as dict) (ns :as string)) (set-render-active! true) (case (type-of expr) "nil" (create-fragment) "boolean" (create-fragment) "raw-html" (dom-parse-html (raw-html-content expr)) "string" (create-text-node expr) "number" (create-text-node (str expr)) "symbol" (render-to-dom (trampoline (eval-expr expr env)) env ns) "keyword" (create-text-node (keyword-name expr)) "dom-node" expr "spread" (do (when (not (island-scope?)) (scope-emit! "element-attrs" (spread-attrs expr))) expr) "dict" (if (has-key? expr "__host_handle") expr (create-fragment)) "list" (if (empty? expr) (create-fragment) (render-dom-list expr env ns)) :else (if (signal? expr) (if (island-scope?) (reactive-text expr) (create-text-node (str (deref expr)))) (create-text-node (str expr))))))
|
|
|
|
(define render-dom-list :effects (render) (fn (expr (env :as dict) (ns :as string)) (let ((head (first expr))) (cond (= (type-of head) "symbol") (let ((name (symbol-name head)) (args (rest expr))) (cond (= name "raw!") (render-dom-raw args env) (= name "<>") (render-dom-fragment args env ns) (= name "lake") (render-dom-lake args env ns) (= name "marsh") (render-dom-marsh args env ns) (starts-with? name "html:") (render-dom-element (slice name 5) args env ns) (render-dom-form? name) (if (and (contains? HTML_TAGS name) (or (and (> (len args) 0) (= (type-of (first args)) "keyword")) ns)) (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) (contains? HTML_TAGS name) (render-dom-element name args env ns) (and (starts-with? name "~") (env-has? env name) (island? (env-get env name))) (if (scope-peek "sx-render-markers") (let ((island (env-get env name)) (marker (dom-create-element "span" nil))) (dom-set-attr marker "data-sx-island" (component-name island)) marker) (render-dom-island (env-get env name) args env ns)) (starts-with? name "~") (let ((comp (env-get env name))) (if (component? comp) (render-dom-component comp args env ns) (render-dom-unknown-component name))) (and (> (index-of name "-") 0) (> (len args) 0) (= (type-of (first args)) "keyword")) (render-dom-element name args env ns) ns (render-dom-element name args env ns) (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))))) (and (island-scope?) (contains-deref? expr)) (reactive-text (computed (fn () (trampoline (eval-expr expr env))))) :else (render-to-dom (trampoline (eval-expr expr env)) env ns))) (or (lambda? head) (= (type-of head) "list")) (render-to-dom (trampoline (eval-expr expr env)) env ns) :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)))))
|
|
|
|
(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))) (scope-push! "element-attrs" nil) (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 ((attr-name (keyword-name arg)) (attr-expr (nth args (inc (get state "i"))))) (cond (starts-with? attr-name "on-") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (when (callable? attr-val) (dom-on el (slice attr-name 3) attr-val))) (= attr-name "bind") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (when (signal? attr-val) (bind-input el attr-val))) (= attr-name "ref") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (dict-set! attr-val "current" el)) (= attr-name "key") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (dom-set-attr el "key" (str attr-val))) (island-scope?) (reactive-attr el attr-name (fn () (trampoline (eval-expr attr-expr env)))) :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")))) (do (when (not (contains? VOID_ELEMENTS tag)) (let ((child (render-to-dom arg env new-ns))) (cond (and (spread? child) (island-scope?)) (reactive-spread el (fn () (render-to-dom arg env new-ns))) (spread? child) nil :else (dom-append el child)))) (assoc state "i" (inc (get state "i")))))))) (dict "i" 0 "skip" false) args) (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))) (scope-emitted "element-attrs")) (scope-pop! "element-attrs") el)))
|
|
|
|
(define render-dom-component :effects (render) (fn ((comp :as component) (args :as list) (env :as dict) (ns :as string)) (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) (let ((local (env-merge (component-closure comp) env))) (for-each (fn (p) (env-bind! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil))) (component-params comp)) (when (component-has-children? comp) (let ((child-frag (create-fragment))) (for-each (fn (c) (let ((result (render-to-dom c env ns))) (when (not (spread? result)) (dom-append child-frag result)))) children) (env-bind! local "children" child-frag))) (render-to-dom (component-body comp) local ns)))))
|
|
|
|
(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)))
|
|
|
|
(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)))
|
|
|
|
(define render-dom-unknown-component :effects (render) (fn ((name :as string)) (error (str "Unknown component: " name))))
|
|
|
|
(define RENDER_DOM_FORMS (list "if" "when" "cond" "case" "let" "let*" "letrec" "begin" "do" "define" "defcomp" "defisland" "defmacro" "defstyle" "map" "map-indexed" "filter" "for-each" "portal" "error-boundary" "scope" "provide"))
|
|
|
|
(define render-dom-form? :effects () (fn ((name :as string)) (contains? RENDER_DOM_FORMS name)))
|
|
|
|
(define dispatch-render-form :effects (render) (fn ((name :as string) expr (env :as dict) (ns :as string)) (cond (= name "if") (if (island-scope?) (let ((marker (create-comment "r-if")) (current-nodes (list)) (initial-result nil)) (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) (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)) (set! initial-result result))))) (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))) (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))))) (= name "when") (if (island-scope?) (let ((marker (create-comment "r-when")) (current-nodes (list)) (initial-result nil)) (effect (fn () (if (dom-parent marker) (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)))) (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)))))) (if (spread? initial-result) initial-result (let ((frag (create-fragment))) (dom-append frag marker) (when initial-result (dom-append frag initial-result)) frag))) (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))) (= name "cond") (if (island-scope?) (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) (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)))) (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))))))) (if (spread? initial-result) initial-result (let ((frag (create-fragment))) (dom-append frag marker) (when initial-result (dom-append frag initial-result)) frag))) (let ((branch (eval-cond (rest expr) env))) (if branch (render-to-dom branch env ns) (create-fragment)))) (= name "case") (render-to-dom (trampoline (eval-expr expr env)) env ns) (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))) (= name "letrec") (let ((bindings (nth expr 1)) (body (slice expr 2)) (local (env-extend env))) (for-each (fn (pair) (let ((pname (if (= (type-of (first pair)) "symbol") (symbol-name (first pair)) (str (first pair))))) (env-bind! local pname nil))) bindings) (for-each (fn (pair) (let ((pname (if (= (type-of (first pair)) "symbol") (symbol-name (first pair)) (str (first pair))))) (env-set! local pname (trampoline (eval-expr (nth pair 1) local))))) bindings) (when (> (len body) 1) (for-each (fn (e) (trampoline (eval-expr e local))) (init body))) (render-to-dom (last body) local ns)) (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-form? name) (do (trampoline (eval-expr expr env)) (create-fragment)) (= name "map") (let ((coll-expr (nth expr 2))) (if (and (island-scope?) (= (type-of coll-expr) "list") (> (len coll-expr) 1) (= (type-of (first coll-expr)) "symbol") (= (symbol-name (first coll-expr)) "deref")) (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) (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))) (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))) (= 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) (= name "filter") (render-to-dom (trampoline (eval-expr expr env)) env ns) (= name "portal") (render-dom-portal (rest expr) env ns) (= name "error-boundary") (render-dom-error-boundary (rest expr) env ns) (= 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) (= 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))) (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) (= 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) :else (render-to-dom (trampoline (eval-expr expr env)) env ns))))
|
|
|
|
(define render-lambda-dom :effects (render) (fn ((f :as lambda) (args :as list) (env :as dict) (ns :as string)) (let ((local (env-merge (lambda-closure f) env))) (for-each-indexed (fn (i p) (env-bind! local p (nth args i))) (lambda-params f)) (render-to-dom (lambda-body f) local ns))))
|
|
|
|
(define render-dom-island :effects (render mutation) (fn ((island :as island) (args :as list) (env :as dict) (ns :as string)) (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) (let ((local (env-merge (component-closure island) env)) (island-name (component-name island))) (for-each (fn (p) (env-bind! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil))) (component-params island)) (when (component-has-children? island) (let ((child-frag (create-fragment))) (for-each (fn (c) (dom-append child-frag (render-to-dom c env ns))) children) (env-bind! local "children" child-frag))) (let ((container (dom-create-element "span" nil)) (disposers (list))) (dom-set-attr container "data-sx-island" island-name) (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 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))))
|
|
|
|
(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 "")) (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))))
|
|
|
|
(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)))
|
|
|
|
(define reactive-attr :effects (render mutation) (fn (el (attr-name :as string) (compute-fn :as lambda)) (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))) (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)))))))))
|
|
|
|
(define reactive-spread :effects (render mutation) (fn (el (render-fn :as lambda)) (let ((prev-classes (list)) (prev-extra-keys (list))) (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 () (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))))) (for-each (fn (k) (dom-remove-attr el k)) prev-extra-keys) (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) (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)))) (for-each (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 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 () (for-each (fn (n) (dom-remove n)) current-nodes) (set! current-nodes (list)) (when (test-fn) (let ((frag (render-fn))) (set! current-nodes (dom-child-nodes frag)) (dom-insert-after marker frag))))) marker)))
|
|
|
|
(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)) (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) (let ((new-map (dict)) (new-keys (list)) (has-keys false)) (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)) (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) (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))) (do (for-each (fn (old-key) (when (not (dict-has? new-map old-key)) (dom-remove (dict-get key-map old-key)))) 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)))) (set! key-map new-map) (set! key-order new-keys)) (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)))
|
|
|
|
(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")))) (if is-checkbox (dom-set-prop el "checked" (deref sig)) (dom-set-prop el "value" (str (deref sig)))) (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)))))) (dom-on el (if is-checkbox "change" "input") (fn (e) (if is-checkbox (reset! sig (dom-get-prop el "checked")) (reset! sig (dom-get-prop el "value"))))))))
|
|
|
|
(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 "")) (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 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)))))) (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)) (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 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))) (for-each (fn (child) (dom-append frag (render-to-dom child env ns))) (rest args)) (let ((portal-nodes (dom-child-nodes frag))) (dom-append target frag) (register-in-scope (fn () (for-each (fn (n) (dom-remove n)) portal-nodes)))) marker)))))
|
|
|
|
(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 (signal 0))) (dom-set-attr container "data-sx-boundary" "true") (effect (fn () (deref retry-version) (dom-set-prop container "innerHTML" "") (scope-push! "sx-island-scope" nil) (try-catch (fn () (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) (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)))
|