giles
cea009084f
Two fixes for sx-browser.js (spec-compiled) vs sx.js (hand-written): 1. CSS meta tag mismatch: initCssTracking read meta[name="sx-css-hash"] but the page template uses meta[name="sx-css-classes"]. This left _cssHash empty, causing the server to send ALL CSS as "new" on every navigation, appending duplicate rules that broke Tailwind responsive ordering (e.g. menu bar layout). 2. Stale verb info after morph: execute-request used captured verbInfo from bind time. After morph updated element attributes (e.g. during OOB nav swap), click handlers still fired with old URLs. Now re-reads verb info from the element first, matching sx.js behavior. Also includes: render-expression dispatch in eval.sx, NIL guard for preload cache in bootstrap_js.py, and helpers.py switched to sx-browser.js. Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
817 lines
31 KiB
Plaintext
817 lines
31 KiB
Plaintext
;; ==========================================================================
|
|
;; orchestration.sx — Engine orchestration (browser wiring)
|
|
;;
|
|
;; Binds the pure engine logic to actual browser events, fetch, DOM
|
|
;; processing, and lifecycle management. This is the runtime that makes
|
|
;; the engine go.
|
|
;;
|
|
;; Dependency is one-way: orchestration → engine, never reverse.
|
|
;;
|
|
;; Depends on:
|
|
;; engine.sx — parse-trigger-spec, get-verb-info, build-request-headers,
|
|
;; process-response-headers, parse-swap-spec, parse-retry-spec,
|
|
;; next-retry-ms, resolve-target, apply-optimistic,
|
|
;; revert-optimistic, find-oob-swaps, swap-dom-nodes,
|
|
;; swap-html-string, morph-children, handle-history,
|
|
;; preload-cache-get, preload-cache-set, classify-trigger,
|
|
;; should-boost-link?, should-boost-form?, parse-sse-swap,
|
|
;; default-trigger, filter-params, PRELOAD_TTL
|
|
;; adapter-dom.sx — render-to-dom
|
|
;; render.sx — shared registries
|
|
;; ==========================================================================
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Engine state
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define _preload-cache (dict))
|
|
(define _css-hash "")
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Event dispatch helpers
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define dispatch-trigger-events
|
|
(fn (el header-val)
|
|
;; Dispatch events from SX-Trigger / SX-Trigger-After-Swap headers.
|
|
;; Value can be JSON object (name → detail) or comma-separated names.
|
|
(when header-val
|
|
(let ((parsed (try-parse-json header-val)))
|
|
(if parsed
|
|
;; JSON object: keys are event names, values are detail
|
|
(for-each
|
|
(fn (key)
|
|
(dom-dispatch el key (get parsed key)))
|
|
(keys parsed))
|
|
;; Comma-separated event names
|
|
(for-each
|
|
(fn (name)
|
|
(let ((trimmed (trim name)))
|
|
(when (not (empty? trimmed))
|
|
(dom-dispatch el trimmed (dict)))))
|
|
(split header-val ",")))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; CSS tracking
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define init-css-tracking
|
|
(fn ()
|
|
;; Read initial CSS hash from meta tag
|
|
(let ((meta (dom-query "meta[name=\"sx-css-classes\"]")))
|
|
(when meta
|
|
(let ((content (dom-get-attr meta "content")))
|
|
(when content
|
|
(set! _css-hash content)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Request execution
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define execute-request
|
|
(fn (el verbInfo extraParams)
|
|
;; Gate checks then delegate to do-fetch.
|
|
;; verbInfo: dict with "method" and "url" (or nil to read from element).
|
|
;; Re-read from element in case attributes were morphed since binding.
|
|
;; Returns a promise.
|
|
(let ((info (or (get-verb-info el) verbInfo)))
|
|
(if (nil? info)
|
|
(promise-resolve nil)
|
|
(let ((verb (get info "method"))
|
|
(url (get info "url")))
|
|
;; Media query gate
|
|
(if (let ((media (dom-get-attr el "sx-media")))
|
|
(and media (not (browser-media-matches? media))))
|
|
(promise-resolve nil)
|
|
;; Confirm gate
|
|
(if (let ((confirm-msg (dom-get-attr el "sx-confirm")))
|
|
(and confirm-msg (not (browser-confirm confirm-msg))))
|
|
(promise-resolve nil)
|
|
;; Prompt
|
|
(let ((prompt-msg (dom-get-attr el "sx-prompt"))
|
|
(prompt-val (if prompt-msg (browser-prompt prompt-msg) nil)))
|
|
(if (and prompt-msg (nil? prompt-val))
|
|
(promise-resolve nil)
|
|
;; Validation gate
|
|
(if (not (validate-for-request el))
|
|
(promise-resolve nil)
|
|
(do-fetch el verb verb url
|
|
(if prompt-val
|
|
(assoc (or extraParams (dict)) "SX-Prompt" prompt-val)
|
|
extraParams))))))))))))
|
|
|
|
|
|
(define do-fetch
|
|
(fn (el verb method url extraParams)
|
|
;; Execute the actual fetch. Manages abort, headers, body, loading state.
|
|
(let ((sync (dom-get-attr el "sx-sync")))
|
|
;; Abort previous if sync mode
|
|
(when (= sync "replace")
|
|
(abort-previous el))
|
|
|
|
(let ((ctrl (new-abort-controller)))
|
|
(track-controller el ctrl)
|
|
|
|
;; Build request
|
|
(let ((body-info (build-request-body el method url))
|
|
(final-url (get body-info "url"))
|
|
(body (get body-info "body"))
|
|
(ct (get body-info "content-type"))
|
|
(headers (build-request-headers el
|
|
(loaded-component-names) _css-hash))
|
|
(csrf (csrf-token)))
|
|
|
|
;; Merge extra params as headers
|
|
(when extraParams
|
|
(for-each
|
|
(fn (k) (dict-set! headers k (get extraParams k)))
|
|
(keys extraParams)))
|
|
|
|
;; Content-Type
|
|
(when ct
|
|
(dict-set! headers "Content-Type" ct))
|
|
|
|
;; CSRF
|
|
(when csrf
|
|
(dict-set! headers "X-CSRFToken" csrf))
|
|
|
|
;; Preload cache check
|
|
(let ((cached (preload-cache-get _preload-cache final-url))
|
|
(optimistic-state (apply-optimistic el))
|
|
(indicator (show-indicator el))
|
|
(disabled-elts (disable-elements el)))
|
|
|
|
;; Loading indicators
|
|
(dom-add-class el "sx-request")
|
|
(dom-set-attr el "aria-busy" "true")
|
|
(dom-dispatch el "sx:beforeRequest" (dict "url" final-url "method" method))
|
|
|
|
;; Fetch
|
|
(fetch-request
|
|
(dict "url" final-url
|
|
"method" method
|
|
"headers" headers
|
|
"body" body
|
|
"signal" (controller-signal ctrl)
|
|
"cross-origin" (cross-origin? final-url)
|
|
"preloaded" cached)
|
|
;; Success callback
|
|
(fn (resp-ok status get-header text)
|
|
(do
|
|
(clear-loading-state el indicator disabled-elts)
|
|
(revert-optimistic optimistic-state)
|
|
(if (not resp-ok)
|
|
(do
|
|
(dom-dispatch el "sx:responseError"
|
|
(dict "status" status "text" text))
|
|
(handle-retry el verb method final-url extraParams))
|
|
(do
|
|
(dom-dispatch el "sx:afterRequest"
|
|
(dict "status" status))
|
|
(handle-fetch-success el final-url verb extraParams
|
|
get-header text)))))
|
|
;; Error callback
|
|
(fn (err)
|
|
(do
|
|
(clear-loading-state el indicator disabled-elts)
|
|
(revert-optimistic optimistic-state)
|
|
(when (not (abort-error? err))
|
|
(dom-dispatch el "sx:requestError"
|
|
(dict "error" err))))))))))))
|
|
|
|
|
|
(define handle-fetch-success
|
|
(fn (el url verb extraParams get-header text)
|
|
;; Route a successful response through the appropriate handler.
|
|
(let ((resp-headers (process-response-headers get-header)))
|
|
;; CSS hash update
|
|
(let ((new-hash (get resp-headers "css-hash")))
|
|
(when new-hash (set! _css-hash new-hash)))
|
|
|
|
;; Triggers (before swap)
|
|
(dispatch-trigger-events el (get resp-headers "trigger"))
|
|
|
|
(cond
|
|
;; Redirect
|
|
(get resp-headers "redirect")
|
|
(browser-navigate (get resp-headers "redirect"))
|
|
|
|
;; Refresh
|
|
(get resp-headers "refresh")
|
|
(browser-reload)
|
|
|
|
;; Location (SX-Location header)
|
|
(get resp-headers "location")
|
|
(fetch-location (get resp-headers "location"))
|
|
|
|
;; Normal response — route by content type
|
|
:else
|
|
(let ((target-el (if (get resp-headers "retarget")
|
|
(dom-query (get resp-headers "retarget"))
|
|
(resolve-target el)))
|
|
(swap-spec (parse-swap-spec
|
|
(or (get resp-headers "reswap")
|
|
(dom-get-attr el "sx-swap"))
|
|
(dom-has-class? (dom-body) "sx-transitions")))
|
|
(swap-style (get swap-spec "style"))
|
|
(use-transition (get swap-spec "transition"))
|
|
(ct (or (get resp-headers "content-type") "")))
|
|
|
|
;; Dispatch by content type
|
|
(if (contains? ct "text/sx")
|
|
(handle-sx-response el target-el text swap-style use-transition)
|
|
(handle-html-response el target-el text swap-style use-transition))
|
|
|
|
;; Post-swap triggers
|
|
(dispatch-trigger-events el (get resp-headers "trigger-swap"))
|
|
|
|
;; History
|
|
(handle-history el url resp-headers)
|
|
|
|
;; Settle triggers (after small delay)
|
|
(when (get resp-headers "trigger-settle")
|
|
(set-timeout
|
|
(fn () (dispatch-trigger-events el
|
|
(get resp-headers "trigger-settle")))
|
|
20))
|
|
|
|
;; Lifecycle event
|
|
(dom-dispatch el "sx:afterSwap"
|
|
(dict "target" target-el "swap" swap-style)))))))
|
|
|
|
|
|
(define handle-sx-response
|
|
(fn (el target text swap-style use-transition)
|
|
;; Handle SX-format response: strip components, extract CSS, render, swap.
|
|
(let ((cleaned (strip-component-scripts text)))
|
|
(let ((final (extract-response-css cleaned)))
|
|
(let ((trimmed (trim final)))
|
|
(when (not (empty? trimmed))
|
|
(let ((rendered (sx-render trimmed))
|
|
(container (dom-create-element "div" nil)))
|
|
(dom-append container rendered)
|
|
;; Process OOB swaps
|
|
(process-oob-swaps container
|
|
(fn (t oob s)
|
|
(swap-dom-nodes t oob s)
|
|
(sx-hydrate t)
|
|
(process-elements t)))
|
|
;; Select if specified
|
|
(let ((select-sel (dom-get-attr el "sx-select"))
|
|
(content (if select-sel
|
|
(select-from-container container select-sel)
|
|
(children-to-fragment container))))
|
|
;; Swap
|
|
(with-transition use-transition
|
|
(fn ()
|
|
(swap-dom-nodes target content swap-style)
|
|
(post-swap target)))))))))))
|
|
|
|
|
|
(define handle-html-response
|
|
(fn (el target text swap-style use-transition)
|
|
;; Handle HTML-format response: parse, OOB, select, swap.
|
|
(let ((doc (dom-parse-html-document text)))
|
|
(when doc
|
|
(let ((select-sel (dom-get-attr el "sx-select")))
|
|
(if select-sel
|
|
;; Select from parsed document
|
|
(let ((html (select-html-from-doc doc select-sel)))
|
|
(with-transition use-transition
|
|
(fn ()
|
|
(swap-html-string target html swap-style)
|
|
(post-swap target))))
|
|
;; Full body content
|
|
(let ((container (dom-create-element "div" nil)))
|
|
(dom-set-inner-html container (dom-body-inner-html doc))
|
|
;; Process OOB swaps
|
|
(process-oob-swaps container
|
|
(fn (t oob s)
|
|
(swap-dom-nodes t oob s)
|
|
(post-swap t)))
|
|
;; Hoist head elements
|
|
(hoist-head-elements container)
|
|
;; Swap remaining content
|
|
(with-transition use-transition
|
|
(fn ()
|
|
(swap-dom-nodes target (children-to-fragment container) swap-style)
|
|
(post-swap target))))))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Retry
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define handle-retry
|
|
(fn (el verb method url extraParams)
|
|
;; Handle retry on failure if sx-retry is configured
|
|
(let ((retry-attr (dom-get-attr el "sx-retry"))
|
|
(spec (parse-retry-spec retry-attr)))
|
|
(when spec
|
|
(let ((current-ms (or (dom-get-attr el "data-sx-retry-ms")
|
|
(get spec "start-ms"))))
|
|
(let ((ms (parse-int current-ms (get spec "start-ms"))))
|
|
(dom-set-attr el "data-sx-retry-ms"
|
|
(str (next-retry-ms ms (get spec "cap-ms"))))
|
|
(set-timeout
|
|
(fn () (do-fetch el verb method url extraParams))
|
|
ms)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Trigger binding
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define bind-triggers
|
|
(fn (el verbInfo)
|
|
;; Bind triggers from sx-trigger attribute (or defaults)
|
|
(let ((triggers (or (parse-trigger-spec (dom-get-attr el "sx-trigger"))
|
|
(default-trigger (dom-tag-name el)))))
|
|
(for-each
|
|
(fn (trigger)
|
|
(let ((kind (classify-trigger trigger))
|
|
(mods (get trigger "modifiers")))
|
|
(cond
|
|
(= kind "poll")
|
|
(set-interval
|
|
(fn () (execute-request el nil nil))
|
|
(get mods "interval"))
|
|
|
|
(= kind "intersect")
|
|
(observe-intersection el
|
|
(fn () (execute-request el nil nil))
|
|
false (get mods "delay"))
|
|
|
|
(= kind "load")
|
|
(set-timeout
|
|
(fn () (execute-request el nil nil))
|
|
(or (get mods "delay") 0))
|
|
|
|
(= kind "revealed")
|
|
(observe-intersection el
|
|
(fn () (execute-request el nil nil))
|
|
true (get mods "delay"))
|
|
|
|
(= kind "event")
|
|
(bind-event el (get trigger "event") mods verbInfo))))
|
|
triggers))))
|
|
|
|
|
|
(define bind-event
|
|
(fn (el event-name mods verbInfo)
|
|
;; Bind a standard DOM event trigger.
|
|
;; Handles delay, once, changed, optimistic, preventDefault.
|
|
(let ((timer nil)
|
|
(last-val nil)
|
|
(listen-target (if (get mods "from")
|
|
(dom-query (get mods "from"))
|
|
el)))
|
|
(when listen-target
|
|
(dom-add-listener listen-target event-name
|
|
(fn (e)
|
|
(let ((should-fire true))
|
|
;; Changed modifier: skip if value unchanged
|
|
(when (get mods "changed")
|
|
(let ((val (element-value el)))
|
|
(if (= val last-val)
|
|
(set! should-fire false)
|
|
(set! last-val val))))
|
|
|
|
(when should-fire
|
|
;; Prevent default for submit/click on links
|
|
(when (or (= event-name "submit")
|
|
(and (= event-name "click")
|
|
(dom-has-attr? el "href")))
|
|
(prevent-default e))
|
|
|
|
;; Delay modifier
|
|
(if (get mods "delay")
|
|
(do
|
|
(clear-timeout timer)
|
|
(set! timer
|
|
(set-timeout
|
|
(fn () (execute-request el verbInfo nil))
|
|
(get mods "delay"))))
|
|
(execute-request el verbInfo nil)))))
|
|
(if (get mods "once") (dict "once" true) nil))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Post-swap lifecycle
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define post-swap
|
|
(fn (root)
|
|
;; Run lifecycle after swap: activate scripts, process SX, hydrate, process
|
|
(activate-scripts root)
|
|
(sx-process-scripts root)
|
|
(sx-hydrate root)
|
|
(process-elements root)))
|
|
|
|
|
|
(define activate-scripts
|
|
(fn (root)
|
|
;; Re-activate scripts in swapped content.
|
|
;; Scripts inserted via innerHTML are inert — clone to make them execute.
|
|
(when root
|
|
(let ((scripts (dom-query-all root "script")))
|
|
(for-each
|
|
(fn (dead)
|
|
;; Skip already-processed or data-components scripts
|
|
(when (and (not (dom-has-attr? dead "data-components"))
|
|
(not (dom-has-attr? dead "data-sx-activated")))
|
|
(let ((live (create-script-clone dead)))
|
|
(dom-set-attr live "data-sx-activated" "true")
|
|
(dom-replace-child (dom-parent dead) live dead))))
|
|
scripts)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; OOB swap processing
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define process-oob-swaps
|
|
(fn (container swap-fn)
|
|
;; Find and process out-of-band swaps in container.
|
|
;; swap-fn is (fn (target oob-element swap-type) ...).
|
|
(let ((oobs (find-oob-swaps container)))
|
|
(for-each
|
|
(fn (oob)
|
|
(let ((target-id (get oob "target-id"))
|
|
(target (dom-query-by-id target-id))
|
|
(oob-el (get oob "element"))
|
|
(swap-type (get oob "swap-type")))
|
|
;; Remove from source container
|
|
(when (dom-parent oob-el)
|
|
(dom-remove-child (dom-parent oob-el) oob-el))
|
|
;; Swap into target
|
|
(when target
|
|
(swap-fn target oob-el swap-type))))
|
|
oobs))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Head element hoisting
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define hoist-head-elements
|
|
(fn (container)
|
|
;; Move style[data-sx-css] and link[rel=stylesheet] to <head>
|
|
;; so they take effect globally.
|
|
(for-each
|
|
(fn (style)
|
|
(when (dom-parent style)
|
|
(dom-remove-child (dom-parent style) style))
|
|
(dom-append-to-head style))
|
|
(dom-query-all container "style[data-sx-css]"))
|
|
(for-each
|
|
(fn (link)
|
|
(when (dom-parent link)
|
|
(dom-remove-child (dom-parent link) link))
|
|
(dom-append-to-head link))
|
|
(dom-query-all container "link[rel=\"stylesheet\"]"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Boost processing
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define process-boosted
|
|
(fn (root)
|
|
;; Find [sx-boost] containers and boost their descendants
|
|
(for-each
|
|
(fn (container)
|
|
(boost-descendants container))
|
|
(dom-query-all (or root (dom-body)) "[sx-boost]"))))
|
|
|
|
|
|
(define boost-descendants
|
|
(fn (container)
|
|
;; Boost links and forms within a container
|
|
;; Links get sx-get, forms get sx-post/sx-get
|
|
(for-each
|
|
(fn (link)
|
|
(when (and (not (is-processed? link "boost"))
|
|
(should-boost-link? link))
|
|
(mark-processed! link "boost")
|
|
;; Set default sx-target if not specified
|
|
(when (not (dom-has-attr? link "sx-target"))
|
|
(dom-set-attr link "sx-target" "#main-panel"))
|
|
(when (not (dom-has-attr? link "sx-swap"))
|
|
(dom-set-attr link "sx-swap" "innerHTML"))
|
|
(when (not (dom-has-attr? link "sx-push-url"))
|
|
(dom-set-attr link "sx-push-url" "true"))
|
|
(bind-boost-link link (dom-get-attr link "href"))))
|
|
(dom-query-all container "a[href]"))
|
|
(for-each
|
|
(fn (form)
|
|
(when (and (not (is-processed? form "boost"))
|
|
(should-boost-form? form))
|
|
(mark-processed! form "boost")
|
|
(let ((method (upper (or (dom-get-attr form "method") "GET")))
|
|
(action (or (dom-get-attr form "action")
|
|
(browser-location-href))))
|
|
(when (not (dom-has-attr? form "sx-target"))
|
|
(dom-set-attr form "sx-target" "#main-panel"))
|
|
(when (not (dom-has-attr? form "sx-swap"))
|
|
(dom-set-attr form "sx-swap" "innerHTML"))
|
|
(bind-boost-form form method action))))
|
|
(dom-query-all container "form"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; SSE processing
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define process-sse
|
|
(fn (root)
|
|
;; Find and bind SSE elements
|
|
(for-each
|
|
(fn (el)
|
|
(when (not (is-processed? el "sse"))
|
|
(mark-processed! el "sse")
|
|
(bind-sse el)))
|
|
(dom-query-all (or root (dom-body)) "[sx-sse]"))))
|
|
|
|
|
|
(define bind-sse
|
|
(fn (el)
|
|
;; Connect to SSE endpoint and bind swap handler
|
|
(let ((url (dom-get-attr el "sx-sse")))
|
|
(when url
|
|
(let ((source (event-source-connect url el))
|
|
(event-name (parse-sse-swap el)))
|
|
(event-source-listen source event-name
|
|
(fn (data)
|
|
(bind-sse-swap el data))))))))
|
|
|
|
|
|
(define bind-sse-swap
|
|
(fn (el data)
|
|
;; Handle an SSE event: swap data into element
|
|
(let ((target (resolve-target el))
|
|
(swap-spec (parse-swap-spec
|
|
(dom-get-attr el "sx-swap")
|
|
(dom-has-class? (dom-body) "sx-transitions")))
|
|
(swap-style (get swap-spec "style"))
|
|
(use-transition (get swap-spec "transition"))
|
|
(trimmed (trim data)))
|
|
(when (not (empty? trimmed))
|
|
(if (starts-with? trimmed "(")
|
|
;; SX response
|
|
(let ((rendered (sx-render trimmed))
|
|
(container (dom-create-element "div" nil)))
|
|
(dom-append container rendered)
|
|
(with-transition use-transition
|
|
(fn ()
|
|
(swap-dom-nodes target (children-to-fragment container) swap-style)
|
|
(post-swap target))))
|
|
;; HTML response
|
|
(with-transition use-transition
|
|
(fn ()
|
|
(swap-html-string target trimmed swap-style)
|
|
(post-swap target))))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Inline event handlers
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define bind-inline-handlers
|
|
(fn (root)
|
|
;; Find elements with sx-on:* attributes and bind handlers
|
|
(for-each
|
|
(fn (el)
|
|
(for-each
|
|
(fn (attr)
|
|
(let ((name (first attr))
|
|
(body (nth attr 1)))
|
|
(when (starts-with? name "sx-on:")
|
|
(let ((event-name (slice name 6)))
|
|
(when (not (is-processed? el (str "on:" event-name)))
|
|
(mark-processed! el (str "on:" event-name))
|
|
(bind-inline-handler el event-name body))))))
|
|
(dom-attr-list el)))
|
|
(dom-query-all (or root (dom-body)) "[sx-on\\:beforeRequest],[sx-on\\:afterRequest],[sx-on\\:afterSwap],[sx-on\\:afterSettle],[sx-on\\:load]"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Preload
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define bind-preload-for
|
|
(fn (el)
|
|
;; Bind preload event listeners based on sx-preload attribute
|
|
(let ((preload-attr (dom-get-attr el "sx-preload")))
|
|
(when preload-attr
|
|
(let ((info (get-verb-info el)))
|
|
(when info
|
|
(let ((url (get info "url"))
|
|
(headers (build-request-headers el
|
|
(loaded-component-names) _css-hash))
|
|
(events (if (= preload-attr "mousedown")
|
|
(list "mousedown" "touchstart")
|
|
(list "mouseover")))
|
|
(debounce-ms (if (= preload-attr "mousedown") 0 100)))
|
|
(bind-preload el events debounce-ms
|
|
(fn () (do-preload url headers))))))))))
|
|
|
|
|
|
(define do-preload
|
|
(fn (url headers)
|
|
;; Execute a preload fetch into the cache
|
|
(when (nil? (preload-cache-get _preload-cache url))
|
|
(fetch-preload url headers _preload-cache))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Main element processing
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define VERB_SELECTOR
|
|
(str "[sx-get],[sx-post],[sx-put],[sx-delete],[sx-patch]"))
|
|
|
|
(define process-elements
|
|
(fn (root)
|
|
;; Find all elements with sx-* verb attributes and process them.
|
|
(let ((els (dom-query-all (or root (dom-body)) VERB_SELECTOR)))
|
|
(for-each
|
|
(fn (el)
|
|
(when (not (is-processed? el "verb"))
|
|
(mark-processed! el "verb")
|
|
(process-one el)))
|
|
els))
|
|
;; Also process boost, SSE, inline handlers
|
|
(process-boosted root)
|
|
(process-sse root)
|
|
(bind-inline-handlers root)))
|
|
|
|
|
|
(define process-one
|
|
(fn (el)
|
|
;; Process a single element with an sx-* verb attribute
|
|
(let ((verb-info (get-verb-info el)))
|
|
(when verb-info
|
|
;; Check for disabled
|
|
(when (not (dom-has-attr? el "sx-disable"))
|
|
(bind-triggers el verb-info)
|
|
(bind-preload-for el))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; History: popstate handler
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define handle-popstate
|
|
(fn (scrollY)
|
|
;; Handle browser back/forward navigation
|
|
(let ((main (dom-query-by-id "main-panel"))
|
|
(url (browser-location-href)))
|
|
(when main
|
|
(let ((headers (build-request-headers main
|
|
(loaded-component-names) _css-hash)))
|
|
(fetch-and-restore main url headers scrollY))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Initialization
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define engine-init
|
|
(fn ()
|
|
;; Initialize: CSS tracking, scripts, hydrate, process.
|
|
(do
|
|
(init-css-tracking)
|
|
(sx-process-scripts nil)
|
|
(sx-hydrate nil)
|
|
(process-elements nil))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Platform interface — Orchestration
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; From engine.sx (pure logic):
|
|
;; parse-trigger-spec, default-trigger, get-verb-info, classify-trigger,
|
|
;; build-request-headers, process-response-headers, parse-swap-spec,
|
|
;; parse-retry-spec, next-retry-ms, resolve-target, apply-optimistic,
|
|
;; revert-optimistic, find-oob-swaps, swap-dom-nodes, swap-html-string,
|
|
;; morph-children, handle-history, preload-cache-get, preload-cache-set,
|
|
;; should-boost-link?, should-boost-form?, parse-sse-swap, filter-params,
|
|
;; PRELOAD_TTL
|
|
;;
|
|
;; === Promises ===
|
|
;; (promise-resolve val) → resolved Promise
|
|
;; (promise-catch p fn) → p.catch(fn)
|
|
;;
|
|
;; === Abort controllers ===
|
|
;; (abort-previous el) → abort + remove controller for element
|
|
;; (track-controller el ctrl) → store controller for element
|
|
;; (new-abort-controller) → new AbortController()
|
|
;; (controller-signal ctrl) → ctrl.signal
|
|
;; (abort-error? err) → boolean (err.name === "AbortError")
|
|
;;
|
|
;; === Timers ===
|
|
;; (set-timeout fn ms) → timer id
|
|
;; (set-interval fn ms) → timer id
|
|
;; (clear-timeout id) → void
|
|
;; (request-animation-frame fn) → void
|
|
;;
|
|
;; === Fetch ===
|
|
;; (fetch-request config success-fn error-fn) → Promise
|
|
;; config: dict with url, method, headers, body, signal, preloaded,
|
|
;; cross-origin
|
|
;; success-fn: (fn (resp-ok status get-header text) ...)
|
|
;; error-fn: (fn (err) ...)
|
|
;; (fetch-location url) → fetch URL and swap to #main-panel
|
|
;; (fetch-and-restore main url headers scroll-y) → popstate fetch+swap
|
|
;; (fetch-preload url headers cache) → preload into cache
|
|
;;
|
|
;; === Request body ===
|
|
;; (build-request-body el method url) → dict with body, url, content-type
|
|
;;
|
|
;; === Loading state ===
|
|
;; (show-indicator el) → indicator state (or nil)
|
|
;; (disable-elements el) → list of disabled elements
|
|
;; (clear-loading-state el indicator disabled-elts) → void
|
|
;;
|
|
;; === DOM extras (beyond adapter-dom.sx) ===
|
|
;; (dom-query-by-id id) → Element or nil
|
|
;; (dom-matches? el sel) → boolean
|
|
;; (dom-closest el sel) → Element or nil
|
|
;; (dom-body) → document.body
|
|
;; (dom-has-class? el cls) → boolean
|
|
;; (dom-append-to-head el) → void
|
|
;; (dom-parse-html-document text) → parsed document (DOMParser)
|
|
;; (dom-outer-html el) → string
|
|
;; (dom-body-inner-html doc) → string
|
|
;; (dom-tag-name el) → uppercase tag name
|
|
;;
|
|
;; === Events ===
|
|
;; (dom-dispatch el name detail) → boolean (dispatchEvent)
|
|
;; (dom-add-listener el event fn opts) → void
|
|
;; (prevent-default e) → void
|
|
;; (element-value el) → el.value or nil
|
|
;;
|
|
;; === Validation ===
|
|
;; (validate-for-request el) → boolean
|
|
;;
|
|
;; === View Transitions ===
|
|
;; (with-transition enabled fn) → void
|
|
;;
|
|
;; === IntersectionObserver ===
|
|
;; (observe-intersection el fn once? delay) → void
|
|
;;
|
|
;; === EventSource ===
|
|
;; (event-source-connect url el) → EventSource (with cleanup)
|
|
;; (event-source-listen source event fn) → void
|
|
;;
|
|
;; === Boost bindings ===
|
|
;; (bind-boost-link el href) → void (click handler + pushState)
|
|
;; (bind-boost-form form method action) → void (submit handler)
|
|
;;
|
|
;; === Inline handlers ===
|
|
;; (bind-inline-handler el event-name body) → void (new Function)
|
|
;;
|
|
;; === Preload ===
|
|
;; (bind-preload el events debounce-ms fn) → void
|
|
;;
|
|
;; === Processing markers ===
|
|
;; (mark-processed! el key) → void
|
|
;; (is-processed? el key) → boolean
|
|
;;
|
|
;; === Script handling ===
|
|
;; (create-script-clone script) → live script Element
|
|
;;
|
|
;; === SX API (references to Sx/SxRef object) ===
|
|
;; (sx-render source) → DOM nodes
|
|
;; (sx-process-scripts root) → void
|
|
;; (sx-hydrate root) → void
|
|
;; (loaded-component-names) → list of ~name strings
|
|
;;
|
|
;; === Response processing ===
|
|
;; (strip-component-scripts text) → cleaned text
|
|
;; (extract-response-css text) → cleaned text
|
|
;; (select-from-container el sel) → DocumentFragment
|
|
;; (children-to-fragment el) → DocumentFragment
|
|
;; (select-html-from-doc doc sel) → HTML string
|
|
;;
|
|
;; === Parsing ===
|
|
;; (try-parse-json s) → parsed value or nil
|
|
;;
|
|
;; === Browser (via engine.sx) ===
|
|
;; (browser-location-href) → current URL string
|
|
;; (browser-navigate url) → void
|
|
;; (browser-reload) → void
|
|
;; (browser-media-matches? query) → boolean
|
|
;; (browser-confirm msg) → boolean
|
|
;; (browser-prompt msg) → string or nil
|
|
;; (csrf-token) → string
|
|
;; (cross-origin? url) → boolean
|
|
;; (now-ms) → timestamp ms
|
|
;; --------------------------------------------------------------------------
|