giles
07bbcaf1bb
Core runtime fixes: - Safe equality (=, !=): physical equality for dicts/lambdas/signals, structural only for acyclic types. Prevents infinite loops on circular signal subscriber chains. - contains?: same safe comparison (physical first, structural for simple types) - Thunk trampolining in as_number and to_string: leaked thunks auto-resolve instead of showing <thunk> or erroring "Expected number, got thunk" - Diagnostic first error: shows actual type received Island hydration fixes: - adapter-dom.sx: skip scope-emit for spreads inside islands (was tripling classes) - schedule-idle: wrap callback to absorb requestIdleCallback deadline arg - home-stepper: remove spread-specific highlighting (all tokens same style per step) Platform functions (boot-helpers.sx): - fetch-request: 3-arg interface (config, success-fn, error-fn) with promise chain - build-request-body: form serialization for GET/POST - strip-component-scripts / extract-response-css: SX text processing - Navigation: bind-boost-link, bind-client-route-click via execute-request - Loading state: show-indicator, disable-elements, clear-loading-state - DOM extras: dom-remove, dom-attr-list (name/value pairs), dom-child-list (SX list), dom-is-active-element?, dom-is-input-element?, dom-is-child-of?, dom-on, dom-parse-html-document, dom-body-inner-html, create-script-clone - All remaining stubs: csrf-token, loaded-component-names, observe-intersection, event-source-connect/listen, with-transition, cross-origin?, etc. Navigation pipeline: - browser-push-state/replace-state: accept 1-arg (URL only) or 3-arg - boot.sx: wire popstate listener to handle-popstate - URL updates working via handle-history + pushState fix Morph debugging (WIP): - dom-child-list returns proper SX list (was JS Array) - dom-query accepts optional root element for scoped queries - Navigation fetches and renders SX responses, URL updates, but morph doesn't replace content div (investigating dom-child-list on new elements) Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
697 lines
25 KiB
Plaintext
697 lines
25 KiB
Plaintext
;; boot-helpers.sx — Platform helpers for boot/orchestration/engine
|
|
;;
|
|
;; These were JS-native functions in the transpiled bundle. Now pure SX
|
|
;; built on the 8 FFI host primitives + dom.sx/browser.sx.
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Processing markers — track which DOM elements have been bound/hydrated
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define _sx-bound-prefix "_sxBound")
|
|
|
|
(define mark-processed!
|
|
(fn (el key)
|
|
(host-set! el (str _sx-bound-prefix key) true)))
|
|
|
|
(define is-processed?
|
|
(fn (el key)
|
|
(let ((v (host-get el (str _sx-bound-prefix key))))
|
|
(if v true false))))
|
|
|
|
(define clear-processed!
|
|
(fn (el key)
|
|
(host-set! el (str _sx-bound-prefix key) nil)))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Callable check
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define callable?
|
|
(fn (v)
|
|
(let ((t (type-of v)))
|
|
(or (= t "lambda") (= t "native-fn") (= t "continuation")))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; String helpers
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define to-kebab
|
|
(fn (s)
|
|
"Convert camelCase to kebab-case."
|
|
(let ((result (list))
|
|
(i 0))
|
|
(let loop ((i 0))
|
|
(when (< i (len s))
|
|
(let ((ch (nth s i)))
|
|
(if (and (>= ch "A") (<= ch "Z"))
|
|
(do
|
|
(when (> i 0) (append! result "-"))
|
|
(append! result (lower ch)))
|
|
(append! result ch))
|
|
(loop (+ i 1)))))
|
|
(join "" result))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Component / rendering helpers
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define sx-load-components
|
|
(fn (text)
|
|
"Parse and evaluate component definitions from text."
|
|
(when (and text (> (len text) 0))
|
|
(let ((exprs (sx-parse text)))
|
|
(for-each (fn (expr) (cek-eval expr)) exprs)))))
|
|
|
|
(define call-expr
|
|
(fn (expr-text &rest env-bindings)
|
|
"Parse and evaluate an SX expression string."
|
|
(let ((exprs (sx-parse expr-text)))
|
|
(when (not (empty? exprs))
|
|
(cek-eval (first exprs))))))
|
|
|
|
(define base-env
|
|
(fn ()
|
|
"Return the current global environment."
|
|
(global-env)))
|
|
|
|
(define get-render-env
|
|
(fn (&rest extra)
|
|
"Get the rendering environment (global env, optionally merged with extra)."
|
|
(let ((env (global-env)))
|
|
(if (and extra (not (nil? (first extra))) (not (empty? extra)))
|
|
(env-merge env (first extra))
|
|
env))))
|
|
|
|
(define merge-envs
|
|
(fn (a b)
|
|
"Merge two environments."
|
|
(if (and a b)
|
|
(env-merge a b)
|
|
(or a b (global-env)))))
|
|
|
|
(define sx-render-with-env
|
|
(fn (source extra-env)
|
|
"Parse SX source and render to DOM fragment."
|
|
(let ((doc (host-global "document"))
|
|
(frag (host-call doc "createDocumentFragment"))
|
|
(exprs (sx-parse source)))
|
|
(for-each (fn (expr)
|
|
(let ((html (render-to-html expr)))
|
|
(when (and html (> (len html) 0))
|
|
(let ((temp (host-call doc "createElement" "template")))
|
|
(host-set! temp "innerHTML" html)
|
|
(host-call frag "appendChild" (host-get temp "content"))))))
|
|
exprs)
|
|
frag)))
|
|
|
|
(define parse-env-attr
|
|
(fn (el)
|
|
"Parse data-sx-env attribute (JSON key-value pairs)."
|
|
nil))
|
|
|
|
(define store-env-attr
|
|
(fn (el base new-env)
|
|
nil))
|
|
|
|
(define resolve-mount-target
|
|
(fn (target)
|
|
"Resolve a CSS selector string to a DOM element."
|
|
(if (string? target)
|
|
(dom-query target)
|
|
target)))
|
|
|
|
(define remove-head-element
|
|
(fn (sel)
|
|
"Remove a <head> element matching selector."
|
|
(let ((el (dom-query sel)))
|
|
(when el
|
|
(dom-remove el)))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Cookie helpers for component caching
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define set-sx-comp-cookie
|
|
(fn (hash)
|
|
(set-cookie "sx-components" hash)))
|
|
|
|
(define clear-sx-comp-cookie
|
|
(fn ()
|
|
(set-cookie "sx-components" "")))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Logging
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define log-parse-error
|
|
(fn (label text err)
|
|
(log-error (str "Parse error in " label ": " err))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Validation stub (orchestration.sx needs this)
|
|
;; --------------------------------------------------------------------------
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Loaded component tracking
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; Returns names of components/islands loaded client-side.
|
|
;; build-request-headers uses a DOM hash instead of this list,
|
|
;; and deps-satisfied? falls back to server fetch when empty.
|
|
|
|
(define loaded-component-names
|
|
(fn ()
|
|
;; Scan data-components script tags for loaded component names
|
|
(let ((scripts (dom-query-all (dom-body) "script[data-components]"))
|
|
(names (list)))
|
|
(for-each (fn (script)
|
|
(let ((text (or (dom-get-attr script "data-components") "")))
|
|
(when (> (len text) 0)
|
|
(for-each (fn (name)
|
|
(when (> (len (trim name)) 0)
|
|
(append! names (trim name))))
|
|
(split text ",")))))
|
|
scripts)
|
|
names)))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; CSRF token
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define csrf-token
|
|
(fn ()
|
|
(let ((meta (dom-query "meta[name=\"csrf-token\"]")))
|
|
(if meta (dom-get-attr meta "content") nil))))
|
|
|
|
(define validate-for-request
|
|
(fn (el) true))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Request body builder
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; For GET/HEAD: no body. If element is a form, serialize inputs as query params.
|
|
;; For POST/PUT/etc: if element is a form, build FormData body.
|
|
;; Returns dict with "url", "body", "content-type".
|
|
|
|
(define build-request-body
|
|
(fn (el method url)
|
|
(let ((m (upper method)))
|
|
(if (or (= m "GET") (= m "HEAD"))
|
|
;; GET/HEAD — serialize form inputs into URL query params
|
|
(if (and el (= (upper (or (dom-tag-name el) "")) "FORM"))
|
|
(let ((fd (host-new "FormData" el))
|
|
(params (host-new "URLSearchParams" fd))
|
|
(qs (host-call params "toString")))
|
|
(dict "url" (if (and qs (> (len qs) 0))
|
|
(str url (if (contains? url "?") "&" "?") qs)
|
|
url)
|
|
"body" nil
|
|
"content-type" nil))
|
|
(dict "url" url "body" nil "content-type" nil))
|
|
;; POST/PUT/etc — build form body if element is a form
|
|
(if (and el (= (upper (or (dom-tag-name el) "")) "FORM"))
|
|
(let ((enctype (or (dom-get-attr el "enctype") "application/x-www-form-urlencoded")))
|
|
(if (= enctype "multipart/form-data")
|
|
;; Multipart: let browser set Content-Type with boundary
|
|
(let ((fd (host-new "FormData" el)))
|
|
(dict "url" url "body" fd "content-type" nil))
|
|
;; URL-encoded
|
|
(let ((fd (host-new "FormData" el))
|
|
(params (host-new "URLSearchParams" fd)))
|
|
(dict "url" url
|
|
"body" (host-call params "toString")
|
|
"content-type" "application/x-www-form-urlencoded"))))
|
|
;; Not a form — no body
|
|
(dict "url" url "body" nil "content-type" nil))))))
|
|
|
|
(define abort-previous-target (fn (el) nil))
|
|
(define abort-previous (fn (el) nil))
|
|
(define track-controller (fn (el ctrl) nil))
|
|
(define track-controller-target (fn (el ctrl) nil))
|
|
(define new-abort-controller (fn () (host-new "AbortController")))
|
|
(define abort-signal (fn (ctrl) (host-get ctrl "signal")))
|
|
(define apply-optimistic (fn (el) nil))
|
|
(define revert-optimistic (fn (el) nil))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; DOM query helpers (used by boot.sx)
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define dom-has-attr?
|
|
(fn (el name)
|
|
(host-call el "hasAttribute" name)))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Loading state (indicators, disabling)
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define show-indicator
|
|
(fn (el)
|
|
;; Show loading indicator. Returns indicator state for cleanup.
|
|
(let ((indicator-sel (dom-get-attr el "sx-indicator")))
|
|
(when indicator-sel
|
|
(let ((indicator (dom-query indicator-sel)))
|
|
(when indicator
|
|
(dom-remove-class indicator "hidden")
|
|
(dom-add-class indicator "sx-indicator-visible"))))
|
|
indicator-sel)))
|
|
|
|
(define disable-elements
|
|
(fn (el)
|
|
;; Disable elements during request. Returns list of disabled elements.
|
|
(let ((disable-sel (dom-get-attr el "sx-disabled-elt")))
|
|
(if disable-sel
|
|
(let ((elts (dom-query-all (dom-body) disable-sel)))
|
|
(for-each (fn (e) (dom-set-attr e "disabled" "")) elts)
|
|
elts)
|
|
(list)))))
|
|
|
|
(define clear-loading-state
|
|
(fn (el indicator disabled-elts)
|
|
;; Reverse loading state: hide indicator, re-enable elements
|
|
(dom-remove-class el "sx-request")
|
|
(dom-remove-attr el "aria-busy")
|
|
(when indicator
|
|
(let ((ind (dom-query indicator)))
|
|
(when ind
|
|
(dom-add-class ind "hidden")
|
|
(dom-remove-class ind "sx-indicator-visible"))))
|
|
(when disabled-elts
|
|
(for-each (fn (e) (dom-remove-attr e "disabled")) disabled-elts))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Abort / error helpers
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define abort-error?
|
|
(fn (err)
|
|
(= (host-get err "name") "AbortError")))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Promise helpers
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define promise-catch
|
|
(fn (p f)
|
|
(let ((cb (host-callback f)))
|
|
(host-call p "catch" cb))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Fetch helpers
|
|
;; --------------------------------------------------------------------------
|
|
|
|
;; Override browser.sx's raw fetch-request with the higher-level interface
|
|
;; that orchestration expects: (fetch-request config success-fn error-fn)
|
|
;; config: dict with url, method, headers, body, signal, cross-origin, preloaded
|
|
;; success-fn: (fn (resp-ok status get-header text) ...)
|
|
;; error-fn: (fn (err) ...)
|
|
(define fetch-request
|
|
(fn (config success-fn error-fn)
|
|
(let ((url (get config "url"))
|
|
(method (or (get config "method") "GET"))
|
|
(headers (or (get config "headers") (dict)))
|
|
(body (get config "body"))
|
|
(signal (get config "signal"))
|
|
(preloaded (get config "preloaded")))
|
|
;; If preloaded content is available, use it directly
|
|
(if preloaded
|
|
(success-fn true 200 (fn (name) nil) preloaded)
|
|
;; Build fetch options as plain JS object
|
|
(let ((h (host-new "Headers"))
|
|
(js-opts (host-new "Object")))
|
|
(for-each (fn (k)
|
|
(host-call h "set" k (get headers k)))
|
|
(keys headers))
|
|
(host-set! js-opts "method" method)
|
|
(host-set! js-opts "headers" h)
|
|
(when body (host-set! js-opts "body" body))
|
|
(when signal (host-set! js-opts "signal" signal))
|
|
;; Execute fetch
|
|
(promise-then
|
|
(host-call (dom-window) "fetch" url js-opts)
|
|
(fn (response)
|
|
(let ((ok (host-get response "ok"))
|
|
(status (host-get response "status"))
|
|
(get-header (fn (name) (host-call (host-get response "headers") "get" name))))
|
|
(promise-then
|
|
(host-call response "text")
|
|
(fn (text) (success-fn ok status get-header text))
|
|
error-fn)))
|
|
error-fn))))))
|
|
|
|
(define fetch-location
|
|
(fn (url)
|
|
;; Navigate to URL via fetch + swap into boost target
|
|
(let ((target (or (dom-query "[sx-boost]") (dom-query "#main-panel"))))
|
|
(when target
|
|
(browser-navigate url)))))
|
|
|
|
(define fetch-and-restore
|
|
(fn (main url headers scroll-y)
|
|
;; Popstate: fetch URL, swap into main, restore scroll
|
|
(fetch-request
|
|
(dict "url" url "method" "GET" "headers" headers "body" nil "signal" nil)
|
|
(fn (resp-ok status get-header text)
|
|
(when resp-ok
|
|
(dom-set-inner-html main text)
|
|
(post-swap main)
|
|
(host-call (dom-window) "scrollTo" 0 scroll-y)))
|
|
(fn (err) (log-warn (str "fetch-and-restore error: " err))))))
|
|
|
|
(define fetch-preload
|
|
(fn (url headers cache)
|
|
;; Preload URL into cache dict
|
|
(fetch-request
|
|
(dict "url" url "method" "GET" "headers" headers "body" nil "signal" nil)
|
|
(fn (resp-ok status get-header text)
|
|
(when resp-ok
|
|
(preload-cache-set cache url text)))
|
|
(fn (err) nil))))
|
|
|
|
(define fetch-streaming
|
|
(fn (target pathname headers swap-fn)
|
|
;; Streaming fetch — fallback to non-streaming
|
|
(fetch-and-restore target pathname headers 0)))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; DOM extras
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define dom-parse-html-document
|
|
(fn (text)
|
|
(let ((parser (host-new "DOMParser")))
|
|
(host-call parser "parseFromString" text "text/html"))))
|
|
|
|
(define dom-body-inner-html
|
|
(fn (doc)
|
|
(host-get (host-get doc "body") "innerHTML")))
|
|
|
|
(define create-script-clone
|
|
(fn (dead)
|
|
(let ((doc (host-global "document"))
|
|
(live (host-call doc "createElement" "script")))
|
|
;; Copy attributes
|
|
(let ((attrs (host-get dead "attributes")))
|
|
(let loop ((i 0))
|
|
(when (< i (host-get attrs "length"))
|
|
(let ((attr (host-call attrs "item" i)))
|
|
(host-call live "setAttribute"
|
|
(host-get attr "name") (host-get attr "value"))
|
|
(loop (+ i 1))))))
|
|
;; Copy content
|
|
(host-set! live "textContent" (host-get dead "textContent"))
|
|
live)))
|
|
|
|
(define cross-origin?
|
|
(fn (url)
|
|
(if (or (starts-with? url "http://") (starts-with? url "https://"))
|
|
(not (starts-with? url (browser-location-origin)))
|
|
false)))
|
|
|
|
(define browser-scroll-to
|
|
(fn (x y)
|
|
(host-call (dom-window) "scrollTo" x y)))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; View transitions
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define with-transition
|
|
(fn (enabled thunk)
|
|
(if (and enabled (host-get (host-global "document") "startViewTransition"))
|
|
(host-call (host-global "document") "startViewTransition"
|
|
(host-callback thunk))
|
|
(thunk))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; IntersectionObserver
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define observe-intersection
|
|
(fn (el callback once? delay)
|
|
(let ((cb (host-callback
|
|
(fn (entries)
|
|
(for-each (fn (entry)
|
|
(when (host-get entry "isIntersecting")
|
|
(if delay
|
|
(set-timeout (fn () (callback entry)) delay)
|
|
(callback entry))
|
|
(when once?
|
|
(host-call observer "unobserve" el))))
|
|
(host-call entries "forEach" (host-callback (fn (e) e))))))))
|
|
;; Direct approach: create observer that calls back for each entry
|
|
(let ((observer (host-new "IntersectionObserver"
|
|
(host-callback (fn (entries)
|
|
(let ((arr-len (host-get entries "length")))
|
|
(let loop ((i 0))
|
|
(when (< i arr-len)
|
|
(let ((entry (host-call entries "item" i)))
|
|
(when (and entry (host-get entry "isIntersecting"))
|
|
(if delay
|
|
(set-timeout (fn () (callback entry)) delay)
|
|
(callback entry))
|
|
(when once?
|
|
(host-call observer "unobserve" el))))
|
|
(loop (+ i 1))))))))))
|
|
(host-call observer "observe" el)
|
|
observer))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; EventSource (SSE)
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define event-source-connect
|
|
(fn (url el)
|
|
(let ((source (host-new "EventSource" url)))
|
|
(host-set! source "_sxElement" el)
|
|
source)))
|
|
|
|
(define event-source-listen
|
|
(fn (source event-name handler)
|
|
(host-call source "addEventListener" event-name
|
|
(host-callback (fn (e) (handler e))))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Boost bindings
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define bind-boost-link
|
|
(fn (el href)
|
|
(dom-listen el "click"
|
|
(fn (e)
|
|
(when (not (event-modifier-key? e))
|
|
(prevent-default e)
|
|
;; Set verb attrs so execute-request can process this as a GET
|
|
(when (not (dom-has-attr? el "sx-get"))
|
|
(dom-set-attr el "sx-get" href))
|
|
(when (not (dom-has-attr? el "sx-push-url"))
|
|
(dom-set-attr el "sx-push-url" "true"))
|
|
(execute-request el nil nil))))))
|
|
|
|
(define bind-boost-form
|
|
(fn (form method action)
|
|
(dom-listen form "submit"
|
|
(fn (e)
|
|
(prevent-default e)
|
|
(execute-request form nil nil)))))
|
|
|
|
(define bind-client-route-click
|
|
(fn (link href fallback-fn)
|
|
(dom-listen link "click"
|
|
(fn (e)
|
|
(when (not (event-modifier-key? e))
|
|
(prevent-default e)
|
|
;; Try client routing first, fall back to server fetch
|
|
(let ((boost-el (dom-query "[sx-boost]"))
|
|
(target-sel (if boost-el
|
|
(let ((attr (dom-get-attr boost-el "sx-boost")))
|
|
(if (and attr (not (= attr "true"))) attr "#main-panel"))
|
|
"#main-panel")))
|
|
(if (try-client-route (url-pathname href) target-sel)
|
|
(do
|
|
(browser-push-state nil "" href)
|
|
(browser-scroll-to 0 0))
|
|
;; Fallback: server fetch via execute-request
|
|
(do
|
|
(when (not (dom-has-attr? link "sx-get"))
|
|
(dom-set-attr link "sx-get" href))
|
|
(when (not (dom-has-attr? link "sx-push-url"))
|
|
(dom-set-attr link "sx-push-url" "true"))
|
|
(execute-request link nil nil)))))))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Service worker
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define sw-post-message (fn (msg) nil))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Response processing (fetch/swap pipeline)
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define try-parse-json
|
|
(fn (text)
|
|
(json-parse text)))
|
|
|
|
(define strip-component-scripts
|
|
(fn (text)
|
|
;; Remove <script data-components>...</script> from response text.
|
|
;; The text may be SX (not valid HTML), so use string matching.
|
|
;; First, load the component definitions into the environment.
|
|
(let ((result text)
|
|
(start-tag "<script type=\"text/sx\" data-components>")
|
|
(end-tag "</script>"))
|
|
;; Find and extract component scripts
|
|
(let loop ((s result))
|
|
(let ((start-idx (index-of s start-tag)))
|
|
(if (= start-idx -1)
|
|
(set! result s)
|
|
(let ((after-start (+ start-idx (len start-tag)))
|
|
(rest-str (slice s (+ start-idx (len start-tag)))))
|
|
(let ((end-offset (index-of rest-str end-tag)))
|
|
(if (= end-offset -1)
|
|
(set! result s)
|
|
(let ((comp-text (slice rest-str 0 end-offset))
|
|
(before (slice s 0 start-idx))
|
|
(after (slice rest-str (+ end-offset (len end-tag)))))
|
|
;; Load component definitions
|
|
(sx-load-components comp-text)
|
|
(loop (str before after)))))))))
|
|
result)))
|
|
|
|
(define extract-response-css
|
|
(fn (text)
|
|
;; Extract <style data-sx-css>...</style> tags from response text.
|
|
;; Apply them to the document head, return remaining text.
|
|
(let ((result text)
|
|
(start-tag "<style data-sx-css>")
|
|
(end-tag "</style>"))
|
|
(let loop ((s result))
|
|
(let ((start-idx (index-of s start-tag)))
|
|
(if (= start-idx -1)
|
|
(set! result s)
|
|
(let ((rest-str (slice s (+ start-idx (len start-tag)))))
|
|
(let ((end-offset (index-of rest-str end-tag)))
|
|
(if (= end-offset -1)
|
|
(set! result s)
|
|
(let ((css-text (slice rest-str 0 end-offset))
|
|
(before (slice s 0 start-idx))
|
|
(after (slice rest-str (+ end-offset (len end-tag)))))
|
|
;; Apply CSS to head
|
|
(let ((doc (host-global "document"))
|
|
(style-el (host-call doc "createElement" "style")))
|
|
(host-set! style-el "textContent" css-text)
|
|
(dom-append-to-head style-el))
|
|
(loop (str before after)))))))))
|
|
result)))
|
|
|
|
(define sx-render
|
|
(fn (text)
|
|
;; Parse SX text and render to a DOM fragment.
|
|
(let ((doc (host-global "document"))
|
|
(frag (host-call doc "createDocumentFragment"))
|
|
(exprs (sx-parse text)))
|
|
(for-each (fn (expr)
|
|
(let ((result (render-to-dom expr (get-render-env nil) nil)))
|
|
(when result (dom-append frag result))))
|
|
exprs)
|
|
frag)))
|
|
|
|
(define sx-hydrate
|
|
(fn (root)
|
|
;; Hydrate data-sx elements in root (or document).
|
|
(sx-hydrate-elements (or root (dom-body)))))
|
|
|
|
(define sx-process-scripts
|
|
(fn (root)
|
|
;; Find and evaluate <script type="text/sx"> in root.
|
|
(let ((scripts (dom-query-all (or root (dom-body)) "script[type=\"text/sx\"]")))
|
|
(for-each (fn (s)
|
|
(when (not (is-processed? s "sx-script"))
|
|
(mark-processed! s "sx-script")
|
|
(let ((text (host-get s "textContent")))
|
|
(when (and text (> (len text) 0))
|
|
(let ((exprs (sx-parse text)))
|
|
(for-each (fn (expr) (cek-eval expr)) exprs))))))
|
|
scripts))))
|
|
|
|
(define select-from-container
|
|
(fn (container selector)
|
|
;; Select matching element from container, return it (not just children).
|
|
(if selector
|
|
(let ((selected (dom-query container selector)))
|
|
(if selected
|
|
selected
|
|
(children-to-fragment container)))
|
|
(children-to-fragment container))))
|
|
|
|
(define children-to-fragment
|
|
(fn (el)
|
|
;; Move all children of el into a DocumentFragment.
|
|
(let ((doc (host-global "document"))
|
|
(frag (host-call doc "createDocumentFragment")))
|
|
(let loop ()
|
|
(let ((child (dom-first-child el)))
|
|
(when child
|
|
(dom-append frag child)
|
|
(loop))))
|
|
frag)))
|
|
|
|
(define select-html-from-doc
|
|
(fn (doc selector)
|
|
;; Extract HTML from a parsed document, optionally selecting.
|
|
(if selector
|
|
(let ((el (dom-query doc selector)))
|
|
(if el (dom-inner-html el) (dom-body-inner-html doc)))
|
|
(dom-body-inner-html doc))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Client routing stubs
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define find-matching-route
|
|
(fn (pathname routes)
|
|
;; Match pathname against registered page routes.
|
|
;; Returns match dict or nil.
|
|
nil))
|
|
|
|
(define parse-route-pattern (fn (pattern) nil))
|
|
|
|
(define register-io-deps (fn (deps) nil))
|
|
|
|
(define resolve-page-data
|
|
(fn (page-name params &rest rest)
|
|
nil))
|
|
|
|
(define parse-sx-data
|
|
(fn (text)
|
|
(if (and text (> (len text) 0))
|
|
(let ((exprs (sx-parse text)))
|
|
(if (not (empty? exprs)) (first exprs) nil))
|
|
nil)))
|
|
|
|
(define try-eval-content
|
|
(fn (content-src env)
|
|
;; Evaluate SX content source to DOM.
|
|
(let ((exprs (sx-parse content-src)))
|
|
(if (empty? exprs)
|
|
nil
|
|
(let ((frag (create-fragment)))
|
|
(for-each (fn (expr)
|
|
(let ((result (render-to-dom expr env nil)))
|
|
(when result (dom-append frag result))))
|
|
exprs)
|
|
frag)))))
|
|
|
|
(define try-async-eval-content
|
|
(fn (content-src env &rest rest)
|
|
;; Async variant — for now, delegate to sync.
|
|
(try-eval-content content-src env)))
|
|
|
|
(define try-rerender-page (fn (&rest args) nil))
|
|
(define execute-action (fn (&rest args) nil))
|
|
(define bind-preload (fn (&rest args) nil))
|
|
(define persist-offline-data (fn (&rest args) nil))
|
|
(define retrieve-offline-data (fn (&rest args) nil))
|