;; ========================================================================== ;; 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 ;; 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 ;; --------------------------------------------------------------------------