(define _sx-bound-prefix "_sxBound") (define mark-processed! (fn (el key) (host-set! el (str _sx-bound-prefix key) true))) (define is-processed? (fn (el key) (let ((v (host-get el (str _sx-bound-prefix key)))) (if v true false)))) (define clear-processed! (fn (el key) (host-set! el (str _sx-bound-prefix key) nil))) (define callable? (fn (v) (let ((t (type-of v))) (or (= t "lambda") (= t "native-fn") (= t "continuation"))))) (define to-kebab (fn (s) "Convert camelCase to kebab-case." (let ((result (list)) (i 0)) (let loop ((i 0)) (when (< i (len s)) (let ((ch (nth s i))) (if (and (>= ch "A") (<= ch "Z")) (do (when (> i 0) (append! result "-")) (append! result (lower ch))) (append! result ch)) (loop (+ i 1))))) (join "" result)))) (define sx-load-components (fn (text) "Parse and evaluate component definitions from text." (when (and text (> (len text) 0)) (let ((exprs (sx-parse text))) (for-each (fn (expr) (cek-eval expr)) exprs))))) (define call-expr (fn (expr-text env-bindings) "Parse and evaluate an SX expression string." (let ((exprs (sx-parse expr-text))) (when (not (empty? exprs)) (cek-eval (first exprs)))))) (define base-env (fn () "Return the current global environment." (global-env))) (define get-render-env (fn (extra) "Get the rendering environment (global env, optionally merged with extra)." (let ((env (base-env))) (if (and extra (not (nil? extra))) (env-merge env extra) env)))) (define merge-envs (fn (a b) "Merge two environments." (if (and a b) (env-merge a b) (or a b (global-env))))) (define sx-render-with-env (fn (source extra-env) "Parse SX source and render to DOM fragment." (let ((doc (host-global "document")) (frag (host-call doc "createDocumentFragment")) (exprs (sx-parse source))) (for-each (fn (expr) (let ((html (render-to-html expr))) (when (and html (> (len html) 0)) (let ((temp (host-call doc "createElement" "template"))) (host-set! temp "innerHTML" html) (host-call frag "appendChild" (host-get temp "content")))))) exprs) frag))) (define parse-env-attr (fn (el) "Parse data-sx-env attribute (JSON key-value pairs)." nil)) (define store-env-attr (fn (el base new-env) nil)) (define resolve-mount-target (fn (target) "Resolve a CSS selector string to a DOM element." (if (string? target) (dom-query target) target))) (define remove-head-element (fn (sel) "Remove a element matching selector." (let ((el (dom-query sel))) (when el (dom-remove el))))) (define set-sx-comp-cookie (fn (hash) (set-cookie "sx-components" hash))) (define clear-sx-comp-cookie (fn () (set-cookie "sx-components" ""))) (define log-parse-error (fn (label text err) (log-error (str "Parse error in " label ": " err)))) (define loaded-component-names (fn () (let ((scripts (dom-query-all (dom-body) "script[data-components]")) (names (list))) (for-each (fn (script) (let ((text (or (dom-get-attr script "data-components") ""))) (when (> (len text) 0) (for-each (fn (name) (when (> (len (trim name)) 0) (append! names (trim name)))) (split text ","))))) scripts) names))) (define csrf-token (fn () (let ((meta (dom-query "meta[name=\"csrf-token\"]"))) (if meta (dom-get-attr meta "content") nil)))) (define validate-for-request (fn (el) true)) (define build-request-body (fn (el method url) (let ((m (upper method))) (if (or (= m "GET") (= m "HEAD")) (if (and el (= (upper (or (dom-tag-name el) "")) "FORM")) (let ((fd (host-new "FormData" el)) (params (host-new "URLSearchParams" fd)) (qs (host-call params "toString"))) (dict "url" (if (and qs (> (len qs) 0)) (str url (if (contains? url "?") "&" "?") qs) url) "body" nil "content-type" nil)) (dict "url" url "body" nil "content-type" nil)) (if (and el (= (upper (or (dom-tag-name el) "")) "FORM")) (let ((enctype (or (dom-get-attr el "enctype") "application/x-www-form-urlencoded"))) (if (= enctype "multipart/form-data") (let ((fd (host-new "FormData" el))) (dict "url" url "body" fd "content-type" nil)) (let ((fd (host-new "FormData" el)) (params (host-new "URLSearchParams" fd))) (dict "url" url "body" (host-call params "toString") "content-type" "application/x-www-form-urlencoded")))) (dict "url" url "body" nil "content-type" nil)))))) (define abort-previous-target (fn (el) nil)) (define abort-previous (fn (el) nil)) (define track-controller (fn (el ctrl) nil)) (define track-controller-target (fn (el ctrl) nil)) (define new-abort-controller (fn () (host-new "AbortController"))) (define abort-signal (fn (ctrl) (host-get ctrl "signal"))) (define apply-optimistic (fn (el) nil)) (define revert-optimistic (fn (el) nil)) (define dom-has-attr? (fn (el name) (host-call el "hasAttribute" name))) (define show-indicator (fn (el) (let ((indicator-sel (dom-get-attr el "sx-indicator"))) (when indicator-sel (let ((indicator (dom-query indicator-sel))) (when indicator (dom-remove-class indicator "hidden") (dom-add-class indicator "sx-indicator-visible")))) indicator-sel))) (define disable-elements (fn (el) (let ((disable-sel (dom-get-attr el "sx-disabled-elt"))) (if disable-sel (let ((elts (dom-query-all (dom-body) disable-sel))) (for-each (fn (e) (dom-set-attr e "disabled" "")) elts) elts) (list))))) (define clear-loading-state (fn (el indicator disabled-elts) (dom-remove-class el "sx-request") (dom-remove-attr el "aria-busy") (when indicator (let ((ind (dom-query indicator))) (when ind (dom-add-class ind "hidden") (dom-remove-class ind "sx-indicator-visible")))) (when disabled-elts (for-each (fn (e) (dom-remove-attr e "disabled")) disabled-elts)))) (define abort-error? (fn (err) (= (host-get err "name") "AbortError"))) (define promise-catch (fn (p f) (let ((cb (host-callback f))) (host-call p "catch" cb)))) (define fetch-request (fn (config success-fn error-fn) (let ((url (get config "url")) (method (or (get config "method") "GET")) (headers (or (get config "headers") (dict))) (body (get config "body")) (signal (get config "signal")) (preloaded (get config "preloaded"))) (if preloaded (success-fn true 200 (fn (name) nil) preloaded) (let ((h (host-new "Headers")) (js-opts (host-new "Object"))) (for-each (fn (k) (host-call h "set" k (get headers k))) (keys headers)) (host-set! js-opts "method" method) (host-set! js-opts "headers" h) (when body (host-set! js-opts "body" body)) (when signal (host-set! js-opts "signal" signal)) (promise-then (host-call (dom-window) "fetch" url js-opts) (fn (response) (let ((ok (host-get response "ok")) (status (host-get response "status")) (get-header (fn (name) (host-call (host-get response "headers") "get" name)))) (promise-then (host-call response "text") (fn (text) (success-fn ok status get-header text)) error-fn))) error-fn)))))) (define fetch-location (fn (url) (let ((target (or (dom-query "[sx-boost]") (dom-query "#main-panel")))) (when target (browser-navigate url))))) (define fetch-and-restore (fn (main url headers scroll-y) (fetch-request (dict "url" url "method" "GET" "headers" headers "body" nil "signal" nil) (fn (resp-ok status get-header text) (when resp-ok (dom-set-inner-html main text) (post-swap main) (host-call (dom-window) "scrollTo" 0 scroll-y))) (fn (err) (log-warn (str "fetch-and-restore error: " err)))))) (define fetch-preload (fn (url headers cache) (fetch-request (dict "url" url "method" "GET" "headers" headers "body" nil "signal" nil) (fn (resp-ok status get-header text) (when resp-ok (preload-cache-set cache url text))) (fn (err) nil)))) (define fetch-streaming (fn (target pathname headers swap-fn) (fetch-and-restore target pathname headers 0))) (define dom-parse-html-document (fn (text) (let ((parser (host-new "DOMParser"))) (host-call parser "parseFromString" text "text/html")))) (define dom-body-inner-html (fn (doc) (host-get (host-get doc "body") "innerHTML"))) (define create-script-clone (fn (dead) (let ((doc (host-global "document")) (live (host-call doc "createElement" "script"))) (let ((attrs (host-get dead "attributes"))) (let loop ((i 0)) (when (< i (host-get attrs "length")) (let ((attr (host-call attrs "item" i))) (host-call live "setAttribute" (host-get attr "name") (host-get attr "value")) (loop (+ i 1)))))) (host-set! live "textContent" (host-get dead "textContent")) live))) (define cross-origin? (fn (url) (if (or (starts-with? url "http://") (starts-with? url "https://")) (not (starts-with? url (browser-location-origin))) false))) (define browser-scroll-to (fn (x y) (host-call (dom-window) "scrollTo" x y))) (define with-transition (fn (enabled thunk) (if (and enabled (host-get (host-global "document") "startViewTransition")) (host-call (host-global "document") "startViewTransition" (host-callback thunk)) (thunk)))) (define observe-intersection (fn (el callback once? delay) (let ((cb (host-callback (fn (entries) (for-each (fn (entry) (when (host-get entry "isIntersecting") (if delay (set-timeout (fn () (callback entry)) delay) (callback entry)) (when once? (host-call observer "unobserve" el)))) (host-call entries "forEach" (host-callback (fn (e) e)))))))) (let ((observer (host-new "IntersectionObserver" (host-callback (fn (entries) (let ((arr-len (host-get entries "length"))) (let loop ((i 0)) (when (< i arr-len) (let ((entry (host-call entries "item" i))) (when (and entry (host-get entry "isIntersecting")) (if delay (set-timeout (fn () (callback entry)) delay) (callback entry)) (when once? (host-call observer "unobserve" el)))) (loop (+ i 1)))))))))) (host-call observer "observe" el) observer)))) (define event-source-connect (fn (url el) (let ((source (host-new "EventSource" url))) (host-set! source "_sxElement" el) source))) (define event-source-listen (fn (source event-name handler) (host-call source "addEventListener" event-name (host-callback (fn (e) (handler e)))))) (define bind-boost-link (fn (el href) (dom-listen el "click" (fn (e) (when (not (event-modifier-key? e)) (prevent-default e) (when (not (dom-has-attr? el "sx-get")) (dom-set-attr el "sx-get" href)) (when (not (dom-has-attr? el "sx-push-url")) (dom-set-attr el "sx-push-url" "true")) (execute-request el nil nil)))))) (define bind-boost-form (fn (form method action) (dom-listen form "submit" (fn (e) (prevent-default e) (execute-request form nil nil))))) (define bind-client-route-click (fn (link href fallback-fn) (dom-listen link "click" (fn (e) (when (not (event-modifier-key? e)) (prevent-default e) (let ((boost-el (dom-query "[sx-boost]")) (target-sel (if boost-el (let ((attr (dom-get-attr boost-el "sx-boost"))) (if (and attr (not (= attr "true"))) attr "#main-panel")) "#main-panel"))) (if (try-client-route (url-pathname href) target-sel) (do (browser-push-state nil "" href) (browser-scroll-to 0 0)) (do (when (not (dom-has-attr? link "sx-get")) (dom-set-attr link "sx-get" href)) (when (not (dom-has-attr? link "sx-push-url")) (dom-set-attr link "sx-push-url" "true")) (execute-request link nil nil))))))))) (define sw-post-message (fn (msg) nil)) (define try-parse-json (fn (text) (json-parse text))) (define strip-component-scripts (fn (text) (let ((result text) (start-tag "")) (let loop ((s result)) (let ((start-idx (index-of s start-tag))) (if (= start-idx -1) (set! result s) (let ((after-start (+ start-idx (len start-tag))) (rest-str (slice s (+ start-idx (len start-tag))))) (let ((end-offset (index-of rest-str end-tag))) (if (= end-offset -1) (set! result s) (let ((comp-text (slice rest-str 0 end-offset)) (before (slice s 0 start-idx)) (after (slice rest-str (+ end-offset (len end-tag))))) (sx-load-components comp-text) (loop (str before after))))))))) result))) (define extract-response-css (fn (text) (let ((result text) (start-tag "")) (let loop ((s result)) (let ((start-idx (index-of s start-tag))) (if (= start-idx -1) (set! result s) (let ((rest-str (slice s (+ start-idx (len start-tag))))) (let ((end-offset (index-of rest-str end-tag))) (if (= end-offset -1) (set! result s) (let ((css-text (slice rest-str 0 end-offset)) (before (slice s 0 start-idx)) (after (slice rest-str (+ end-offset (len end-tag))))) (let ((doc (host-global "document")) (style-el (host-call doc "createElement" "style"))) (host-set! style-el "textContent" css-text) (dom-append-to-head style-el)) (loop (str before after))))))))) result))) (define sx-render (fn (text) (let ((doc (host-global "document")) (frag (host-call doc "createDocumentFragment")) (exprs (sx-parse text))) (scope-push! "sx-render-markers" true) (for-each (fn (expr) (let ((result (render-to-dom expr (get-render-env nil) nil))) (when result (dom-append frag result)))) exprs) (scope-pop! "sx-render-markers") frag))) (define sx-hydrate (fn (root) (sx-hydrate-elements (or root (dom-body))))) (define sx-process-scripts (fn (root) (let ((scripts (dom-query-all (or root (dom-body)) "script[type=\"text/sx\"]"))) (for-each (fn (s) (when (not (is-processed? s "sx-script")) (mark-processed! s "sx-script") (let ((text (host-get s "textContent"))) (when (and text (> (len text) 0)) (let ((exprs (sx-parse text))) (for-each (fn (expr) (cek-eval expr)) exprs)))))) scripts)))) (define select-from-container (fn (container selector) (if selector (let ((selected (dom-query container selector))) (if selected selected (children-to-fragment container))) (children-to-fragment container)))) (define children-to-fragment (fn (el) (let ((doc (host-global "document")) (frag (host-call doc "createDocumentFragment"))) (let loop () (let ((child (dom-first-child el))) (when child (dom-append frag child) (loop)))) frag))) (define select-html-from-doc (fn (doc selector) (if selector (let ((el (dom-query doc selector))) (if el (dom-inner-html el) (dom-body-inner-html doc))) (dom-body-inner-html doc)))) (define register-io-deps (fn (deps) nil)) (define resolve-page-data (fn (page-name params callback) nil)) (define parse-sx-data (fn (text) (if (and text (> (len text) 0)) (let ((exprs (sx-parse text))) (if (not (empty? exprs)) (first exprs) nil)) nil))) (define try-eval-content (fn (content-src env) (let ((exprs (sx-parse content-src))) (if (empty? exprs) nil (let ((frag (create-fragment))) (for-each (fn (expr) (let ((result (render-to-dom expr env nil))) (when result (dom-append frag result)))) exprs) frag))))) (define try-async-eval-content (fn (content-src env callback) (try-eval-content content-src env))) (define try-rerender-page (fn () nil)) (define execute-action (fn () nil)) (define bind-preload (fn () nil)) (define persist-offline-data (fn () nil)) (define retrieve-offline-data (fn () nil))