giles
d4b23aae4c
29 orchestration functions written in SX + adapter style: request pipeline (execute-request, do-fetch, handle-fetch-success), trigger binding (poll, intersect, load, revealed, event), post-swap processing, OOB swaps, boost, SSE, inline handlers, preload, history/popstate, and engine-init. Platform JS implementations in bootstrap_js.py for all browser-specific operations. Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
1496 lines
57 KiB
Plaintext
1496 lines
57 KiB
Plaintext
;; ==========================================================================
|
|
;; engine.sx — SxEngine specification
|
|
;;
|
|
;; 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.
|
|
;;
|
|
;; 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, ...)
|
|
;;
|
|
;; Depends on:
|
|
;; adapter-dom.sx — render-to-dom (for SX response rendering)
|
|
;; render.sx — shared registries
|
|
;; ==========================================================================
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Constants
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define ENGINE_VERBS (list "get" "post" "put" "delete" "patch"))
|
|
(define DEFAULT_SWAP "outerHTML")
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Trigger parsing
|
|
;; --------------------------------------------------------------------------
|
|
;; Parses the sx-trigger attribute value into a list of trigger descriptors.
|
|
;; Each descriptor is a dict with "event" and "modifiers" keys.
|
|
|
|
(define parse-time
|
|
(fn (s)
|
|
;; Parse time string: "2s" → 2000, "500ms" → 500
|
|
(cond
|
|
(nil? s) 0
|
|
(ends-with? s "ms") (parse-int s 0)
|
|
(ends-with? s "s") (* (parse-int (replace s "s" "") 0) 1000)
|
|
:else (parse-int s 0))))
|
|
|
|
|
|
(define parse-trigger-spec
|
|
(fn (spec)
|
|
;; Parse "click delay:500ms once,change" → list of trigger descriptors
|
|
(if (nil? spec)
|
|
nil
|
|
(let ((raw-parts (split spec ",")))
|
|
(filter
|
|
(fn (x) (not (nil? x)))
|
|
(map
|
|
(fn (part)
|
|
(let ((tokens (split (trim part) " ")))
|
|
(if (empty? tokens)
|
|
nil
|
|
(if (and (= (first tokens) "every") (>= (len tokens) 2))
|
|
;; Polling trigger
|
|
(dict
|
|
"event" "every"
|
|
"modifiers" (dict "interval" (parse-time (nth tokens 1))))
|
|
;; Normal trigger with optional modifiers
|
|
(let ((mods (dict)))
|
|
(for-each
|
|
(fn (tok)
|
|
(cond
|
|
(= tok "once")
|
|
(dict-set! mods "once" true)
|
|
(= tok "changed")
|
|
(dict-set! mods "changed" true)
|
|
(starts-with? tok "delay:")
|
|
(dict-set! mods "delay"
|
|
(parse-time (slice tok 6)))
|
|
(starts-with? tok "from:")
|
|
(dict-set! mods "from"
|
|
(slice tok 5))))
|
|
(rest tokens))
|
|
(dict "event" (first tokens) "modifiers" mods))))))
|
|
raw-parts))))))
|
|
|
|
|
|
(define default-trigger
|
|
(fn (tag-name)
|
|
;; Default trigger for element type
|
|
(cond
|
|
(= tag-name "FORM")
|
|
(list (dict "event" "submit" "modifiers" (dict)))
|
|
(or (= tag-name "INPUT")
|
|
(= tag-name "SELECT")
|
|
(= tag-name "TEXTAREA"))
|
|
(list (dict "event" "change" "modifiers" (dict)))
|
|
:else
|
|
(list (dict "event" "click" "modifiers" (dict))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Verb extraction
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define get-verb-info
|
|
(fn (el)
|
|
;; Check element for sx-get, sx-post, etc. Returns (dict "method" "url") or nil.
|
|
(some
|
|
(fn (verb)
|
|
(let ((url (dom-get-attr el (str "sx-" verb))))
|
|
(if url
|
|
(dict "method" (upper verb) "url" url)
|
|
nil)))
|
|
ENGINE_VERBS)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Request header building
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define build-request-headers
|
|
(fn (el loaded-components css-hash)
|
|
;; Build the SX request headers dict
|
|
(let ((headers (dict
|
|
"SX-Request" "true"
|
|
"SX-Current-URL" (browser-location-href))))
|
|
;; Target selector
|
|
(let ((target-sel (dom-get-attr el "sx-target")))
|
|
(when target-sel
|
|
(dict-set! headers "SX-Target" target-sel)))
|
|
|
|
;; Loaded component names
|
|
(when (not (empty? loaded-components))
|
|
(dict-set! headers "SX-Components"
|
|
(join "," loaded-components)))
|
|
|
|
;; CSS class hash
|
|
(when css-hash
|
|
(dict-set! headers "SX-Css" css-hash))
|
|
|
|
;; Extra headers from sx-headers attribute
|
|
(let ((extra-h (dom-get-attr el "sx-headers")))
|
|
(when extra-h
|
|
(let ((parsed (parse-header-value extra-h)))
|
|
(when parsed
|
|
(for-each
|
|
(fn (key) (dict-set! headers key (str (get parsed key))))
|
|
(keys parsed))))))
|
|
|
|
headers)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Response header processing
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define process-response-headers
|
|
(fn (get-header)
|
|
;; Extract all SX response header directives into a dict.
|
|
;; get-header is (fn (name) → string or nil).
|
|
(dict
|
|
"redirect" (get-header "SX-Redirect")
|
|
"refresh" (get-header "SX-Refresh")
|
|
"trigger" (get-header "SX-Trigger")
|
|
"retarget" (get-header "SX-Retarget")
|
|
"reswap" (get-header "SX-Reswap")
|
|
"location" (get-header "SX-Location")
|
|
"replace-url" (get-header "SX-Replace-Url")
|
|
"css-hash" (get-header "SX-Css-Hash")
|
|
"trigger-swap" (get-header "SX-Trigger-After-Swap")
|
|
"trigger-settle" (get-header "SX-Trigger-After-Settle")
|
|
"content-type" (get-header "Content-Type"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Swap specification parsing
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define parse-swap-spec
|
|
(fn (raw-swap global-transitions?)
|
|
;; Parse "innerHTML transition:true" → dict with style + transition flag
|
|
(let ((parts (split (or raw-swap DEFAULT_SWAP) " "))
|
|
(style (first parts))
|
|
(use-transition global-transitions?))
|
|
(for-each
|
|
(fn (p)
|
|
(cond
|
|
(= p "transition:true") (set! use-transition true)
|
|
(= p "transition:false") (set! use-transition false)))
|
|
(rest parts))
|
|
(dict "style" style "transition" use-transition))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Retry logic
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define parse-retry-spec
|
|
(fn (retry-attr)
|
|
;; Parse "exponential:1000:30000" → spec dict or nil
|
|
(if (nil? retry-attr)
|
|
nil
|
|
(let ((parts (split retry-attr ":")))
|
|
(dict
|
|
"strategy" (first parts)
|
|
"start-ms" (parse-int (nth parts 1) 1000)
|
|
"cap-ms" (parse-int (nth parts 2) 30000))))))
|
|
|
|
|
|
(define next-retry-ms
|
|
(fn (current-ms cap-ms)
|
|
;; Exponential backoff: double current, cap at max
|
|
(min (* current-ms 2) cap-ms)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Form parameter filtering
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define filter-params
|
|
(fn (params-spec all-params)
|
|
;; Filter form parameters by sx-params spec.
|
|
;; all-params is a list of (key value) pairs.
|
|
;; Returns filtered list of (key value) pairs.
|
|
(cond
|
|
(nil? params-spec) all-params
|
|
(= params-spec "none") (list)
|
|
(= params-spec "*") all-params
|
|
(starts-with? params-spec "not ")
|
|
(let ((excluded (map trim (split (slice params-spec 4) ","))))
|
|
(filter
|
|
(fn (p) (not (contains? excluded (first p))))
|
|
all-params))
|
|
:else
|
|
(let ((allowed (map trim (split params-spec ","))))
|
|
(filter
|
|
(fn (p) (contains? allowed (first p)))
|
|
all-params)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Target resolution
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define resolve-target
|
|
(fn (el)
|
|
;; Resolve the swap target for an element
|
|
(let ((sel (dom-get-attr el "sx-target")))
|
|
(cond
|
|
(or (nil? sel) (= sel "this")) el
|
|
(= sel "closest") (dom-parent el)
|
|
:else (dom-query sel)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Optimistic updates
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define apply-optimistic
|
|
(fn (el)
|
|
;; Apply optimistic update preview. Returns state for reverting, or nil.
|
|
(let ((directive (dom-get-attr el "sx-optimistic")))
|
|
(if (nil? directive)
|
|
nil
|
|
(let ((target (or (resolve-target el) el))
|
|
(state (dict "target" target "directive" directive)))
|
|
(cond
|
|
(= directive "remove")
|
|
(do
|
|
(dict-set! state "opacity" (dom-get-style target "opacity"))
|
|
(dom-set-style target "opacity" "0")
|
|
(dom-set-style target "pointer-events" "none"))
|
|
(= directive "disable")
|
|
(do
|
|
(dict-set! state "disabled" (dom-get-prop target "disabled"))
|
|
(dom-set-prop target "disabled" true))
|
|
(starts-with? directive "add-class:")
|
|
(let ((cls (slice directive 10)))
|
|
(dict-set! state "add-class" cls)
|
|
(dom-add-class target cls)))
|
|
state)))))
|
|
|
|
|
|
(define revert-optimistic
|
|
(fn (state)
|
|
;; Revert an optimistic update
|
|
(when state
|
|
(let ((target (get state "target"))
|
|
(directive (get state "directive")))
|
|
(cond
|
|
(= directive "remove")
|
|
(do
|
|
(dom-set-style target "opacity" (or (get state "opacity") ""))
|
|
(dom-set-style target "pointer-events" ""))
|
|
(= directive "disable")
|
|
(dom-set-prop target "disabled" (or (get state "disabled") false))
|
|
(get state "add-class")
|
|
(dom-remove-class target (get state "add-class")))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Out-of-band swap identification
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define find-oob-swaps
|
|
(fn (container)
|
|
;; Find elements marked for out-of-band swapping.
|
|
;; Returns list of (dict "element" el "swap-type" type "target-id" id).
|
|
(let ((results (list)))
|
|
(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 target-id
|
|
(append! results
|
|
(dict "element" oob
|
|
"swap-type" swap-type
|
|
"target-id" target-id)))))
|
|
oob-els)))
|
|
(list "sx-swap-oob" "hx-swap-oob"))
|
|
results)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; DOM morph algorithm
|
|
;; --------------------------------------------------------------------------
|
|
;; Lightweight reconciler: patches oldNode to match newNode in-place,
|
|
;; preserving event listeners, focus, scroll position, and form state
|
|
;; on keyed (id) elements.
|
|
|
|
(define morph-node
|
|
(fn (old-node new-node)
|
|
;; Morph old-node to match new-node, preserving listeners/state.
|
|
(cond
|
|
;; sx-preserve / sx-ignore → skip
|
|
(or (dom-has-attr? old-node "sx-preserve")
|
|
(dom-has-attr? old-node "sx-ignore"))
|
|
nil
|
|
|
|
;; Different node type or tag → replace wholesale
|
|
(or (not (= (dom-node-type old-node) (dom-node-type new-node)))
|
|
(not (= (dom-node-name old-node) (dom-node-name new-node))))
|
|
(dom-replace-child (dom-parent old-node)
|
|
(dom-clone new-node) old-node)
|
|
|
|
;; Text/comment nodes → update content
|
|
(or (= (dom-node-type old-node) 3) (= (dom-node-type old-node) 8))
|
|
(when (not (= (dom-text-content old-node) (dom-text-content new-node)))
|
|
(dom-set-text-content old-node (dom-text-content new-node)))
|
|
|
|
;; Element nodes → sync attributes, then recurse children
|
|
(= (dom-node-type old-node) 1)
|
|
(do
|
|
(sync-attrs old-node new-node)
|
|
;; Skip morphing focused input to preserve user's in-progress edits
|
|
(when (not (and (dom-is-active-element? old-node)
|
|
(dom-is-input-element? old-node)))
|
|
(morph-children old-node new-node))))))
|
|
|
|
|
|
(define sync-attrs
|
|
(fn (old-el new-el)
|
|
;; Add/update attributes from new, remove those not in new
|
|
(for-each
|
|
(fn (attr)
|
|
(let ((name (first attr))
|
|
(val (nth attr 1)))
|
|
(when (not (= (dom-get-attr old-el name) val))
|
|
(dom-set-attr old-el name val))))
|
|
(dom-attr-list new-el))
|
|
(for-each
|
|
(fn (attr)
|
|
(when (not (dom-has-attr? new-el (first attr)))
|
|
(dom-remove-attr old-el (first attr))))
|
|
(dom-attr-list old-el))))
|
|
|
|
|
|
(define morph-children
|
|
(fn (old-parent new-parent)
|
|
;; Reconcile children of old-parent to match new-parent.
|
|
;; Keyed elements (with id) are matched and moved in-place.
|
|
(let ((old-kids (dom-child-list old-parent))
|
|
(new-kids (dom-child-list new-parent))
|
|
;; Build ID map of old children for keyed matching
|
|
(old-by-id (reduce
|
|
(fn (acc kid)
|
|
(let ((id (dom-id kid)))
|
|
(if id (do (dict-set! acc id kid) acc) acc)))
|
|
(dict) old-kids))
|
|
(oi 0))
|
|
|
|
;; Walk new children, morph/insert/append
|
|
(for-each
|
|
(fn (new-child)
|
|
(let ((match-id (dom-id new-child))
|
|
(match-by-id (if match-id (dict-get old-by-id match-id) nil)))
|
|
(cond
|
|
;; Keyed match — move into position if needed, then morph
|
|
(and match-by-id (not (nil? match-by-id)))
|
|
(do
|
|
(when (and (< oi (len old-kids))
|
|
(not (= match-by-id (nth old-kids oi))))
|
|
(dom-insert-before old-parent match-by-id
|
|
(if (< oi (len old-kids)) (nth old-kids oi) nil)))
|
|
(morph-node match-by-id new-child)
|
|
(set! oi (inc oi)))
|
|
|
|
;; Positional match
|
|
(< oi (len old-kids))
|
|
(let ((old-child (nth old-kids oi)))
|
|
(if (and (dom-id old-child) (not match-id))
|
|
;; Old has ID, new doesn't — insert new before old
|
|
(dom-insert-before old-parent
|
|
(dom-clone new-child) old-child)
|
|
;; Normal positional morph
|
|
(do
|
|
(morph-node old-child new-child)
|
|
(set! oi (inc oi)))))
|
|
|
|
;; Extra new children — append
|
|
:else
|
|
(dom-append old-parent (dom-clone new-child)))))
|
|
new-kids)
|
|
|
|
;; Remove leftover old children
|
|
(for-each
|
|
(fn (i)
|
|
(when (>= i oi)
|
|
(let ((leftover (nth old-kids i)))
|
|
(when (and (dom-is-child-of? leftover old-parent)
|
|
(not (dom-has-attr? leftover "sx-preserve"))
|
|
(not (dom-has-attr? leftover "sx-ignore")))
|
|
(dom-remove-child old-parent leftover)))))
|
|
(range oi (len old-kids))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Swap dispatch
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define swap-dom-nodes
|
|
(fn (target new-nodes strategy)
|
|
;; Execute a swap strategy on live DOM nodes.
|
|
;; new-nodes is typically a DocumentFragment or Element.
|
|
(case strategy
|
|
"innerHTML"
|
|
(if (dom-is-fragment? new-nodes)
|
|
(morph-children target new-nodes)
|
|
(let ((wrapper (dom-create-element "div" nil)))
|
|
(dom-append wrapper new-nodes)
|
|
(morph-children target wrapper)))
|
|
|
|
"outerHTML"
|
|
(let ((parent (dom-parent target)))
|
|
(if (dom-is-fragment? new-nodes)
|
|
;; Fragment — morph first child, insert rest
|
|
(let ((fc (dom-first-child new-nodes)))
|
|
(if fc
|
|
(do
|
|
(morph-node target fc)
|
|
;; Insert remaining siblings after morphed element
|
|
(let ((sib (dom-next-sibling fc)))
|
|
(insert-remaining-siblings parent target sib)))
|
|
(dom-remove-child parent target)))
|
|
(morph-node target new-nodes))
|
|
parent)
|
|
|
|
"afterend"
|
|
(dom-insert-after target new-nodes)
|
|
|
|
"beforeend"
|
|
(dom-append target new-nodes)
|
|
|
|
"afterbegin"
|
|
(dom-prepend target new-nodes)
|
|
|
|
"beforebegin"
|
|
(dom-insert-before (dom-parent target) new-nodes target)
|
|
|
|
"delete"
|
|
(dom-remove-child (dom-parent target) target)
|
|
|
|
"none"
|
|
nil
|
|
|
|
;; Default = innerHTML
|
|
:else
|
|
(if (dom-is-fragment? new-nodes)
|
|
(morph-children target new-nodes)
|
|
(let ((wrapper (dom-create-element "div" nil)))
|
|
(dom-append wrapper new-nodes)
|
|
(morph-children target wrapper))))))
|
|
|
|
|
|
(define insert-remaining-siblings
|
|
(fn (parent ref-node sib)
|
|
;; Insert sibling chain after ref-node
|
|
(when sib
|
|
(let ((next (dom-next-sibling sib)))
|
|
(dom-insert-after ref-node sib)
|
|
(insert-remaining-siblings parent sib next)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; String-based swap (fallback for HTML responses)
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define swap-html-string
|
|
(fn (target html strategy)
|
|
;; Execute a swap strategy using an HTML string (DOMParser pipeline).
|
|
(case strategy
|
|
"innerHTML"
|
|
(dom-set-inner-html target html)
|
|
"outerHTML"
|
|
(let ((parent (dom-parent target)))
|
|
(dom-insert-adjacent-html target "afterend" html)
|
|
(dom-remove-child parent target)
|
|
parent)
|
|
"afterend"
|
|
(dom-insert-adjacent-html target "afterend" html)
|
|
"beforeend"
|
|
(dom-insert-adjacent-html target "beforeend" html)
|
|
"afterbegin"
|
|
(dom-insert-adjacent-html target "afterbegin" html)
|
|
"beforebegin"
|
|
(dom-insert-adjacent-html target "beforebegin" html)
|
|
"delete"
|
|
(dom-remove-child (dom-parent target) target)
|
|
"none"
|
|
nil
|
|
:else
|
|
(dom-set-inner-html target html))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; History management
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define handle-history
|
|
(fn (el url resp-headers)
|
|
;; Process history push/replace based on element attrs and response headers
|
|
(let ((push-url (dom-get-attr el "sx-push-url"))
|
|
(replace-url (dom-get-attr el "sx-replace-url"))
|
|
(hdr-replace (get resp-headers "replace-url")))
|
|
(cond
|
|
;; Server override
|
|
hdr-replace
|
|
(browser-replace-state hdr-replace)
|
|
;; Client push
|
|
(and push-url (not (= push-url "false")))
|
|
(browser-push-state
|
|
(if (= push-url "true") url push-url))
|
|
;; Client replace
|
|
(and replace-url (not (= replace-url "false")))
|
|
(browser-replace-state
|
|
(if (= replace-url "true") url replace-url))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Preload cache
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define PRELOAD_TTL 30000) ;; 30 seconds
|
|
|
|
(define preload-cache-get
|
|
(fn (cache url)
|
|
;; Get and consume a cached preload response.
|
|
;; Returns (dict "text" ... "content-type" ...) or nil.
|
|
(let ((entry (dict-get cache url)))
|
|
(if (nil? entry)
|
|
nil
|
|
(if (> (- (now-ms) (get entry "timestamp")) PRELOAD_TTL)
|
|
(do (dict-delete! cache url) nil)
|
|
(do (dict-delete! cache url) entry))))))
|
|
|
|
|
|
(define preload-cache-set
|
|
(fn (cache url text content-type)
|
|
;; Store a preloaded response
|
|
(dict-set! cache url
|
|
(dict "text" text "content-type" content-type "timestamp" (now-ms)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Trigger dispatch table
|
|
;; --------------------------------------------------------------------------
|
|
;; Maps trigger event names to binding strategies.
|
|
;; This is the logic; actual browser event binding is platform interface.
|
|
|
|
(define classify-trigger
|
|
(fn (trigger)
|
|
;; Classify a parsed trigger descriptor for binding.
|
|
;; Returns one of: "poll", "intersect", "load", "revealed", "event"
|
|
(let ((event (get trigger "event")))
|
|
(cond
|
|
(= event "every") "poll"
|
|
(= event "intersect") "intersect"
|
|
(= event "load") "load"
|
|
(= event "revealed") "revealed"
|
|
:else "event"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Boost logic
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define should-boost-link?
|
|
(fn (link)
|
|
;; Whether a link inside an sx-boost container should be boosted
|
|
(let ((href (dom-get-attr link "href")))
|
|
(and href
|
|
(not (starts-with? href "#"))
|
|
(not (starts-with? href "javascript:"))
|
|
(not (starts-with? href "mailto:"))
|
|
(browser-same-origin? href)
|
|
(not (dom-has-attr? link "sx-get"))
|
|
(not (dom-has-attr? link "sx-post"))
|
|
(not (dom-has-attr? link "sx-disable"))))))
|
|
|
|
|
|
(define should-boost-form?
|
|
(fn (form)
|
|
;; Whether a form inside an sx-boost container should be boosted
|
|
(and (not (dom-has-attr? form "sx-get"))
|
|
(not (dom-has-attr? form "sx-post"))
|
|
(not (dom-has-attr? form "sx-disable")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; SSE event classification
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define parse-sse-swap
|
|
(fn (el)
|
|
;; Parse sx-sse-swap attribute
|
|
;; Returns event name to listen for (default "message")
|
|
(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
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; === 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
|
|
;; (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
|
|
;; --------------------------------------------------------------------------
|