Split orchestration from engine into separate adapter
engine.sx now contains only pure logic: parsing, morph, swap, headers, retry, target resolution, etc. orchestration.sx contains the browser wiring: request execution, trigger binding, SSE, boost, post-swap lifecycle, and init. Dependency is one-way: orchestration → engine. Bootstrap compiler gains "orchestration" as a separate adapter with deps on engine+dom. Engine-only builds get morph/swap without the full browser runtime. Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -1,41 +1,15 @@
|
||||
;; ==========================================================================
|
||||
;; engine.sx — SxEngine specification
|
||||
;; engine.sx — SxEngine pure logic
|
||||
;;
|
||||
;; Fetch/swap/history engine for browser-side SX. Like HTMX but native
|
||||
;; to the SX rendering pipeline.
|
||||
;;
|
||||
;; This file specifies the LOGIC of the engine in s-expressions.
|
||||
;; Browser-specific APIs (fetch, DOM, history, events) are declared as
|
||||
;; platform interface at the bottom.
|
||||
;; This file specifies the pure LOGIC of the engine in s-expressions:
|
||||
;; parsing trigger specs, morph algorithm, swap dispatch, header building,
|
||||
;; retry logic, target resolution, etc.
|
||||
;;
|
||||
;; The engine processes elements with sx-* attributes:
|
||||
;; sx-get, sx-post, sx-put, sx-delete, sx-patch — HTTP verb + URL
|
||||
;; sx-trigger — when to fire (click, submit, change, every 5s, ...)
|
||||
;; sx-target — where to swap response (#selector, "this", "closest")
|
||||
;; sx-swap — how to swap (innerHTML, outerHTML, afterend, ...)
|
||||
;; sx-select — filter response (CSS selector)
|
||||
;; sx-confirm — confirmation dialog before request
|
||||
;; sx-prompt — prompt dialog, sends result as SX-Prompt header
|
||||
;; sx-validate — form validation before request
|
||||
;; sx-encoding — "json" for JSON body instead of form-encoded
|
||||
;; sx-params — filter form fields (include, exclude, none)
|
||||
;; sx-include — include extra inputs from other elements
|
||||
;; sx-vals — extra key-value pairs to send
|
||||
;; sx-headers — extra request headers
|
||||
;; sx-indicator — show/hide loading indicator
|
||||
;; sx-disabled-elt — disable elements during request
|
||||
;; sx-push-url — push to browser history
|
||||
;; sx-replace-url — replace browser history
|
||||
;; sx-sync — abort previous request ("replace")
|
||||
;; sx-media — only fire if media query matches
|
||||
;; sx-preload — preload on mousedown/mouseover
|
||||
;; sx-boost — auto-boost links and forms in container
|
||||
;; sx-sse — connect to Server-Sent Events
|
||||
;; sx-retry — retry on failure (exponential:startMs:capMs)
|
||||
;; sx-optimistic — optimistic update (remove, disable, add-class:name)
|
||||
;; sx-preserve — don't morph this element during swap
|
||||
;; sx-ignore — skip morphing entirely
|
||||
;; sx-on:* — inline event handlers (beforeRequest, afterSwap, ...)
|
||||
;; Orchestration (binding events, executing requests, processing elements)
|
||||
;; lives in orchestration.sx, which depends on this file.
|
||||
;;
|
||||
;; Depends on:
|
||||
;; adapter-dom.sx — render-to-dom (for SX response rendering)
|
||||
@@ -662,834 +636,29 @@
|
||||
(or (dom-get-attr el "sx-sse-swap") "message")))
|
||||
|
||||
|
||||
;; ==========================================================================
|
||||
;; Engine orchestration
|
||||
;;
|
||||
;; The following functions define the runtime behavior of the engine:
|
||||
;; request execution, trigger binding, post-swap lifecycle, boost, SSE,
|
||||
;; and main processing. Browser-specific mechanics (fetch, addEventListener,
|
||||
;; IntersectionObserver, EventSource, etc.) are declared as platform
|
||||
;; interface at the bottom.
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Engine state
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define _preload-cache (dict))
|
||||
(define _css-hash "")
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Event dispatch helpers
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define dispatch-trigger-events
|
||||
(fn (el header-val)
|
||||
;; Parse and dispatch SX-Trigger header events.
|
||||
;; Value: JSON object, JSON string, or comma-separated names.
|
||||
(when header-val
|
||||
(let ((parsed (try-parse-json header-val)))
|
||||
(if (and parsed (dict? parsed))
|
||||
(for-each
|
||||
(fn (key) (dom-dispatch el key (dict-get parsed key)))
|
||||
(keys parsed))
|
||||
(for-each
|
||||
(fn (name)
|
||||
(let ((n (trim name)))
|
||||
(when (not (= n ""))
|
||||
(dom-dispatch el n (dict)))))
|
||||
(split header-val ",")))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; CSS tracking
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define init-css-tracking
|
||||
(fn ()
|
||||
;; Read CSS hash from <meta name="sx-css-classes">
|
||||
(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 verb-info extra-params)
|
||||
;; Pre-flight gate logic: media, confirm, prompt.
|
||||
;; Returns a promise.
|
||||
(let ((current-verb (get-verb-info el))
|
||||
(verb (if current-verb current-verb verb-info))
|
||||
(method (get verb "method"))
|
||||
(url (get verb "url")))
|
||||
;; Reset retry backoff on fresh requests
|
||||
(when (not (dom-has-class? el "sx-error"))
|
||||
(dom-remove-attr el "data-sx-retry-ms"))
|
||||
;; Gate: media query
|
||||
(if (let ((media (dom-get-attr el "sx-media")))
|
||||
(and media (not (browser-media-matches? media))))
|
||||
(promise-resolve nil)
|
||||
;; Gate: confirm dialog
|
||||
(if (let ((msg (dom-get-attr el "sx-confirm")))
|
||||
(and msg (not (browser-confirm msg))))
|
||||
(promise-resolve nil)
|
||||
;; Gate: prompt dialog
|
||||
(let ((prompt-msg (dom-get-attr el "sx-prompt"))
|
||||
(params extra-params))
|
||||
(if prompt-msg
|
||||
(let ((prompt-val (browser-prompt prompt-msg)))
|
||||
(if (nil? prompt-val)
|
||||
(promise-resolve nil)
|
||||
(do
|
||||
(set! params (or params (dict)))
|
||||
(dict-set! params "promptValue" prompt-val)
|
||||
(do-fetch el verb method url params))))
|
||||
(do-fetch el verb method url params))))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Fetch pipeline
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define do-fetch
|
||||
(fn (el verb method url extra-params)
|
||||
;; Build request, execute fetch, handle response.
|
||||
;; Returns a promise.
|
||||
(let ((sync-attr (dom-get-attr el "sx-sync")))
|
||||
(when (and sync-attr (contains? sync-attr "replace"))
|
||||
(abort-previous el))
|
||||
(let ((ctrl (new-abort-controller)))
|
||||
(track-controller el ctrl)
|
||||
(let ((headers (build-request-headers el
|
||||
(loaded-component-names) _css-hash)))
|
||||
;; Prompt header
|
||||
(when (and extra-params (dict-has? extra-params "promptValue"))
|
||||
(dict-set! headers "SX-Prompt"
|
||||
(get extra-params "promptValue")))
|
||||
;; CSRF for mutating same-origin
|
||||
(when (and (not (= method "GET")) (browser-same-origin? url))
|
||||
(let ((csrf (csrf-token)))
|
||||
(when csrf
|
||||
(dict-set! headers "X-CSRFToken" csrf))))
|
||||
;; Build request body
|
||||
(let ((body-info (build-request-body el method url)))
|
||||
(let ((body (get body-info "body"))
|
||||
(final-url (get body-info "url"))
|
||||
(ct (get body-info "content-type")))
|
||||
(when ct (dict-set! headers "Content-Type" ct))
|
||||
;; Lifecycle: beforeRequest
|
||||
(if (not (dom-dispatch el "sx:beforeRequest"
|
||||
(dict "method" method "url" final-url)))
|
||||
(promise-resolve nil)
|
||||
(do
|
||||
;; Loading state
|
||||
(dom-add-class el "sx-request")
|
||||
(dom-set-attr el "aria-busy" "true")
|
||||
(let ((indicator (show-indicator el))
|
||||
(disabled-elts (disable-elements el))
|
||||
(preloaded (if (= method "GET")
|
||||
(preload-cache-get _preload-cache final-url)
|
||||
nil)))
|
||||
;; Platform fetch with callbacks
|
||||
(fetch-request
|
||||
(dict "url" final-url "method" method
|
||||
"headers" headers "body" body
|
||||
"signal" (controller-signal ctrl)
|
||||
"preloaded" preloaded
|
||||
"cross-origin" (cross-origin? final-url))
|
||||
;; Success: (fn (resp-ok status get-header text) ...)
|
||||
(fn (resp-ok status get-header text)
|
||||
(do
|
||||
(clear-loading-state el indicator disabled-elts)
|
||||
(if (not resp-ok)
|
||||
(do
|
||||
(dom-dispatch el "sx:responseError"
|
||||
(dict "status" status))
|
||||
(handle-retry el verb extra-params))
|
||||
(do
|
||||
(dom-dispatch el "sx:afterRequest" (dict))
|
||||
(handle-fetch-success el final-url verb
|
||||
extra-params get-header text)))))
|
||||
;; Error: (fn (err) ...)
|
||||
(fn (err)
|
||||
(do
|
||||
(clear-loading-state el indicator disabled-elts)
|
||||
(when (not (abort-error? err))
|
||||
(do
|
||||
(dom-dispatch el "sx:sendError"
|
||||
(dict "error" err))
|
||||
(handle-retry el verb extra-params))))))))))))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Response handling
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define handle-fetch-success
|
||||
(fn (el url verb extra-params get-header text)
|
||||
;; Process a successful fetch response.
|
||||
(let ((headers (process-response-headers get-header)))
|
||||
;; Redirect — skip swap
|
||||
(if (get headers "redirect")
|
||||
(browser-navigate (get headers "redirect"))
|
||||
;; Refresh — skip swap
|
||||
(if (= (get headers "refresh") "true")
|
||||
(browser-reload)
|
||||
(do
|
||||
;; Trigger events from header
|
||||
(dispatch-trigger-events el (get headers "trigger"))
|
||||
;; Determine swap target and strategy
|
||||
(let ((raw-swap (or (dom-get-attr el "sx-swap") DEFAULT_SWAP))
|
||||
(target (resolve-target el))
|
||||
(select-sel (dom-get-attr el "sx-select")))
|
||||
;; Server overrides
|
||||
(when (get headers "retarget")
|
||||
(set! target (or (dom-query (get headers "retarget")) target)))
|
||||
(when (get headers "reswap")
|
||||
(set! raw-swap (get headers "reswap")))
|
||||
;; Parse swap spec
|
||||
(let ((swap (parse-swap-spec raw-swap false))
|
||||
(ct (or (get headers "content-type") "")))
|
||||
;; Dispatch by content type
|
||||
(if (contains? ct "text/sx")
|
||||
(handle-sx-response el target swap select-sel text)
|
||||
(handle-html-response el target swap select-sel text))
|
||||
;; SX-Location
|
||||
(when (get headers "location")
|
||||
(fetch-location (get headers "location")))
|
||||
;; History
|
||||
(handle-history el url headers)
|
||||
;; After-swap lifecycle
|
||||
(dom-dispatch el "sx:afterSwap" (dict "target" target))
|
||||
(dispatch-trigger-events el (get headers "trigger-swap"))
|
||||
(request-animation-frame
|
||||
(fn ()
|
||||
(do
|
||||
(dom-dispatch el "sx:afterSettle"
|
||||
(dict "target" target))
|
||||
(dispatch-trigger-events el
|
||||
(get headers "trigger-settle")))))))))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; SX response handler
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define handle-sx-response
|
||||
(fn (el target swap select-sel text)
|
||||
;; Process text/sx response: extract components, CSS, render, swap.
|
||||
(let ((cleaned (strip-component-scripts text))
|
||||
(cleaned2 (extract-response-css cleaned)))
|
||||
(let ((source (trim cleaned2)))
|
||||
(when (and source (not (= source "")))
|
||||
(let ((dom (sx-render source))
|
||||
(container (dom-create-element "div" nil)))
|
||||
(dom-append container dom)
|
||||
;; OOB processing on live DOM nodes
|
||||
(process-oob-swaps container
|
||||
(fn (t oob s) (swap-dom-nodes t oob s)))
|
||||
;; Select filtering
|
||||
(let ((selected (if select-sel
|
||||
(select-from-container container select-sel)
|
||||
(children-to-fragment container))))
|
||||
;; Main swap
|
||||
(when (and (not (= (get swap "style") "none")) target)
|
||||
(with-transition (get swap "transition")
|
||||
(fn ()
|
||||
(do
|
||||
(swap-dom-nodes target selected (get swap "style"))
|
||||
(hoist-head-elements target))))))))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; HTML response handler
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define handle-html-response
|
||||
(fn (el target swap select-sel text)
|
||||
;; Process HTML response: parse, scripts, OOB, swap.
|
||||
(let ((doc (dom-parse-html-document text)))
|
||||
;; Process sx scripts
|
||||
(sx-process-scripts doc)
|
||||
;; OOB processing
|
||||
(process-oob-swaps doc
|
||||
(fn (t oob s)
|
||||
(swap-html-string t (dom-outer-html oob) s)))
|
||||
;; Build content
|
||||
(let ((content (if select-sel
|
||||
(select-html-from-doc doc select-sel)
|
||||
(or (dom-body-inner-html doc) text))))
|
||||
;; Main swap
|
||||
(when (and (not (= (get swap "style") "none")) target)
|
||||
(with-transition (get swap "transition")
|
||||
(fn ()
|
||||
(do
|
||||
(swap-html-string target content (get swap "style"))
|
||||
(hoist-head-elements target)))))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Retry handling
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define handle-retry
|
||||
(fn (el verb-info extra-params)
|
||||
;; Retry failed request with exponential backoff.
|
||||
(let ((retry-attr (dom-get-attr el "sx-retry")))
|
||||
(when retry-attr
|
||||
(let ((spec (parse-retry-spec retry-attr))
|
||||
(current-ms (or (parse-int
|
||||
(dom-get-attr el "data-sx-retry-ms") 0)
|
||||
(get spec "start-ms"))))
|
||||
(dom-add-class el "sx-error")
|
||||
(dom-remove-class el "sx-loading")
|
||||
(set-timeout
|
||||
(fn ()
|
||||
(do
|
||||
(dom-remove-class el "sx-error")
|
||||
(dom-add-class el "sx-loading")
|
||||
(dom-set-attr el "data-sx-retry-ms"
|
||||
(str (next-retry-ms current-ms (get spec "cap-ms"))))
|
||||
(execute-request el verb-info extra-params)))
|
||||
current-ms))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Trigger binding
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define bind-triggers
|
||||
(fn (el verb-info)
|
||||
;; Parse triggers and bind event handlers.
|
||||
(let ((trigger-spec (dom-get-attr el "sx-trigger"))
|
||||
(triggers (if trigger-spec
|
||||
(parse-trigger-spec trigger-spec)
|
||||
(default-trigger (dom-tag-name el)))))
|
||||
(for-each
|
||||
(fn (trig)
|
||||
(let ((kind (classify-trigger trig)))
|
||||
(cond
|
||||
(= kind "poll")
|
||||
(set-interval
|
||||
(fn () (execute-request el verb-info nil))
|
||||
(or (get (get trig "modifiers") "interval") 1000))
|
||||
(= kind "intersect")
|
||||
(observe-intersection el
|
||||
(fn () (execute-request el verb-info nil))
|
||||
(get (get trig "modifiers") "once")
|
||||
(get (get trig "modifiers") "delay"))
|
||||
(= kind "load")
|
||||
(set-timeout
|
||||
(fn () (execute-request el verb-info nil)) 0)
|
||||
(= kind "revealed")
|
||||
(observe-intersection el
|
||||
(fn () (execute-request el verb-info nil))
|
||||
true nil)
|
||||
:else
|
||||
(bind-event el verb-info trig))))
|
||||
triggers))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Event binding with modifiers
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define bind-event
|
||||
(fn (el verb-info trig)
|
||||
;; Bind a single event with modifiers (once, delay, changed, from).
|
||||
(let ((event-name (get trig "event"))
|
||||
(mods (get trig "modifiers"))
|
||||
(listen-target (if (get mods "from")
|
||||
(or (dom-query (get mods "from")) el)
|
||||
el))
|
||||
(timer nil)
|
||||
(last-val nil))
|
||||
(dom-add-listener listen-target event-name
|
||||
(fn (e)
|
||||
(do
|
||||
;; Prevent defaults
|
||||
(when (= event-name "submit") (prevent-default e))
|
||||
(when (and (= event-name "click") (= (dom-tag-name el) "A"))
|
||||
(prevent-default e))
|
||||
;; Validation gate
|
||||
(if (not (validate-for-request el))
|
||||
(dom-dispatch el "sx:validationFailed" (dict))
|
||||
;; Changed modifier gate
|
||||
(if (and (get mods "changed")
|
||||
(not (nil? (element-value el)))
|
||||
(= (element-value el) last-val))
|
||||
nil
|
||||
(do
|
||||
(when (get mods "changed")
|
||||
(set! last-val (element-value el)))
|
||||
;; Apply optimistic update
|
||||
(let ((opt-state (apply-optimistic el))
|
||||
(exec-fn
|
||||
(fn ()
|
||||
(let ((p (execute-request el verb-info nil)))
|
||||
(when (and opt-state p)
|
||||
(promise-catch p
|
||||
(fn (_) (revert-optimistic opt-state))))))))
|
||||
;; Delay modifier
|
||||
(if (get mods "delay")
|
||||
(do
|
||||
(clear-timeout timer)
|
||||
(set! timer
|
||||
(set-timeout exec-fn (get mods "delay"))))
|
||||
(exec-fn))))))))
|
||||
(dict "once" (get mods "once"))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Post-swap lifecycle
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define post-swap
|
||||
(fn (root)
|
||||
;; Post-swap: activate scripts, load components, hydrate, bind engine.
|
||||
(do
|
||||
(activate-scripts root)
|
||||
(sx-process-scripts root)
|
||||
(sx-hydrate root)
|
||||
(process-elements root))))
|
||||
|
||||
(define activate-scripts
|
||||
(fn (root)
|
||||
;; Scripts inserted via innerHTML don't execute.
|
||||
;; Replace dead scripts with live clones so the browser runs them.
|
||||
(let ((dead (dom-query-all root
|
||||
"script:not([type]), script[type='text/javascript']")))
|
||||
(for-each
|
||||
(fn (d)
|
||||
(let ((live (create-script-clone d)))
|
||||
(dom-replace-child (dom-parent d) live d)))
|
||||
dead))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Out-of-band swap processing (orchestration variant)
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define process-oob-swaps
|
||||
(fn (container swap-fn)
|
||||
;; Find elements with sx-swap-oob/hx-swap-oob and swap to targets.
|
||||
(for-each
|
||||
(fn (attr)
|
||||
(let ((oob-els (dom-query-all container (str "[" attr "]"))))
|
||||
(for-each
|
||||
(fn (oob)
|
||||
(let ((swap-type (or (dom-get-attr oob attr) "outerHTML"))
|
||||
(target-id (dom-id oob)))
|
||||
(dom-remove-attr oob attr)
|
||||
(when (dom-parent oob)
|
||||
(dom-remove-child (dom-parent oob) oob))
|
||||
(when target-id
|
||||
(let ((target (dom-query-by-id target-id)))
|
||||
(when target
|
||||
(swap-fn target oob swap-type))))))
|
||||
oob-els)))
|
||||
(list "sx-swap-oob" "hx-swap-oob"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Head element hoisting
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define hoist-head-elements
|
||||
(fn (root)
|
||||
;; Move <style> and <link rel=stylesheet> from swapped content to <head>.
|
||||
(let ((styles (dom-query-all root "style[data-sx-css]"))
|
||||
(links (dom-query-all root "link[rel='stylesheet']")))
|
||||
(for-each
|
||||
(fn (el)
|
||||
(when (dom-parent el)
|
||||
(dom-remove-child (dom-parent el) el))
|
||||
(dom-append-to-head el))
|
||||
styles)
|
||||
(for-each
|
||||
(fn (el)
|
||||
(when (dom-parent el)
|
||||
(dom-remove-child (dom-parent el) el))
|
||||
(dom-append-to-head el))
|
||||
links))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Boost processing
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define process-boosted
|
||||
(fn (root)
|
||||
;; Find sx-boost containers and boost their links/forms.
|
||||
(let ((containers (dom-query-all root "[sx-boost]")))
|
||||
(when (dom-matches? root "[sx-boost]")
|
||||
(boost-descendants root))
|
||||
(for-each boost-descendants containers))))
|
||||
|
||||
(define boost-descendants
|
||||
(fn (container)
|
||||
;; Boost links and forms inside a container.
|
||||
(do
|
||||
;; Boost links
|
||||
(let ((links (dom-query-all container "a[href]")))
|
||||
(for-each
|
||||
(fn (link)
|
||||
(when (and (not (is-processed? link "boost"))
|
||||
(should-boost-link? link))
|
||||
(mark-processed! link "boost")
|
||||
(bind-boost-link link (dom-get-attr link "href"))
|
||||
;; Default attrs for boosted links
|
||||
(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-select"))
|
||||
(dom-set-attr link "sx-select" "#main-panel"))))
|
||||
links))
|
||||
;; Boost forms
|
||||
(let ((forms (dom-query-all container "form")))
|
||||
(for-each
|
||||
(fn (form)
|
||||
(when (and (not (is-processed? form "boost"))
|
||||
(should-boost-form? form))
|
||||
(mark-processed! form "boost")
|
||||
(bind-boost-form form
|
||||
(or (upper (dom-get-attr form "method")) "GET")
|
||||
(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"))))
|
||||
forms)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; SSE (Server-Sent Events)
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define process-sse
|
||||
(fn (root)
|
||||
;; Find elements with sx-sse and bind EventSource connections.
|
||||
(let ((sse-els (dom-query-all root "[sx-sse]")))
|
||||
(when (dom-matches? root "[sx-sse]")
|
||||
(bind-sse root))
|
||||
(for-each bind-sse sse-els))))
|
||||
|
||||
(define bind-sse
|
||||
(fn (el)
|
||||
;; Connect to EventSource and bind swap handlers.
|
||||
(when (not (is-processed? el "sse"))
|
||||
(mark-processed! el "sse")
|
||||
(let ((url (dom-get-attr el "sx-sse")))
|
||||
(when url
|
||||
(let ((source (event-source-connect url el)))
|
||||
(let ((swap-els (dom-query-all el "[sx-sse-swap]")))
|
||||
(when (dom-has-attr? el "sx-sse-swap")
|
||||
(bind-sse-swap el source))
|
||||
(for-each
|
||||
(fn (child) (bind-sse-swap child source))
|
||||
swap-els))))))))
|
||||
|
||||
(define bind-sse-swap
|
||||
(fn (el source)
|
||||
;; Bind SSE event handler for swap.
|
||||
(let ((event-name (parse-sse-swap el)))
|
||||
(event-source-listen source event-name
|
||||
(fn (data)
|
||||
(let ((target (or (resolve-target el) el))
|
||||
(swap-style (or (dom-get-attr el "sx-swap") "innerHTML")))
|
||||
(if (starts-with? (trim data) "(")
|
||||
;; SX response — render to DOM
|
||||
(let ((dom (sx-render data)))
|
||||
(swap-dom-nodes target dom swap-style))
|
||||
;; HTML response
|
||||
(swap-html-string target data swap-style))
|
||||
(post-swap target)
|
||||
(dom-dispatch el "sx:sseMessage"
|
||||
(dict "data" data "event" event-name))))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Inline event handlers
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define bind-inline-handlers
|
||||
(fn (el)
|
||||
;; Bind sx-on:* inline event handlers.
|
||||
(when (not (is-processed? el "on"))
|
||||
(mark-processed! el "on")
|
||||
(let ((attrs (dom-attr-list el)))
|
||||
(for-each
|
||||
(fn (attr)
|
||||
(let ((name (first attr))
|
||||
(val (nth attr 1)))
|
||||
(when (starts-with? name "sx-on:")
|
||||
(bind-inline-handler el (slice name 6) val))))
|
||||
attrs)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Preload
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define bind-preload-for
|
||||
(fn (el)
|
||||
;; Set up preload listeners on the element.
|
||||
(when (dom-has-attr? el "sx-preload")
|
||||
(let ((mode (or (dom-get-attr el "sx-preload") "mousedown"))
|
||||
(events (if (= mode "mouseover")
|
||||
(list "mouseenter" "focusin")
|
||||
(list "mousedown" "focusin")))
|
||||
(debounce-ms (if (= mode "mouseover") 100 0)))
|
||||
(bind-preload el events debounce-ms
|
||||
(fn ()
|
||||
(let ((verb (get-verb-info el)))
|
||||
(when verb
|
||||
(let ((url (get verb "url")))
|
||||
(when (nil? (preload-cache-get _preload-cache url))
|
||||
(do-preload url)))))))))))
|
||||
|
||||
(define do-preload
|
||||
(fn (url)
|
||||
;; Preload a URL into the cache.
|
||||
(let ((headers (build-request-headers nil
|
||||
(loaded-component-names) _css-hash)))
|
||||
(fetch-preload url headers _preload-cache))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Main processing
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define VERB_SELECTOR
|
||||
"[sx-get],[sx-post],[sx-put],[sx-delete],[sx-patch]")
|
||||
|
||||
(define process-elements
|
||||
(fn (root)
|
||||
;; Main engine processing: find and bind all sx-* elements.
|
||||
(let ((root (or root (dom-body))))
|
||||
(when root
|
||||
;; Process root itself
|
||||
(when (dom-matches? root VERB_SELECTOR)
|
||||
(process-one root))
|
||||
;; Process descendants
|
||||
(let ((elements (dom-query-all root VERB_SELECTOR)))
|
||||
(for-each process-one elements))
|
||||
;; Boost, SSE, inline handlers
|
||||
(process-boosted root)
|
||||
(process-sse root)
|
||||
(let ((on-els (dom-query-all root
|
||||
"[sx-on\\:beforeRequest],[sx-on\\:afterRequest],[sx-on\\:afterSwap],[sx-on\\:afterSettle],[sx-on\\:responseError]")))
|
||||
(for-each bind-inline-handlers on-els))))))
|
||||
|
||||
(define process-one
|
||||
(fn (el)
|
||||
;; Process a single element: bind triggers and preload.
|
||||
(when (not (is-processed? el "bound"))
|
||||
;; Skip disabled elements
|
||||
(when (not (or (dom-has-attr? el "sx-disable")
|
||||
(dom-closest el "[sx-disable]")))
|
||||
(mark-processed! el "bound")
|
||||
(let ((verb-info (get-verb-info el)))
|
||||
(when verb-info
|
||||
(bind-triggers el verb-info)
|
||||
(bind-preload-for el)))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; History: popstate handling
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define handle-popstate
|
||||
(fn (scroll-y)
|
||||
;; Handle browser back/forward navigation.
|
||||
(let ((url (browser-location-href))
|
||||
(main (dom-query-by-id "main-panel")))
|
||||
(if (not main)
|
||||
(browser-reload)
|
||||
(let ((headers (build-request-headers nil
|
||||
(loaded-component-names) _css-hash)))
|
||||
(dict-set! headers "SX-History-Restore" "true")
|
||||
(fetch-and-restore main url headers scroll-y))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Engine 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 — Engine
|
||||
;; Platform interface — Engine (pure logic)
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; === Browser/Network ===
|
||||
;; From adapter-dom.sx:
|
||||
;; dom-get-attr, dom-set-attr, dom-remove-attr, dom-has-attr?, dom-attr-list
|
||||
;; dom-query, dom-query-all, dom-id, dom-parent, dom-first-child,
|
||||
;; dom-next-sibling, dom-child-list, dom-node-type, dom-node-name,
|
||||
;; dom-text-content, dom-set-text-content, dom-is-fragment?,
|
||||
;; dom-is-child-of?, dom-is-active-element?, dom-is-input-element?,
|
||||
;; dom-create-element, dom-append, dom-prepend, dom-insert-before,
|
||||
;; dom-insert-after, dom-remove-child, dom-replace-child, dom-clone,
|
||||
;; dom-get-style, dom-set-style, dom-get-prop, dom-set-prop,
|
||||
;; dom-add-class, dom-remove-class, dom-set-inner-html,
|
||||
;; dom-insert-adjacent-html
|
||||
;;
|
||||
;; Browser/Network:
|
||||
;; (browser-location-href) → current URL string
|
||||
;; (browser-same-origin? url) → boolean
|
||||
;; (browser-push-state url) → void (history.pushState)
|
||||
;; (browser-replace-state url) → void (history.replaceState)
|
||||
;; (browser-navigate url) → void (location.assign)
|
||||
;; (browser-reload) → void (location.reload)
|
||||
;; (browser-scroll-to x y) → void
|
||||
;; (browser-media-matches? query) → boolean (matchMedia)
|
||||
;; (browser-confirm msg) → boolean
|
||||
;; (browser-prompt msg) → string or nil
|
||||
;;
|
||||
;; Parsing:
|
||||
;; (parse-header-value s) → parsed dict from header string
|
||||
;; (now-ms) → current timestamp in milliseconds
|
||||
;; (csrf-token) → string from meta[name=csrf-token]
|
||||
;; (cross-origin? url) → boolean (needs credentials:include)
|
||||
;;
|
||||
;; === 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
|
||||
;; Handles FormData, JSON encoding, sx-params, sx-include, sx-vals
|
||||
;;
|
||||
;; === Loading state ===
|
||||
;; (show-indicator el) → indicator state (or nil)
|
||||
;; (disable-elements el) → list of disabled elements
|
||||
;; (clear-loading-state el indicator-state disabled-elts) → void
|
||||
;;
|
||||
;; === DOM query (extended) ===
|
||||
;; (dom-query sel) → Element or nil
|
||||
;; (dom-query-all root sel) → list of Elements
|
||||
;; (dom-query-by-id id) → Element or nil
|
||||
;; (dom-id el) → string id or nil
|
||||
;; (dom-parent el) → parent Element
|
||||
;; (dom-first-child el) → first child node
|
||||
;; (dom-next-sibling el) → next sibling node
|
||||
;; (dom-child-list el) → list of child nodes
|
||||
;; (dom-tag-name el) → uppercase tag name
|
||||
;; (dom-matches? el sel) → boolean
|
||||
;; (dom-closest el sel) → Element or nil
|
||||
;; (dom-body) → document.body
|
||||
;;
|
||||
;; === DOM mutation ===
|
||||
;; (dom-create-element tag ns) → Element
|
||||
;; (dom-append parent child) → void
|
||||
;; (dom-prepend parent child) → void
|
||||
;; (dom-insert-before parent node ref) → void
|
||||
;; (dom-insert-after ref node) → void
|
||||
;; (dom-remove-child parent child) → void
|
||||
;; (dom-replace-child parent new old) → void
|
||||
;; (dom-clone node) → deep clone
|
||||
;; (dom-append-to-head el) → void
|
||||
;;
|
||||
;; === DOM attributes ===
|
||||
;; (dom-get-attr el name) → string or nil
|
||||
;; (dom-set-attr el name val) → void
|
||||
;; (dom-remove-attr el name) → void
|
||||
;; (dom-has-attr? el name) → boolean
|
||||
;; (dom-attr-list el) → list of (name value) pairs
|
||||
;;
|
||||
;; === DOM properties/style ===
|
||||
;; (dom-get-prop el name) → value
|
||||
;; (dom-set-prop el name val) → void
|
||||
;; (dom-get-style el prop) → string
|
||||
;; (dom-set-style el prop val) → void
|
||||
;; (dom-add-class el cls) → void
|
||||
;; (dom-remove-class el cls) → void
|
||||
;; (dom-has-class? el cls) → boolean
|
||||
;;
|
||||
;; === DOM inspection ===
|
||||
;; (dom-node-type el) → number
|
||||
;; (dom-node-name el) → string
|
||||
;; (dom-text-content el) → string
|
||||
;; (dom-set-text-content el s) → void
|
||||
;; (dom-is-fragment? el) → boolean
|
||||
;; (dom-is-child-of? child parent) → boolean
|
||||
;; (dom-is-active-element? el) → boolean
|
||||
;; (dom-is-input-element? el) → boolean
|
||||
;;
|
||||
;; === DOM content ===
|
||||
;; (dom-set-inner-html el html) → void
|
||||
;; (dom-insert-adjacent-html el pos html) → void
|
||||
;; (dom-parse-html-document text) → parsed document (DOMParser)
|
||||
;; (dom-outer-html el) → string
|
||||
;; (dom-body-inner-html doc) → string
|
||||
;;
|
||||
;; === 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
|
||||
;;
|
||||
;; === Event binding (platform-level) ===
|
||||
;; (bind-boost-link el href) → void (click handler + pushState)
|
||||
;; (bind-boost-form form method action) → void (submit handler)
|
||||
;; (bind-inline-handler el event-name body) → void (new Function)
|
||||
;; (bind-preload el events debounce-ms fn) → void (preload listeners)
|
||||
;; (observe-intersection el fn once? delay) → void (IntersectionObserver)
|
||||
;; (event-source-connect url el) → EventSource (with cleanup)
|
||||
;; (event-source-listen source event fn) → void
|
||||
;; (validate-for-request el) → boolean (form validation)
|
||||
;;
|
||||
;; === 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 object) ===
|
||||
;; (sx-render source) → DOM nodes (Sx.render)
|
||||
;; (sx-process-scripts root) → void (Sx.processScripts)
|
||||
;; (sx-hydrate root) → void (Sx.hydrate)
|
||||
;; (loaded-component-names) → list of ~name strings
|
||||
;;
|
||||
;; === Response processing ===
|
||||
;; (strip-component-scripts text) → cleaned text (regex strip + load)
|
||||
;; (extract-response-css text) → cleaned text (regex strip + inject)
|
||||
;; (select-from-container el sel) → DocumentFragment
|
||||
;; (children-to-fragment el) → DocumentFragment
|
||||
;; (select-html-from-doc doc sel) → HTML string
|
||||
;; (with-transition enabled fn) → void (View Transition API)
|
||||
;;
|
||||
;; === Parsing ===
|
||||
;; (parse-header-value s) → dict
|
||||
;; (try-parse-json s) → parsed value or nil
|
||||
;;
|
||||
;; === Misc ===
|
||||
;; (dict-has? d key) → boolean
|
||||
;; (dict-delete! d key) → void
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
Reference in New Issue
Block a user