giles
d5e416e478
Islands survive hypermedia swaps: morph-node skips hydrated data-sx-island elements when the same island exists in new content. dispose-islands-in skips hydrated islands to prevent premature cleanup. - @client directive: .sx files marked ;; @client send define forms to browser - CSSX client-side: cssxgroup renamed (no hyphen) to avoid isRenderExpr matching it as a custom element — was producing [object HTMLElement] - Island wrappers: div→span to avoid block-in-inline HTML parse breakage - ~sx-header is now a defisland with inline reactive colour cycling - bootstrap_js.py defaults output to shared/static/scripts/sx-browser.js - Deleted stale sx-ref.js (sx-browser.js is the canonical browser build) - Hegelian Synthesis essay: dialectic of hypertext and reactivity - component-source helper handles Island types for docs pretty-printing Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
677 lines
25 KiB
Plaintext
677 lines
25 KiB
Plaintext
;; ==========================================================================
|
|
;; 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 pure LOGIC of the engine in s-expressions:
|
|
;; parsing trigger specs, morph algorithm, swap dispatch, header building,
|
|
;; retry logic, target resolution, etc.
|
|
;;
|
|
;; 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)
|
|
;; 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")
|
|
"cache-invalidate" (get-header "SX-Cache-Invalidate")
|
|
"cache-update" (get-header "SX-Cache-Update"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 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
|
|
|
|
;; Hydrated island → preserve reactive state across server swaps.
|
|
;; If old and new are the same island (by name), keep the old DOM
|
|
;; with its live signals, effects, and event listeners intact.
|
|
(and (dom-has-attr? old-node "data-sx-island")
|
|
(is-processed? old-node "island-hydrated")
|
|
(dom-has-attr? new-node "data-sx-island")
|
|
(= (dom-get-attr old-node "data-sx-island")
|
|
(dom-get-attr new-node "data-sx-island")))
|
|
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")))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Platform interface — Engine (pure logic)
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; 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)
|
|
;;
|
|
;; Parsing:
|
|
;; (parse-header-value s) → parsed dict from header string
|
|
;; (now-ms) → current timestamp in milliseconds
|
|
;; --------------------------------------------------------------------------
|