giles
bc7da977a0
Move DOM/browser operations to SX library wrappers (dom.sx, browser.sx) using the 8 FFI primitives, eliminating duplicate native implementations. Add scope-emitted transpiler rename — fixes 199 pre-existing test failures. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
212 lines
6.2 KiB
Plaintext
212 lines
6.2 KiB
Plaintext
;; ==========================================================================
|
|
;; browser.sx — Browser API library functions
|
|
;;
|
|
;; Location, history, storage, cookies, timers, fetch — all expressed
|
|
;; using the host FFI primitives. Library functions, not primitives.
|
|
;; ==========================================================================
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Location & navigation
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define browser-location-href
|
|
(fn ()
|
|
(host-get (host-get (dom-window) "location") "href")))
|
|
|
|
(define browser-location-pathname
|
|
(fn ()
|
|
(host-get (host-get (dom-window) "location") "pathname")))
|
|
|
|
(define browser-location-origin
|
|
(fn ()
|
|
(host-get (host-get (dom-window) "location") "origin")))
|
|
|
|
(define browser-same-origin?
|
|
(fn (url)
|
|
(starts-with? url (browser-location-origin))))
|
|
|
|
(define browser-push-state
|
|
(fn (state title url)
|
|
(host-call (host-get (dom-window) "history") "pushState" state title url)))
|
|
|
|
(define browser-replace-state
|
|
(fn (state title url)
|
|
(host-call (host-get (dom-window) "history") "replaceState" state title url)))
|
|
|
|
(define browser-reload
|
|
(fn ()
|
|
(host-call (host-get (dom-window) "location") "reload")))
|
|
|
|
(define browser-navigate
|
|
(fn (url)
|
|
(host-set! (host-get (dom-window) "location") "href" url)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Storage
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define local-storage-get
|
|
(fn (key)
|
|
(host-call (host-get (dom-window) "localStorage") "getItem" key)))
|
|
|
|
(define local-storage-set
|
|
(fn (key val)
|
|
(host-call (host-get (dom-window) "localStorage") "setItem" key val)))
|
|
|
|
(define local-storage-remove
|
|
(fn (key)
|
|
(host-call (host-get (dom-window) "localStorage") "removeItem" key)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Timers
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define set-timeout
|
|
(fn (fn-val ms)
|
|
(host-call (dom-window) "setTimeout" (host-callback fn-val) ms)))
|
|
|
|
(define set-interval
|
|
(fn (fn-val ms)
|
|
(host-call (dom-window) "setInterval" (host-callback fn-val) ms)))
|
|
|
|
(define clear-timeout
|
|
(fn (id)
|
|
(host-call (dom-window) "clearTimeout" id)))
|
|
|
|
(define clear-interval
|
|
(fn (id)
|
|
(host-call (dom-window) "clearInterval" id)))
|
|
|
|
(define request-animation-frame
|
|
(fn (fn-val)
|
|
(host-call (dom-window) "requestAnimationFrame" (host-callback fn-val))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Fetch
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define fetch-request
|
|
(fn (url opts)
|
|
(host-call (dom-window) "fetch" url opts)))
|
|
|
|
(define new-abort-controller
|
|
(fn ()
|
|
(host-new "AbortController")))
|
|
|
|
(define controller-signal
|
|
(fn (controller)
|
|
(host-get controller "signal")))
|
|
|
|
(define controller-abort
|
|
(fn (controller)
|
|
(host-call controller "abort")))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Promises
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define promise-then
|
|
(fn (p on-resolve on-reject)
|
|
(let ((cb-resolve (host-callback on-resolve))
|
|
(cb-reject (if on-reject (host-callback on-reject) nil)))
|
|
(if cb-reject
|
|
(host-call (host-call p "then" cb-resolve) "catch" cb-reject)
|
|
(host-call p "then" cb-resolve)))))
|
|
|
|
(define promise-resolve
|
|
(fn (val)
|
|
(host-call (host-global "Promise") "resolve" val)))
|
|
|
|
(define promise-delayed
|
|
(fn (ms val)
|
|
(host-new "Promise" (host-callback
|
|
(fn (resolve)
|
|
(set-timeout (fn () (host-call resolve "call" nil val)) ms))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Dialogs & media
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define browser-confirm
|
|
(fn (msg) (host-call (dom-window) "confirm" msg)))
|
|
|
|
(define browser-prompt
|
|
(fn (msg default)
|
|
(host-call (dom-window) "prompt" msg default)))
|
|
|
|
(define browser-media-matches?
|
|
(fn (query)
|
|
(host-get (host-call (dom-window) "matchMedia" query) "matches")))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; JSON
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define json-parse
|
|
(fn (s)
|
|
(host-call (host-global "JSON") "parse" s)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Console
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define log-info
|
|
(fn (msg)
|
|
(host-call (host-global "console") "log" (str "[sx] " msg))))
|
|
|
|
(define log-warn
|
|
(fn (msg)
|
|
(host-call (host-global "console") "warn" (str "[sx] " msg))))
|
|
|
|
(define now-ms
|
|
(fn ()
|
|
(host-call (host-global "Date") "now")))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Scheduling
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define schedule-idle
|
|
(fn (f)
|
|
(let ((cb (host-callback f)))
|
|
(if (host-get (dom-window) "requestIdleCallback")
|
|
(host-call (dom-window) "requestIdleCallback" cb)
|
|
(set-timeout cb 0)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Cookies
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define set-cookie
|
|
(fn (name value days)
|
|
(let ((d (or days 365))
|
|
(expires (host-call
|
|
(host-new "Date"
|
|
(+ (host-call (host-global "Date") "now")
|
|
(* d 864e5)))
|
|
"toUTCString")))
|
|
(host-set! (dom-document) "cookie"
|
|
(str name "="
|
|
(host-call nil "encodeURIComponent" value)
|
|
";expires=" expires ";path=/;SameSite=Lax")))))
|
|
|
|
(define get-cookie
|
|
(fn (name)
|
|
(let ((cookies (host-get (dom-document) "cookie"))
|
|
(match (host-call cookies "match"
|
|
(host-new "RegExp"
|
|
(str "(?:^|;\\s*)" name "=([^;]*)")))))
|
|
(if match
|
|
(host-call nil "decodeURIComponent" (host-get match 1))
|
|
nil))))
|