898 lines
35 KiB
Plaintext
898 lines
35 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))
|
|
|
|
;; For GET clicks on links, try client-side routing first
|
|
(let ((is-get-link (and (= event-name "click")
|
|
(= (get verbInfo "method") "GET")
|
|
(dom-has-attr? el "href")
|
|
(not (get mods "delay"))))
|
|
(client-routed false))
|
|
(when is-get-link
|
|
(log-info (str "sx:route trying " (get verbInfo "url")))
|
|
(set! client-routed
|
|
(try-client-route (url-pathname (get verbInfo "url")))))
|
|
(if client-routed
|
|
(do
|
|
(browser-push-state (get verbInfo "url"))
|
|
(browser-scroll-to 0 0))
|
|
(do
|
|
(when is-get-link
|
|
(log-info (str "sx:route server fetch " (get verbInfo "url"))))
|
|
(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-client-route-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"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Client-side routing
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define try-client-route
|
|
(fn (pathname)
|
|
;; Try to render a page client-side. Returns true if successful, false otherwise.
|
|
;; Only works for pages without :data dependencies.
|
|
;; Uses try-eval-content which catches errors — if a component is missing,
|
|
;; eval fails and we fall back to server fetch transparently.
|
|
(let ((match (find-matching-route pathname _page-routes)))
|
|
(if (nil? match)
|
|
(do (log-info (str "sx:route no match (" (len _page-routes) " routes) " pathname)) false)
|
|
(if (get match "has-data")
|
|
(do (log-info (str "sx:route server (has data) " pathname)) false)
|
|
(let ((content-src (get match "content"))
|
|
(closure (or (get match "closure") {}))
|
|
(params (get match "params")))
|
|
(if (or (nil? content-src) (empty? content-src))
|
|
(do (log-warn (str "sx:route no content for " pathname)) false)
|
|
(let ((env (merge closure params))
|
|
(rendered (try-eval-content content-src env)))
|
|
(if (nil? rendered)
|
|
(do (log-info (str "sx:route server (eval failed) " pathname)) false)
|
|
(let ((target (dom-query-by-id "main-panel")))
|
|
(if (nil? target)
|
|
(do (log-warn "sx:route #main-panel not found") false)
|
|
(do
|
|
(dom-set-text-content target "")
|
|
(dom-append target rendered)
|
|
(hoist-head-elements-full target)
|
|
(process-elements target)
|
|
(sx-hydrate-elements target)
|
|
(log-info (str "sx:route client " pathname))
|
|
true))))))))))))
|
|
|
|
|
|
(define bind-client-route-link
|
|
(fn (link href)
|
|
;; Bind a boost link with client-side routing. If the route can be
|
|
;; rendered client-side (pure page, no :data), do so. Otherwise
|
|
;; fall back to standard server fetch via bind-boost-link.
|
|
(bind-client-route-click link href
|
|
(fn ()
|
|
;; Fallback: use standard boost link binding
|
|
(bind-boost-link link href)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 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.
|
|
;; Try client-side route first, fall back to server fetch.
|
|
(let ((main (dom-query-by-id "main-panel"))
|
|
(url (browser-location-href)))
|
|
(when main
|
|
(let ((pathname (url-pathname url)))
|
|
(if (try-client-route pathname)
|
|
(browser-scroll-to 0 scrollY)
|
|
(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)
|
|
;; (bind-client-route-click link href fallback-fn) → void (client route click 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
|
|
;;
|
|
;; === Client-side routing ===
|
|
;; (try-eval-content source env) → DOM node or nil (catches eval errors)
|
|
;; (url-pathname href) → extract pathname from URL string
|
|
;;
|
|
;; From boot.sx:
|
|
;; _page-routes → list of route entries
|
|
;;
|
|
;; From router.sx:
|
|
;; (find-matching-route path routes) → matching entry with params, or nil
|
|
;; (parse-route-pattern pattern) → parsed pattern segments
|
|
;;
|
|
;; === Browser (via engine.sx) ===
|
|
;; (browser-location-href) → current URL string
|
|
;; (browser-navigate url) → void
|
|
;; (browser-reload) → void
|
|
;; (browser-scroll-to x y) → 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
|
|
;; --------------------------------------------------------------------------
|