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)
|
(define-library
|
||||||
(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)
|
(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
|
(begin
|
||||||
|
(define
|
||||||
(define
|
browser-location-href
|
||||||
browser-location-href
|
(fn () (host-get (host-get (dom-window) "location") "href")))
|
||||||
(fn () (host-get (host-get (dom-window) "location") "href")))
|
(define
|
||||||
|
browser-location-pathname
|
||||||
(define
|
(fn () (host-get (host-get (dom-window) "location") "pathname")))
|
||||||
browser-location-pathname
|
(define
|
||||||
(fn () (host-get (host-get (dom-window) "location") "pathname")))
|
browser-location-origin
|
||||||
|
(fn () (host-get (host-get (dom-window) "location") "origin")))
|
||||||
(define
|
(define
|
||||||
browser-location-origin
|
browser-same-origin?
|
||||||
(fn () (host-get (host-get (dom-window) "location") "origin")))
|
(fn (url) (starts-with? url (browser-location-origin))))
|
||||||
|
(define
|
||||||
(define
|
url-pathname
|
||||||
browser-same-origin?
|
(fn
|
||||||
(fn (url) (starts-with? url (browser-location-origin))))
|
(url)
|
||||||
|
(host-get (host-new "URL" url (browser-location-origin)) "pathname")))
|
||||||
(define
|
(define
|
||||||
url-pathname
|
browser-push-state
|
||||||
(fn
|
(fn
|
||||||
(url)
|
(url-or-state title url)
|
||||||
(host-get (host-new "URL" url (browser-location-origin)) "pathname")))
|
(if
|
||||||
|
(nil? title)
|
||||||
(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
|
|
||||||
(host-call
|
(host-call
|
||||||
(host-new
|
(host-get (dom-window) "history")
|
||||||
"Date"
|
"pushState"
|
||||||
(+ (host-call (host-global "Date") "now") (* d 86400000)))
|
nil
|
||||||
"toUTCString")))
|
""
|
||||||
(host-set!
|
url-or-state)
|
||||||
(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
|
(host-call
|
||||||
cookies
|
(host-get (dom-window) "history")
|
||||||
"match"
|
"pushState"
|
||||||
(host-new "RegExp" (str "(?:^|;\\s*)" name "=([^;]*)")))))
|
url-or-state
|
||||||
(if match (host-call nil "decodeURIComponent" (host-get match 1)) nil))))
|
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
|
;; Re-export to global env
|
||||||
|
(define
|
||||||
|
json-stringify
|
||||||
|
(fn (v) (host-call (host-global "JSON") "stringify" v)))
|
||||||
|
|
||||||
(import (sx browser))
|
(import (sx browser))
|
||||||
|
|||||||
863
web/lib/dom.sx
863
web/lib/dom.sx
@@ -1,426 +1,457 @@
|
|||||||
(define-library (sx dom)
|
(define-library
|
||||||
(export dom-document dom-window dom-body dom-head dom-create-element create-text-node create-fragment create-comment dom-append dom-prepend dom-insert-before dom-insert-after dom-remove dom-is-active-element? dom-is-input-element? dom-is-child-of? dom-attr-list dom-remove-child dom-replace-child dom-clone dom-query dom-query-all dom-query-by-id dom-closest dom-matches? dom-get-attr dom-set-attr dom-remove-attr dom-has-attr? dom-add-class dom-remove-class dom-has-class? dom-text-content dom-set-text-content dom-inner-html dom-set-inner-html dom-outer-html dom-insert-adjacent-html dom-get-style dom-set-style dom-get-prop dom-set-prop dom-tag-name dom-node-type dom-node-name dom-id dom-parent dom-first-child dom-next-sibling dom-child-list dom-is-fragment? dom-child-nodes dom-remove-children-after dom-focus dom-parse-html dom-listen dom-add-listener dom-dispatch event-detail prevent-default stop-propagation event-modifier-key? element-value error-message dom-get-data dom-set-data dom-append-to-head set-document-title)
|
(sx dom)
|
||||||
|
(export
|
||||||
|
dom-document
|
||||||
|
dom-window
|
||||||
|
dom-body
|
||||||
|
dom-head
|
||||||
|
dom-create-element
|
||||||
|
create-text-node
|
||||||
|
create-fragment
|
||||||
|
create-comment
|
||||||
|
dom-append
|
||||||
|
dom-prepend
|
||||||
|
dom-insert-before
|
||||||
|
dom-insert-after
|
||||||
|
dom-remove
|
||||||
|
dom-is-active-element?
|
||||||
|
dom-is-input-element?
|
||||||
|
dom-is-child-of?
|
||||||
|
dom-attr-list
|
||||||
|
dom-remove-child
|
||||||
|
dom-replace-child
|
||||||
|
dom-clone
|
||||||
|
dom-query
|
||||||
|
dom-query-all
|
||||||
|
dom-query-by-id
|
||||||
|
dom-closest
|
||||||
|
dom-matches?
|
||||||
|
dom-get-attr
|
||||||
|
dom-set-attr
|
||||||
|
dom-remove-attr
|
||||||
|
dom-has-attr?
|
||||||
|
dom-add-class
|
||||||
|
dom-remove-class
|
||||||
|
dom-has-class?
|
||||||
|
dom-visible?
|
||||||
|
dom-text-content
|
||||||
|
dom-set-text-content
|
||||||
|
dom-inner-html
|
||||||
|
dom-set-inner-html
|
||||||
|
dom-outer-html
|
||||||
|
dom-insert-adjacent-html
|
||||||
|
dom-get-style
|
||||||
|
dom-set-style
|
||||||
|
dom-get-prop
|
||||||
|
dom-set-prop
|
||||||
|
dom-tag-name
|
||||||
|
dom-node-type
|
||||||
|
dom-node-name
|
||||||
|
dom-id
|
||||||
|
dom-parent
|
||||||
|
dom-first-child
|
||||||
|
dom-next-sibling
|
||||||
|
dom-child-list
|
||||||
|
dom-is-fragment?
|
||||||
|
dom-child-nodes
|
||||||
|
dom-remove-children-after
|
||||||
|
dom-focus
|
||||||
|
dom-parse-html
|
||||||
|
dom-listen
|
||||||
|
dom-add-listener
|
||||||
|
dom-dispatch
|
||||||
|
event-detail
|
||||||
|
prevent-default
|
||||||
|
stop-propagation
|
||||||
|
event-modifier-key?
|
||||||
|
element-value
|
||||||
|
error-message
|
||||||
|
dom-get-data
|
||||||
|
dom-set-data
|
||||||
|
dom-append-to-head
|
||||||
|
set-document-title)
|
||||||
(begin
|
(begin
|
||||||
|
(define dom-document (fn () (host-global "document")))
|
||||||
(define dom-document (fn () (host-global "document")))
|
(define dom-window (fn () (host-global "window")))
|
||||||
|
(define dom-body (fn () (host-get (dom-document) "body")))
|
||||||
(define dom-window (fn () (host-global "window")))
|
(define dom-head (fn () (host-get (dom-document) "head")))
|
||||||
|
(define
|
||||||
(define dom-body (fn () (host-get (dom-document) "body")))
|
dom-create-element
|
||||||
|
(fn
|
||||||
(define dom-head (fn () (host-get (dom-document) "head")))
|
(tag ns)
|
||||||
|
|
||||||
(define
|
|
||||||
dom-create-element
|
|
||||||
(fn
|
|
||||||
(tag ns)
|
|
||||||
(if
|
|
||||||
ns
|
|
||||||
(host-call (dom-document) "createElementNS" ns tag)
|
|
||||||
(host-call (dom-document) "createElement" tag))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
create-text-node
|
|
||||||
(fn (s) (host-call (dom-document) "createTextNode" s)))
|
|
||||||
|
|
||||||
(define
|
|
||||||
create-fragment
|
|
||||||
(fn () (host-call (dom-document) "createDocumentFragment")))
|
|
||||||
|
|
||||||
(define
|
|
||||||
create-comment
|
|
||||||
(fn (text) (host-call (dom-document) "createComment" (or text ""))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
dom-append
|
|
||||||
(fn
|
|
||||||
(parent child)
|
|
||||||
(when (and parent child) (host-call parent "appendChild" child))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
dom-prepend
|
|
||||||
(fn
|
|
||||||
(parent child)
|
|
||||||
(when (and parent child) (host-call parent "prepend" child))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
dom-insert-before
|
|
||||||
(fn
|
|
||||||
(parent child ref)
|
|
||||||
(when (and parent child) (host-call parent "insertBefore" child ref))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
dom-insert-after
|
|
||||||
(fn
|
|
||||||
(ref node)
|
|
||||||
"Insert node after ref in the same parent."
|
|
||||||
(let
|
|
||||||
((parent (host-get ref "parentNode"))
|
|
||||||
(next (host-get ref "nextSibling")))
|
|
||||||
(when
|
|
||||||
parent
|
|
||||||
(if
|
(if
|
||||||
next
|
ns
|
||||||
(host-call parent "insertBefore" node next)
|
(host-call (dom-document) "createElementNS" ns tag)
|
||||||
(host-call parent "appendChild" node))))))
|
(host-call (dom-document) "createElement" tag))))
|
||||||
|
(define
|
||||||
(define dom-remove (fn (el) (when el (host-call el "remove"))))
|
create-text-node
|
||||||
|
(fn (s) (host-call (dom-document) "createTextNode" s)))
|
||||||
(define
|
(define
|
||||||
dom-is-active-element?
|
create-fragment
|
||||||
(fn
|
(fn () (host-call (dom-document) "createDocumentFragment")))
|
||||||
(el)
|
(define
|
||||||
(let
|
create-comment
|
||||||
((active (host-get (dom-document) "activeElement")))
|
(fn (text) (host-call (dom-document) "createComment" (or text ""))))
|
||||||
(if (and active el) (identical? el active) false))))
|
(define
|
||||||
|
dom-append
|
||||||
(define
|
(fn
|
||||||
dom-is-input-element?
|
(parent child)
|
||||||
(fn
|
(when (and parent child) (host-call parent "appendChild" child))))
|
||||||
(el)
|
(define
|
||||||
(let
|
dom-prepend
|
||||||
((tag (upper (or (dom-tag-name el) ""))))
|
(fn
|
||||||
(or (= tag "INPUT") (= tag "TEXTAREA") (= tag "SELECT")))))
|
(parent child)
|
||||||
|
(when (and parent child) (host-call parent "prepend" child))))
|
||||||
(define
|
(define
|
||||||
dom-is-child-of?
|
dom-insert-before
|
||||||
(fn (child parent) (and child parent (host-call parent "contains" child))))
|
(fn
|
||||||
|
(parent child ref)
|
||||||
(define
|
(when (and parent child) (host-call parent "insertBefore" child ref))))
|
||||||
dom-attr-list
|
(define
|
||||||
(fn
|
dom-insert-after
|
||||||
(el)
|
(fn
|
||||||
(let
|
(ref node)
|
||||||
((attrs (host-get el "attributes")) (result (list)))
|
"Insert node after ref in the same parent."
|
||||||
(when
|
|
||||||
attrs
|
|
||||||
(let
|
(let
|
||||||
((n (host-get attrs "length")))
|
((parent (host-get ref "parentNode"))
|
||||||
(let
|
(next (host-get ref "nextSibling")))
|
||||||
loop
|
(when
|
||||||
((i 0))
|
parent
|
||||||
(when
|
(if
|
||||||
(< i n)
|
next
|
||||||
|
(host-call parent "insertBefore" node next)
|
||||||
|
(host-call parent "appendChild" node))))))
|
||||||
|
(define dom-remove (fn (el) (when el (host-call el "remove"))))
|
||||||
|
(define
|
||||||
|
dom-is-active-element?
|
||||||
|
(fn
|
||||||
|
(el)
|
||||||
|
(let
|
||||||
|
((active (host-get (dom-document) "activeElement")))
|
||||||
|
(if (and active el) (identical? el active) false))))
|
||||||
|
(define
|
||||||
|
dom-is-input-element?
|
||||||
|
(fn
|
||||||
|
(el)
|
||||||
|
(let
|
||||||
|
((tag (upper (or (dom-tag-name el) ""))))
|
||||||
|
(or (= tag "INPUT") (= tag "TEXTAREA") (= tag "SELECT")))))
|
||||||
|
(define
|
||||||
|
dom-is-child-of?
|
||||||
|
(fn
|
||||||
|
(child parent)
|
||||||
|
(and child parent (host-call parent "contains" child))))
|
||||||
|
(define
|
||||||
|
dom-attr-list
|
||||||
|
(fn
|
||||||
|
(el)
|
||||||
|
(let
|
||||||
|
((attrs (host-get el "attributes")) (result (list)))
|
||||||
|
(when
|
||||||
|
attrs
|
||||||
|
(let
|
||||||
|
((n (host-get attrs "length")))
|
||||||
(let
|
(let
|
||||||
((attr (host-call attrs "item" i)))
|
loop
|
||||||
(append!
|
((i 0))
|
||||||
result
|
(when
|
||||||
(list (host-get attr "name") (host-get attr "value"))))
|
(< i n)
|
||||||
(loop (+ i 1))))))
|
(let
|
||||||
result)))
|
((attr (host-call attrs "item" i)))
|
||||||
|
(append!
|
||||||
(define
|
result
|
||||||
dom-remove-child
|
(list (host-get attr "name") (host-get attr "value"))))
|
||||||
(fn
|
(loop (+ i 1))))))
|
||||||
(parent child)
|
result)))
|
||||||
(when (and parent child) (host-call parent "removeChild" child))))
|
(define
|
||||||
|
dom-remove-child
|
||||||
(define
|
(fn
|
||||||
dom-replace-child
|
(parent child)
|
||||||
(fn
|
(when (and parent child) (host-call parent "removeChild" child))))
|
||||||
(parent new-child old-child)
|
(define
|
||||||
(when
|
dom-replace-child
|
||||||
(and parent new-child old-child)
|
(fn
|
||||||
(host-call parent "replaceChild" new-child old-child))))
|
(parent new-child old-child)
|
||||||
|
(when
|
||||||
(define
|
(and parent new-child old-child)
|
||||||
dom-clone
|
(host-call parent "replaceChild" new-child old-child))))
|
||||||
(fn (node deep) (host-call node "cloneNode" (if (nil? deep) true deep))))
|
(define
|
||||||
|
dom-clone
|
||||||
(define
|
(fn
|
||||||
dom-query
|
(node deep)
|
||||||
(fn
|
(host-call node "cloneNode" (if (nil? deep) true deep))))
|
||||||
(root-or-sel sel)
|
(define
|
||||||
(if
|
dom-query
|
||||||
(nil? sel)
|
(fn
|
||||||
(host-call (dom-document) "querySelector" root-or-sel)
|
(root-or-sel sel)
|
||||||
(host-call root-or-sel "querySelector" sel))))
|
(if
|
||||||
|
(nil? sel)
|
||||||
(define
|
(host-call (dom-document) "querySelector" root-or-sel)
|
||||||
dom-query-all
|
(host-call root-or-sel "querySelector" sel))))
|
||||||
(fn
|
(define
|
||||||
(root sel)
|
dom-query-all
|
||||||
"Query DOM and return an SX list (not a host NodeList)."
|
(fn
|
||||||
(let
|
(root sel)
|
||||||
((node-list (if (nil? sel) (host-call (dom-document) "querySelectorAll" root) (host-call root "querySelectorAll" sel))))
|
"Query DOM and return an SX list (not a host NodeList)."
|
||||||
(if
|
|
||||||
(nil? node-list)
|
|
||||||
(list)
|
|
||||||
(let
|
(let
|
||||||
((n (host-get node-list "length")) (result (list)))
|
((node-list (if (nil? sel) (host-call (dom-document) "querySelectorAll" root) (host-call root "querySelectorAll" sel))))
|
||||||
|
(if
|
||||||
|
(nil? node-list)
|
||||||
|
(list)
|
||||||
|
(let
|
||||||
|
((n (host-get node-list "length")) (result (list)))
|
||||||
|
(let
|
||||||
|
loop
|
||||||
|
((i 0))
|
||||||
|
(when
|
||||||
|
(< i n)
|
||||||
|
(append! result (host-call node-list "item" i))
|
||||||
|
(loop (+ i 1))))
|
||||||
|
result)))))
|
||||||
|
(define
|
||||||
|
dom-query-by-id
|
||||||
|
(fn (id) (host-call (dom-document) "getElementById" id)))
|
||||||
|
(define
|
||||||
|
dom-closest
|
||||||
|
(fn (el sel) (when el (host-call el "closest" sel))))
|
||||||
|
(define
|
||||||
|
dom-matches?
|
||||||
|
(fn
|
||||||
|
(el sel)
|
||||||
|
(if
|
||||||
|
(and el (host-get el "matches"))
|
||||||
|
(host-call el "matches" sel)
|
||||||
|
false)))
|
||||||
|
(define
|
||||||
|
dom-get-attr
|
||||||
|
(fn
|
||||||
|
(el name)
|
||||||
|
(if
|
||||||
|
(and el (host-get el "getAttribute"))
|
||||||
(let
|
(let
|
||||||
loop
|
((v (host-call el "getAttribute" name)))
|
||||||
((i 0))
|
(if (nil? v) nil v))
|
||||||
(when
|
nil)))
|
||||||
(< i n)
|
(define
|
||||||
(append! result (host-call node-list "item" i))
|
dom-set-attr
|
||||||
(loop (+ i 1))))
|
(fn
|
||||||
result)))))
|
(el name val)
|
||||||
|
(when
|
||||||
(define
|
(and el (host-get el "setAttribute"))
|
||||||
dom-query-by-id
|
(host-call el "setAttribute" name val))))
|
||||||
(fn (id) (host-call (dom-document) "getElementById" id)))
|
(define
|
||||||
|
dom-remove-attr
|
||||||
(define dom-closest (fn (el sel) (when el (host-call el "closest" sel))))
|
(fn
|
||||||
|
(el name)
|
||||||
(define
|
(when
|
||||||
dom-matches?
|
(and el (host-get el "removeAttribute"))
|
||||||
(fn
|
(host-call el "removeAttribute" name))))
|
||||||
(el sel)
|
(define
|
||||||
(if (and el (host-get el "matches")) (host-call el "matches" sel) false)))
|
dom-has-attr?
|
||||||
|
(fn
|
||||||
(define
|
(el name)
|
||||||
dom-get-attr
|
(if
|
||||||
(fn
|
(and el (host-get el "hasAttribute"))
|
||||||
(el name)
|
(host-call el "hasAttribute" name)
|
||||||
(if
|
false)))
|
||||||
(and el (host-get el "getAttribute"))
|
(define
|
||||||
(let ((v (host-call el "getAttribute" name))) (if (nil? v) nil v))
|
dom-add-class
|
||||||
nil)))
|
(fn
|
||||||
|
(el cls)
|
||||||
(define
|
(when el (host-call (host-get el "classList") "add" cls))))
|
||||||
dom-set-attr
|
(define
|
||||||
(fn
|
dom-remove-class
|
||||||
(el name val)
|
(fn
|
||||||
(when
|
(el cls)
|
||||||
(and el (host-get el "setAttribute"))
|
(when el (host-call (host-get el "classList") "remove" cls))))
|
||||||
(host-call el "setAttribute" name val))))
|
(define
|
||||||
|
dom-has-class?
|
||||||
(define
|
(fn
|
||||||
dom-remove-attr
|
(el cls)
|
||||||
(fn
|
(if el (host-call (host-get el "classList") "contains" cls) false)))
|
||||||
(el name)
|
(define dom-text-content (fn (el) (host-get el "textContent")))
|
||||||
(when
|
(define
|
||||||
(and el (host-get el "removeAttribute"))
|
dom-set-text-content
|
||||||
(host-call el "removeAttribute" name))))
|
(fn (el val) (host-set! el "textContent" val)))
|
||||||
|
(define dom-inner-html (fn (el) (host-get el "innerHTML")))
|
||||||
(define
|
(define dom-set-inner-html (fn (el val) (host-set! el "innerHTML" val)))
|
||||||
dom-has-attr?
|
(define dom-outer-html (fn (el) (host-get el "outerHTML")))
|
||||||
(fn
|
(define
|
||||||
(el name)
|
dom-insert-adjacent-html
|
||||||
(if
|
(fn
|
||||||
(and el (host-get el "hasAttribute"))
|
(el position html)
|
||||||
(host-call el "hasAttribute" name)
|
(host-call el "insertAdjacentHTML" position html)))
|
||||||
false)))
|
(define
|
||||||
|
dom-get-style
|
||||||
(define
|
(fn (el prop) (host-get (host-get el "style") prop)))
|
||||||
dom-add-class
|
(define
|
||||||
(fn (el cls) (when el (host-call (host-get el "classList") "add" cls))))
|
dom-set-style
|
||||||
|
(fn
|
||||||
(define
|
(el prop val)
|
||||||
dom-remove-class
|
(host-call (host-get el "style") "setProperty" prop val)))
|
||||||
(fn
|
(define dom-get-prop (fn (el name) (host-get el name)))
|
||||||
(el cls)
|
(define dom-set-prop (fn (el name val) (host-set! el name val)))
|
||||||
(when el (host-call (host-get el "classList") "remove" cls))))
|
(define
|
||||||
|
dom-tag-name
|
||||||
(define
|
(fn (el) (if el (lower (or (host-get el "tagName") "")) "")))
|
||||||
dom-has-class?
|
(define dom-node-type (fn (el) (host-get el "nodeType")))
|
||||||
(fn
|
(define dom-node-name (fn (el) (host-get el "nodeName")))
|
||||||
(el cls)
|
(define dom-id (fn (el) (host-get el "id")))
|
||||||
(if el (host-call (host-get el "classList") "contains" cls) false)))
|
(define dom-parent (fn (el) (host-get el "parentNode")))
|
||||||
|
(define dom-first-child (fn (el) (host-get el "firstChild")))
|
||||||
(define dom-text-content (fn (el) (host-get el "textContent")))
|
(define dom-next-sibling (fn (el) (host-get el "nextSibling")))
|
||||||
|
(define
|
||||||
(define dom-set-text-content (fn (el val) (host-set! el "textContent" val)))
|
dom-child-list
|
||||||
|
(fn
|
||||||
(define dom-inner-html (fn (el) (host-get el "innerHTML")))
|
(el)
|
||||||
|
"Return child nodes as an SX list."
|
||||||
(define dom-set-inner-html (fn (el val) (host-set! el "innerHTML" val)))
|
(if
|
||||||
|
el
|
||||||
(define dom-outer-html (fn (el) (host-get el "outerHTML")))
|
|
||||||
|
|
||||||
(define
|
|
||||||
dom-insert-adjacent-html
|
|
||||||
(fn (el position html) (host-call el "insertAdjacentHTML" position html)))
|
|
||||||
|
|
||||||
(define dom-get-style (fn (el prop) (host-get (host-get el "style") prop)))
|
|
||||||
|
|
||||||
(define
|
|
||||||
dom-set-style
|
|
||||||
(fn
|
|
||||||
(el prop val)
|
|
||||||
(host-call (host-get el "style") "setProperty" prop val)))
|
|
||||||
|
|
||||||
(define dom-get-prop (fn (el name) (host-get el name)))
|
|
||||||
|
|
||||||
(define dom-set-prop (fn (el name val) (host-set! el name val)))
|
|
||||||
|
|
||||||
(define
|
|
||||||
dom-tag-name
|
|
||||||
(fn (el) (if el (lower (or (host-get el "tagName") "")) "")))
|
|
||||||
|
|
||||||
(define dom-node-type (fn (el) (host-get el "nodeType")))
|
|
||||||
|
|
||||||
(define dom-node-name (fn (el) (host-get el "nodeName")))
|
|
||||||
|
|
||||||
(define dom-id (fn (el) (host-get el "id")))
|
|
||||||
|
|
||||||
(define dom-parent (fn (el) (host-get el "parentNode")))
|
|
||||||
|
|
||||||
(define dom-first-child (fn (el) (host-get el "firstChild")))
|
|
||||||
|
|
||||||
(define dom-next-sibling (fn (el) (host-get el "nextSibling")))
|
|
||||||
|
|
||||||
(define
|
|
||||||
dom-child-list
|
|
||||||
(fn
|
|
||||||
(el)
|
|
||||||
"Return child nodes as an SX list."
|
|
||||||
(if
|
|
||||||
el
|
|
||||||
(let
|
|
||||||
((nl (host-get el "childNodes"))
|
|
||||||
(n (host-get nl "length"))
|
|
||||||
(result (list)))
|
|
||||||
(let
|
|
||||||
loop
|
|
||||||
((i 0))
|
|
||||||
(when
|
|
||||||
(< i n)
|
|
||||||
(append! result (host-call nl "item" i))
|
|
||||||
(loop (+ i 1))))
|
|
||||||
result)
|
|
||||||
(list))))
|
|
||||||
|
|
||||||
(define dom-is-fragment? (fn (el) (= (host-get el "nodeType") 11)))
|
|
||||||
|
|
||||||
(define
|
|
||||||
dom-child-nodes
|
|
||||||
(fn
|
|
||||||
(el)
|
|
||||||
"Return child nodes as an SX list."
|
|
||||||
(if
|
|
||||||
el
|
|
||||||
(let
|
|
||||||
((nl (host-get el "childNodes"))
|
|
||||||
(n (host-get nl "length"))
|
|
||||||
(result (list)))
|
|
||||||
(let
|
|
||||||
loop
|
|
||||||
((i 0))
|
|
||||||
(when
|
|
||||||
(< i n)
|
|
||||||
(append! result (host-call nl "item" i))
|
|
||||||
(loop (+ i 1))))
|
|
||||||
result)
|
|
||||||
(list))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
dom-remove-children-after
|
|
||||||
(fn
|
|
||||||
(marker)
|
|
||||||
"Remove all siblings after marker node."
|
|
||||||
(let
|
|
||||||
((parent (dom-parent marker)))
|
|
||||||
(when
|
|
||||||
parent
|
|
||||||
(let
|
|
||||||
loop
|
|
||||||
()
|
|
||||||
(let
|
(let
|
||||||
((next (dom-next-sibling marker)))
|
((nl (host-get el "childNodes"))
|
||||||
(when next (host-call parent "removeChild" next) (loop))))))))
|
(n (host-get nl "length"))
|
||||||
|
(result (list)))
|
||||||
(define dom-focus (fn (el) (when el (host-call el "focus"))))
|
(let
|
||||||
|
loop
|
||||||
(define
|
((i 0))
|
||||||
dom-parse-html
|
(when
|
||||||
(fn
|
(< i n)
|
||||||
(html)
|
(append! result (host-call nl "item" i))
|
||||||
(let
|
(loop (+ i 1))))
|
||||||
((parser (host-new "DOMParser"))
|
result)
|
||||||
(doc (host-call parser "parseFromString" html "text/html")))
|
(list))))
|
||||||
(host-get (host-get doc "body") "childNodes"))))
|
(define dom-is-fragment? (fn (el) (= (host-get el "nodeType") 11)))
|
||||||
|
(define
|
||||||
(define
|
dom-child-nodes
|
||||||
dom-listen
|
(fn
|
||||||
(fn
|
(el)
|
||||||
(el event-name handler)
|
"Return child nodes as an SX list."
|
||||||
(let
|
(if
|
||||||
((cb (host-callback handler)))
|
el
|
||||||
(host-call el "addEventListener" event-name cb)
|
(let
|
||||||
(fn () (host-call el "removeEventListener" event-name cb)))))
|
((nl (host-get el "childNodes"))
|
||||||
|
(n (host-get nl "length"))
|
||||||
(define
|
(result (list)))
|
||||||
dom-add-listener
|
(let
|
||||||
(fn
|
loop
|
||||||
(el event-name handler opts)
|
((i 0))
|
||||||
(let
|
(when
|
||||||
((cb (host-callback handler)))
|
(< i n)
|
||||||
(if
|
(append! result (host-call nl "item" i))
|
||||||
opts
|
(loop (+ i 1))))
|
||||||
(host-call el "addEventListener" event-name cb opts)
|
result)
|
||||||
(host-call el "addEventListener" event-name cb))
|
(list))))
|
||||||
(fn () (host-call el "removeEventListener" event-name cb)))))
|
(define
|
||||||
|
dom-remove-children-after
|
||||||
(define
|
(fn
|
||||||
dom-dispatch
|
(marker)
|
||||||
(fn
|
"Remove all siblings after marker node."
|
||||||
(el event-name detail)
|
(let
|
||||||
(let
|
((parent (dom-parent marker)))
|
||||||
((evt (host-new "CustomEvent" event-name (dict "detail" detail "bubbles" true))))
|
(when
|
||||||
(host-call el "dispatchEvent" evt))))
|
parent
|
||||||
|
(let
|
||||||
(define event-detail (fn (evt) (host-get evt "detail")))
|
loop
|
||||||
|
()
|
||||||
(define prevent-default (fn (e) (when e (host-call e "preventDefault"))))
|
(let
|
||||||
|
((next (dom-next-sibling marker)))
|
||||||
(define stop-propagation (fn (e) (when e (host-call e "stopPropagation"))))
|
(when next (host-call parent "removeChild" next) (loop))))))))
|
||||||
|
(define dom-focus (fn (el) (when el (host-call el "focus"))))
|
||||||
(define
|
(define
|
||||||
event-modifier-key?
|
dom-parse-html
|
||||||
(fn
|
(fn
|
||||||
(e)
|
(html)
|
||||||
(and
|
(let
|
||||||
e
|
((parser (host-new "DOMParser"))
|
||||||
(or
|
(doc (host-call parser "parseFromString" html "text/html")))
|
||||||
(host-get e "ctrlKey")
|
(host-get (host-get doc "body") "childNodes"))))
|
||||||
(host-get e "metaKey")
|
(define
|
||||||
(host-get e "shiftKey")
|
dom-listen
|
||||||
(host-get e "altKey")))))
|
(fn
|
||||||
|
(el event-name handler)
|
||||||
(define
|
(let
|
||||||
element-value
|
((cb (host-callback handler)))
|
||||||
(fn
|
(host-call el "addEventListener" event-name cb)
|
||||||
(el)
|
(fn () (host-call el "removeEventListener" event-name cb)))))
|
||||||
(if
|
(define
|
||||||
(and el (not (nil? (host-get el "value"))))
|
dom-add-listener
|
||||||
(host-get el "value")
|
(fn
|
||||||
nil)))
|
(el event-name handler opts)
|
||||||
|
(let
|
||||||
(define
|
((cb (host-callback handler)))
|
||||||
error-message
|
(if
|
||||||
(fn
|
opts
|
||||||
(e)
|
(host-call el "addEventListener" event-name cb opts)
|
||||||
(if (and e (host-get e "message")) (host-get e "message") (str e))))
|
(host-call el "addEventListener" event-name cb))
|
||||||
|
(fn () (host-call el "removeEventListener" event-name cb)))))
|
||||||
(define
|
(define
|
||||||
dom-get-data
|
dom-dispatch
|
||||||
(fn
|
(fn
|
||||||
(el key)
|
(el event-name detail)
|
||||||
(let
|
(let
|
||||||
((store (host-get el "__sx_data")))
|
((evt (host-new "CustomEvent" event-name (dict "detail" detail "bubbles" true))))
|
||||||
(if store (host-get store key) nil))))
|
(host-call el "dispatchEvent" evt))))
|
||||||
|
(define event-detail (fn (evt) (host-get evt "detail")))
|
||||||
(define
|
(define
|
||||||
dom-set-data
|
prevent-default
|
||||||
(fn
|
(fn (e) (when e (host-call e "preventDefault"))))
|
||||||
(el key val)
|
(define
|
||||||
(when
|
stop-propagation
|
||||||
(not (host-get el "__sx_data"))
|
(fn (e) (when e (host-call e "stopPropagation"))))
|
||||||
(host-set! el "__sx_data" (dict)))
|
(define
|
||||||
(host-set! (host-get el "__sx_data") key val)))
|
event-modifier-key?
|
||||||
|
(fn
|
||||||
(define
|
(e)
|
||||||
dom-append-to-head
|
(and
|
||||||
(fn (el) (when (dom-head) (host-call (dom-head) "appendChild" el))))
|
e
|
||||||
|
(or
|
||||||
(define
|
(host-get e "ctrlKey")
|
||||||
set-document-title
|
(host-get e "metaKey")
|
||||||
(fn (title) (host-set! (dom-document) "title" title)))
|
(host-get e "shiftKey")
|
||||||
|
(host-get e "altKey")))))
|
||||||
|
(define
|
||||||
))
|
element-value
|
||||||
|
(fn
|
||||||
|
(el)
|
||||||
|
(if
|
||||||
|
(and el (not (nil? (host-get el "value"))))
|
||||||
|
(host-get el "value")
|
||||||
|
nil)))
|
||||||
|
(define
|
||||||
|
error-message
|
||||||
|
(fn
|
||||||
|
(e)
|
||||||
|
(if (and e (host-get e "message")) (host-get e "message") (str e))))
|
||||||
|
(define
|
||||||
|
dom-get-data
|
||||||
|
(fn
|
||||||
|
(el key)
|
||||||
|
(let
|
||||||
|
((store (host-get el "__sx_data")))
|
||||||
|
(if store (host-get store key) nil))))
|
||||||
|
(define
|
||||||
|
dom-set-data
|
||||||
|
(fn
|
||||||
|
(el key val)
|
||||||
|
(when
|
||||||
|
(not (host-get el "__sx_data"))
|
||||||
|
(host-set! el "__sx_data" (dict)))
|
||||||
|
(host-set! (host-get el "__sx_data") key val)))
|
||||||
|
(define
|
||||||
|
dom-append-to-head
|
||||||
|
(fn (el) (when (dom-head) (host-call (dom-head) "appendChild" el))))
|
||||||
|
(define
|
||||||
|
set-document-title
|
||||||
|
(fn (title) (host-set! (dom-document) "title" title)))))
|
||||||
|
|
||||||
;; Re-export to global env
|
;; Re-export to global env
|
||||||
|
(define
|
||||||
|
dom-visible?
|
||||||
|
(fn
|
||||||
|
(el)
|
||||||
|
(if
|
||||||
|
el
|
||||||
|
(not (= (host-get (host-get el "style") "display") "none"))
|
||||||
|
false)))
|
||||||
|
|
||||||
(import (sx dom))
|
(import (sx dom))
|
||||||
|
|||||||
Reference in New Issue
Block a user