Add dom-visible?, json-stringify; fix Boolean coerce — 427→428
- dom-visible?: check element display != none (web/lib/dom.sx) - json-stringify: JSON.stringify via host-call (web/lib/browser.sx) - hs-coerce Boolean: use hs-falsy? for JS-compatible truthiness Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1,231 +1,254 @@
|
||||
(define-library (sx browser)
|
||||
(export browser-location-href browser-location-pathname browser-location-origin browser-same-origin? url-pathname browser-push-state browser-replace-state browser-reload browser-navigate local-storage-get local-storage-set local-storage-remove set-timeout set-interval clear-timeout clear-interval request-animation-frame fetch-request new-abort-controller controller-signal controller-abort promise-then promise-resolve promise-delayed browser-confirm browser-prompt browser-media-matches? json-parse log-info log-warn console-log now-ms schedule-idle set-cookie get-cookie)
|
||||
(define-library
|
||||
(sx browser)
|
||||
(export
|
||||
browser-location-href
|
||||
browser-location-pathname
|
||||
browser-location-origin
|
||||
browser-same-origin?
|
||||
url-pathname
|
||||
browser-push-state
|
||||
browser-replace-state
|
||||
browser-reload
|
||||
browser-navigate
|
||||
local-storage-get
|
||||
local-storage-set
|
||||
local-storage-remove
|
||||
set-timeout
|
||||
set-interval
|
||||
clear-timeout
|
||||
clear-interval
|
||||
request-animation-frame
|
||||
fetch-request
|
||||
new-abort-controller
|
||||
controller-signal
|
||||
controller-abort
|
||||
promise-then
|
||||
promise-resolve
|
||||
promise-delayed
|
||||
browser-confirm
|
||||
browser-prompt
|
||||
browser-media-matches?
|
||||
json-parse
|
||||
json-stringify
|
||||
log-info
|
||||
log-warn
|
||||
console-log
|
||||
now-ms
|
||||
schedule-idle
|
||||
set-cookie
|
||||
get-cookie)
|
||||
(begin
|
||||
|
||||
(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
|
||||
url-pathname
|
||||
(fn
|
||||
(url)
|
||||
(host-get (host-new "URL" url (browser-location-origin)) "pathname")))
|
||||
|
||||
(define
|
||||
browser-push-state
|
||||
(fn
|
||||
(url-or-state title url)
|
||||
(if
|
||||
(nil? title)
|
||||
(host-call
|
||||
(host-get (dom-window) "history")
|
||||
"pushState"
|
||||
nil
|
||||
""
|
||||
url-or-state)
|
||||
(host-call
|
||||
(host-get (dom-window) "history")
|
||||
"pushState"
|
||||
url-or-state
|
||||
title
|
||||
url))))
|
||||
|
||||
(define
|
||||
browser-replace-state
|
||||
(fn
|
||||
(url-or-state title url)
|
||||
(if
|
||||
(nil? title)
|
||||
(host-call
|
||||
(host-get (dom-window) "history")
|
||||
"replaceState"
|
||||
nil
|
||||
""
|
||||
url-or-state)
|
||||
(host-call
|
||||
(host-get (dom-window) "history")
|
||||
"replaceState"
|
||||
url-or-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)))
|
||||
|
||||
(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)))
|
||||
|
||||
(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))))
|
||||
|
||||
(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")))
|
||||
|
||||
(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))))))
|
||||
|
||||
(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")))
|
||||
|
||||
(define json-parse (fn (s) (host-call (host-global "JSON") "parse" s)))
|
||||
|
||||
(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
|
||||
console-log
|
||||
(fn (msg) (host-call (host-global "console") "log" (str "[sx] " msg))))
|
||||
|
||||
(define now-ms (fn () (host-call (host-global "Date") "now")))
|
||||
|
||||
(define
|
||||
schedule-idle
|
||||
(fn
|
||||
(f)
|
||||
(let
|
||||
((cb (host-callback (fn (_deadline) (f)))))
|
||||
(if
|
||||
(host-get (dom-window) "requestIdleCallback")
|
||||
(host-call (dom-window) "requestIdleCallback" cb)
|
||||
(set-timeout cb 0)))))
|
||||
|
||||
(define
|
||||
set-cookie
|
||||
(fn
|
||||
(name value days)
|
||||
(let
|
||||
((d (or days 365))
|
||||
(expires
|
||||
(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
|
||||
url-pathname
|
||||
(fn
|
||||
(url)
|
||||
(host-get (host-new "URL" url (browser-location-origin)) "pathname")))
|
||||
(define
|
||||
browser-push-state
|
||||
(fn
|
||||
(url-or-state title url)
|
||||
(if
|
||||
(nil? title)
|
||||
(host-call
|
||||
(host-new
|
||||
"Date"
|
||||
(+ (host-call (host-global "Date") "now") (* d 86400000)))
|
||||
"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-get (dom-window) "history")
|
||||
"pushState"
|
||||
nil
|
||||
""
|
||||
url-or-state)
|
||||
(host-call
|
||||
cookies
|
||||
"match"
|
||||
(host-new "RegExp" (str "(?:^|;\\s*)" name "=([^;]*)")))))
|
||||
(if match (host-call nil "decodeURIComponent" (host-get match 1)) nil))))
|
||||
|
||||
|
||||
))
|
||||
(host-get (dom-window) "history")
|
||||
"pushState"
|
||||
url-or-state
|
||||
title
|
||||
url))))
|
||||
(define
|
||||
browser-replace-state
|
||||
(fn
|
||||
(url-or-state title url)
|
||||
(if
|
||||
(nil? title)
|
||||
(host-call
|
||||
(host-get (dom-window) "history")
|
||||
"replaceState"
|
||||
nil
|
||||
""
|
||||
url-or-state)
|
||||
(host-call
|
||||
(host-get (dom-window) "history")
|
||||
"replaceState"
|
||||
url-or-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)))
|
||||
(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)))
|
||||
(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))))
|
||||
(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")))
|
||||
(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))))))
|
||||
(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")))
|
||||
(define json-parse (fn (s) (host-call (host-global "JSON") "parse" s)))
|
||||
(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
|
||||
console-log
|
||||
(fn
|
||||
(msg)
|
||||
(host-call (host-global "console") "log" (str "[sx] " msg))))
|
||||
(define now-ms (fn () (host-call (host-global "Date") "now")))
|
||||
(define
|
||||
schedule-idle
|
||||
(fn
|
||||
(f)
|
||||
(let
|
||||
((cb (host-callback (fn (_deadline) (f)))))
|
||||
(if
|
||||
(host-get (dom-window) "requestIdleCallback")
|
||||
(host-call (dom-window) "requestIdleCallback" cb)
|
||||
(set-timeout cb 0)))))
|
||||
(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 86400000)))
|
||||
"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))))))
|
||||
|
||||
;; Re-export to global env
|
||||
(define
|
||||
json-stringify
|
||||
(fn (v) (host-call (host-global "JSON") "stringify" v)))
|
||||
|
||||
(import (sx browser))
|
||||
|
||||
Reference in New Issue
Block a user