coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add dom-visible?, json-stringify; fix Boolean coerce — 427→428

Browse Source 
- 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:
giles
2026-04-13 10:45:59 +00:00
parent eb060ef32c
commit 49afef6eef
2 changed files with 695 additions and 641 deletions
Download Patch File Download Diff File Expand all files Collapse all files

183
web/lib/browser.sx
View File

@@ -1,30 +1,61 @@
(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
(define
browser-location-pathname browser-location-pathname
(fn () (host-get (host-get (dom-window) "location") "pathname"))) (fn () (host-get (host-get (dom-window) "location") "pathname")))
(define
(define
browser-location-origin browser-location-origin
(fn () (host-get (host-get (dom-window) "location") "origin"))) (fn () (host-get (host-get (dom-window) "location") "origin")))
(define
(define
browser-same-origin? browser-same-origin?
(fn (url) (starts-with? url (browser-location-origin)))) (fn (url) (starts-with? url (browser-location-origin))))
(define
(define
url-pathname url-pathname
(fn (fn
(url) (url)
(host-get (host-new "URL" url (browser-location-origin)) "pathname"))) (host-get (host-new "URL" url (browser-location-origin)) "pathname")))
(define
(define
browser-push-state browser-push-state
(fn (fn
(url-or-state title url) (url-or-state title url)
@@ -42,8 +73,7 @@
url-or-state url-or-state
title title
url)))) url))))
(define
(define
browser-replace-state browser-replace-state
(fn (fn
(url-or-state title url) (url-or-state title url)
@@ -61,68 +91,62 @@
url-or-state url-or-state
title title
url)))) url))))
(define
(define
browser-reload browser-reload
(fn () (host-call (host-get (dom-window) "location") "reload"))) (fn () (host-call (host-get (dom-window) "location") "reload")))
(define
(define
browser-navigate browser-navigate
(fn (url) (host-set! (host-get (dom-window) "location") "href" url))) (fn (url) (host-set! (host-get (dom-window) "location") "href" url)))
(define
(define
local-storage-get local-storage-get
(fn (fn
(key) (key)
(host-call (host-get (dom-window) "localStorage") "getItem" key))) (host-call (host-get (dom-window) "localStorage") "getItem" key)))
(define
(define
local-storage-set local-storage-set
(fn (fn
(key val) (key val)
(host-call (host-get (dom-window) "localStorage") "setItem" key val))) (host-call (host-get (dom-window) "localStorage") "setItem" key val)))
(define
(define
local-storage-remove local-storage-remove
(fn (fn
(key) (key)
(host-call (host-get (dom-window) "localStorage") "removeItem" key))) (host-call (host-get (dom-window) "localStorage") "removeItem" key)))
(define
(define
set-timeout set-timeout
(fn (fn
(fn-val ms) (fn-val ms)
(host-call (dom-window) "setTimeout" (host-callback fn-val) ms))) (host-call (dom-window) "setTimeout" (host-callback fn-val) ms)))
(define
(define
set-interval set-interval
(fn (fn
(fn-val ms) (fn-val ms)
(host-call (dom-window) "setInterval" (host-callback fn-val) ms))) (host-call (dom-window) "setInterval" (host-callback fn-val) ms)))
(define
(define clear-timeout (fn (id) (host-call (dom-window) "clearTimeout" id))) clear-timeout
(fn (id) (host-call (dom-window) "clearTimeout" id)))
(define (define
clear-interval clear-interval
(fn (id) (host-call (dom-window) "clearInterval" id))) (fn (id) (host-call (dom-window) "clearInterval" id)))
(define
(define
request-animation-frame request-animation-frame
(fn (fn
(fn-val) (fn-val)
(host-call (dom-window) "requestAnimationFrame" (host-callback fn-val)))) (host-call
(dom-window)
(define "requestAnimationFrame"
(host-callback fn-val))))
(define
fetch-request fetch-request
(fn (url opts) (host-call (dom-window) "fetch" url opts))) (fn (url opts) (host-call (dom-window) "fetch" url opts)))
(define new-abort-controller (fn () (host-new "AbortController")))
(define new-abort-controller (fn () (host-new "AbortController"))) (define
controller-signal
(define controller-signal (fn (controller) (host-get controller "signal"))) (fn (controller) (host-get controller "signal")))
(define
(define controller-abort (fn (controller) (host-call controller "abort"))) controller-abort
(fn (controller) (host-call controller "abort")))
(define (define
promise-then promise-then
(fn (fn
(p on-resolve on-reject) (p on-resolve on-reject)
@@ -133,12 +157,10 @@
cb-reject cb-reject
(host-call (host-call p "then" cb-resolve) "catch" cb-reject) (host-call (host-call p "then" cb-resolve) "catch" cb-reject)
(host-call p "then" cb-resolve))))) (host-call p "then" cb-resolve)))))
(define
(define
promise-resolve promise-resolve
(fn (val) (host-call (host-global "Promise") "resolve" val))) (fn (val) (host-call (host-global "Promise") "resolve" val)))
(define
(define
promise-delayed promise-delayed
(fn (fn
(ms val) (ms val)
@@ -148,36 +170,35 @@
(fn (fn
(resolve) (resolve)
(set-timeout (fn () (host-call resolve "call" nil val)) ms)))))) (set-timeout (fn () (host-call resolve "call" nil val)) ms))))))
(define
(define browser-confirm (fn (msg) (host-call (dom-window) "confirm" msg))) browser-confirm
(fn (msg) (host-call (dom-window) "confirm" msg)))
(define (define
browser-prompt browser-prompt
(fn (msg default) (host-call (dom-window) "prompt" msg default))) (fn (msg default) (host-call (dom-window) "prompt" msg default)))
(define
(define
browser-media-matches? browser-media-matches?
(fn (fn
(query) (query)
(host-get (host-call (dom-window) "matchMedia" query) "matches"))) (host-get (host-call (dom-window) "matchMedia" query) "matches")))
(define json-parse (fn (s) (host-call (host-global "JSON") "parse" s)))
(define json-parse (fn (s) (host-call (host-global "JSON") "parse" s))) (define
(define
log-info log-info
(fn (msg) (host-call (host-global "console") "log" (str "[sx] " msg)))) (fn
(msg)
(define (host-call (host-global "console") "log" (str "[sx] " msg))))
(define
log-warn log-warn
(fn (msg) (host-call (host-global "console") "warn" (str "[sx] " msg)))) (fn
(msg)
(define (host-call (host-global "console") "warn" (str "[sx] " msg))))
(define
console-log console-log
(fn (msg) (host-call (host-global "console") "log" (str "[sx] " msg)))) (fn
(msg)
(define now-ms (fn () (host-call (host-global "Date") "now"))) (host-call (host-global "console") "log" (str "[sx] " msg))))
(define now-ms (fn () (host-call (host-global "Date") "now")))
(define (define
schedule-idle schedule-idle
(fn (fn
(f) (f)
@@ -187,8 +208,7 @@
(host-get (dom-window) "requestIdleCallback") (host-get (dom-window) "requestIdleCallback")
(host-call (dom-window) "requestIdleCallback" cb) (host-call (dom-window) "requestIdleCallback" cb)
(set-timeout cb 0))))) (set-timeout cb 0)))))
(define
(define
set-cookie set-cookie
(fn (fn
(name value days) (name value days)
@@ -210,8 +230,7 @@
";expires=" ";expires="
expires expires
";path=/;SameSite=Lax"))))) ";path=/;SameSite=Lax")))))
(define
(define
get-cookie get-cookie
(fn (fn
(name) (name)
@@ -222,10 +241,14 @@
cookies cookies
"match" "match"
(host-new "RegExp" (str "(?:^|;\\s*)" name "=([^;]*)"))))) (host-new "RegExp" (str "(?:^|;\\s*)" name "=([^;]*)")))))
(if match (host-call nil "decodeURIComponent" (host-get match 1)) nil)))) (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))

327
web/lib/dom.sx
View File

@@ -1,16 +1,81 @@
(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")))
(define dom-head (fn () (host-get (dom-document) "head")))
(define
dom-create-element dom-create-element
(fn (fn
(tag ns) (tag ns)
@@ -18,38 +83,31 @@
ns ns
(host-call (dom-document) "createElementNS" ns tag) (host-call (dom-document) "createElementNS" ns tag)
(host-call (dom-document) "createElement" tag)))) (host-call (dom-document) "createElement" tag))))
(define
(define
create-text-node create-text-node
(fn (s) (host-call (dom-document) "createTextNode" s))) (fn (s) (host-call (dom-document) "createTextNode" s)))
(define
(define
create-fragment create-fragment
(fn () (host-call (dom-document) "createDocumentFragment"))) (fn () (host-call (dom-document) "createDocumentFragment")))
(define
(define
create-comment create-comment
(fn (text) (host-call (dom-document) "createComment" (or text "")))) (fn (text) (host-call (dom-document) "createComment" (or text ""))))
(define
(define
dom-append dom-append
(fn (fn
(parent child) (parent child)
(when (and parent child) (host-call parent "appendChild" child)))) (when (and parent child) (host-call parent "appendChild" child))))
(define
(define
dom-prepend dom-prepend
(fn (fn
(parent child) (parent child)
(when (and parent child) (host-call parent "prepend" child)))) (when (and parent child) (host-call parent "prepend" child))))
(define
(define
dom-insert-before dom-insert-before
(fn (fn
(parent child ref) (parent child ref)
(when (and parent child) (host-call parent "insertBefore" child ref)))) (when (and parent child) (host-call parent "insertBefore" child ref))))
(define
(define
dom-insert-after dom-insert-after
(fn (fn
(ref node) (ref node)
@@ -63,30 +121,27 @@
next next
(host-call parent "insertBefore" node next) (host-call parent "insertBefore" node next)
(host-call parent "appendChild" node)))))) (host-call parent "appendChild" node))))))
(define dom-remove (fn (el) (when el (host-call el "remove"))))
(define dom-remove (fn (el) (when el (host-call el "remove")))) (define
(define
dom-is-active-element? dom-is-active-element?
(fn (fn
(el) (el)
(let (let
((active (host-get (dom-document) "activeElement"))) ((active (host-get (dom-document) "activeElement")))
(if (and active el) (identical? el active) false)))) (if (and active el) (identical? el active) false))))
(define
(define
dom-is-input-element? dom-is-input-element?
(fn (fn
(el) (el)
(let (let
((tag (upper (or (dom-tag-name el) "")))) ((tag (upper (or (dom-tag-name el) ""))))
(or (= tag "INPUT") (= tag "TEXTAREA") (= tag "SELECT"))))) (or (= tag "INPUT") (= tag "TEXTAREA") (= tag "SELECT")))))
(define
(define
dom-is-child-of? dom-is-child-of?
(fn (child parent) (and child parent (host-call parent "contains" child)))) (fn
(child parent)
(define (and child parent (host-call parent "contains" child))))
(define
dom-attr-list dom-attr-list
(fn (fn
(el) (el)
@@ -108,26 +163,24 @@
(list (host-get attr "name") (host-get attr "value")))) (list (host-get attr "name") (host-get attr "value"))))
(loop (+ i 1)))))) (loop (+ i 1))))))
result))) result)))
(define
(define
dom-remove-child dom-remove-child
(fn (fn
(parent child) (parent child)
(when (and parent child) (host-call parent "removeChild" child)))) (when (and parent child) (host-call parent "removeChild" child))))
(define
(define
dom-replace-child dom-replace-child
(fn (fn
(parent new-child old-child) (parent new-child old-child)
(when (when
(and parent new-child old-child) (and parent new-child old-child)
(host-call parent "replaceChild" new-child old-child)))) (host-call parent "replaceChild" new-child old-child))))
(define
(define
dom-clone dom-clone
(fn (node deep) (host-call node "cloneNode" (if (nil? deep) true deep)))) (fn
(node deep)
(define (host-call node "cloneNode" (if (nil? deep) true deep))))
(define
dom-query dom-query
(fn (fn
(root-or-sel sel) (root-or-sel sel)
@@ -135,8 +188,7 @@
(nil? sel) (nil? sel)
(host-call (dom-document) "querySelector" root-or-sel) (host-call (dom-document) "querySelector" root-or-sel)
(host-call root-or-sel "querySelector" sel)))) (host-call root-or-sel "querySelector" sel))))
(define
(define
dom-query-all dom-query-all
(fn (fn
(root sel) (root sel)
@@ -156,45 +208,45 @@
(append! result (host-call node-list "item" i)) (append! result (host-call node-list "item" i))
(loop (+ i 1)))) (loop (+ i 1))))
result))))) result)))))
(define
(define
dom-query-by-id dom-query-by-id
(fn (id) (host-call (dom-document) "getElementById" id))) (fn (id) (host-call (dom-document) "getElementById" id)))
(define
(define dom-closest (fn (el sel) (when el (host-call el "closest" sel)))) dom-closest
(fn (el sel) (when el (host-call el "closest" sel))))
(define (define
dom-matches? dom-matches?
(fn (fn
(el sel) (el sel)
(if (and el (host-get el "matches")) (host-call el "matches" sel) false))) (if
(and el (host-get el "matches"))
(define (host-call el "matches" sel)
false)))
(define
dom-get-attr dom-get-attr
(fn (fn
(el name) (el name)
(if (if
(and el (host-get el "getAttribute")) (and el (host-get el "getAttribute"))
(let ((v (host-call el "getAttribute" name))) (if (nil? v) nil v)) (let
((v (host-call el "getAttribute" name)))
(if (nil? v) nil v))
nil))) nil)))
(define
(define
dom-set-attr dom-set-attr
(fn (fn
(el name val) (el name val)
(when (when
(and el (host-get el "setAttribute")) (and el (host-get el "setAttribute"))
(host-call el "setAttribute" name val)))) (host-call el "setAttribute" name val))))
(define
(define
dom-remove-attr dom-remove-attr
(fn (fn
(el name) (el name)
(when (when
(and el (host-get el "removeAttribute")) (and el (host-get el "removeAttribute"))
(host-call el "removeAttribute" name)))) (host-call el "removeAttribute" name))))
(define
(define
dom-has-attr? dom-has-attr?
(fn (fn
(el name) (el name)
@@ -202,66 +254,53 @@
(and el (host-get el "hasAttribute")) (and el (host-get el "hasAttribute"))
(host-call el "hasAttribute" name) (host-call el "hasAttribute" name)
false))) false)))
(define
(define
dom-add-class dom-add-class
(fn (el cls) (when el (host-call (host-get el "classList") "add" cls)))) (fn
(el cls)
(define (when el (host-call (host-get el "classList") "add" cls))))
(define
dom-remove-class dom-remove-class
(fn (fn
(el cls) (el cls)
(when el (host-call (host-get el "classList") "remove" cls)))) (when el (host-call (host-get el "classList") "remove" cls))))
(define
(define
dom-has-class? dom-has-class?
(fn (fn
(el cls) (el cls)
(if el (host-call (host-get el "classList") "contains" cls) false))) (if el (host-call (host-get el "classList") "contains" cls) false)))
(define dom-text-content (fn (el) (host-get el "textContent")))
(define dom-text-content (fn (el) (host-get el "textContent"))) (define
dom-set-text-content
(define dom-set-text-content (fn (el val) (host-set! el "textContent" val))) (fn (el val) (host-set! el "textContent" val)))
(define dom-inner-html (fn (el) (host-get el "innerHTML")))
(define dom-inner-html (fn (el) (host-get el "innerHTML"))) (define dom-set-inner-html (fn (el val) (host-set! el "innerHTML" val)))
(define dom-outer-html (fn (el) (host-get el "outerHTML")))
(define dom-set-inner-html (fn (el val) (host-set! el "innerHTML" val))) (define
(define dom-outer-html (fn (el) (host-get el "outerHTML")))
(define
dom-insert-adjacent-html dom-insert-adjacent-html
(fn (el position html) (host-call el "insertAdjacentHTML" position html))) (fn
(el position html)
(define dom-get-style (fn (el prop) (host-get (host-get el "style") prop))) (host-call el "insertAdjacentHTML" position html)))
(define
(define dom-get-style
(fn (el prop) (host-get (host-get el "style") prop)))
(define
dom-set-style dom-set-style
(fn (fn
(el prop val) (el prop val)
(host-call (host-get el "style") "setProperty" prop val))) (host-call (host-get el "style") "setProperty" prop val)))
(define dom-get-prop (fn (el name) (host-get el name)))
(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
(define dom-set-prop (fn (el name val) (host-set! el name val)))
(define
dom-tag-name dom-tag-name
(fn (el) (if el (lower (or (host-get el "tagName") "")) ""))) (fn (el) (if el (lower (or (host-get el "tagName") "")) "")))
(define dom-node-type (fn (el) (host-get el "nodeType")))
(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-node-name (fn (el) (host-get el "nodeName"))) (define dom-parent (fn (el) (host-get el "parentNode")))
(define dom-first-child (fn (el) (host-get el "firstChild")))
(define dom-id (fn (el) (host-get el "id"))) (define dom-next-sibling (fn (el) (host-get el "nextSibling")))
(define
(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 dom-child-list
(fn (fn
(el) (el)
@@ -281,10 +320,8 @@
(loop (+ i 1)))) (loop (+ i 1))))
result) result)
(list)))) (list))))
(define dom-is-fragment? (fn (el) (= (host-get el "nodeType") 11)))
(define dom-is-fragment? (fn (el) (= (host-get el "nodeType") 11))) (define
(define
dom-child-nodes dom-child-nodes
(fn (fn
(el) (el)
@@ -304,8 +341,7 @@
(loop (+ i 1)))) (loop (+ i 1))))
result) result)
(list)))) (list))))
(define
(define
dom-remove-children-after dom-remove-children-after
(fn (fn
(marker) (marker)
@@ -320,10 +356,8 @@
(let (let
((next (dom-next-sibling marker))) ((next (dom-next-sibling marker)))
(when next (host-call parent "removeChild" next) (loop)))))))) (when next (host-call parent "removeChild" next) (loop))))))))
(define dom-focus (fn (el) (when el (host-call el "focus"))))
(define dom-focus (fn (el) (when el (host-call el "focus")))) (define
(define
dom-parse-html dom-parse-html
(fn (fn
(html) (html)
@@ -331,8 +365,7 @@
((parser (host-new "DOMParser")) ((parser (host-new "DOMParser"))
(doc (host-call parser "parseFromString" html "text/html"))) (doc (host-call parser "parseFromString" html "text/html")))
(host-get (host-get doc "body") "childNodes")))) (host-get (host-get doc "body") "childNodes"))))
(define
(define
dom-listen dom-listen
(fn (fn
(el event-name handler) (el event-name handler)
@@ -340,8 +373,7 @@
((cb (host-callback handler))) ((cb (host-callback handler)))
(host-call el "addEventListener" event-name cb) (host-call el "addEventListener" event-name cb)
(fn () (host-call el "removeEventListener" event-name cb))))) (fn () (host-call el "removeEventListener" event-name cb)))))
(define
(define
dom-add-listener dom-add-listener
(fn (fn
(el event-name handler opts) (el event-name handler opts)
@@ -352,22 +384,21 @@
(host-call el "addEventListener" event-name cb opts) (host-call el "addEventListener" event-name cb opts)
(host-call el "addEventListener" event-name cb)) (host-call el "addEventListener" event-name cb))
(fn () (host-call el "removeEventListener" event-name cb))))) (fn () (host-call el "removeEventListener" event-name cb)))))
(define
(define
dom-dispatch dom-dispatch
(fn (fn
(el event-name detail) (el event-name detail)
(let (let
((evt (host-new "CustomEvent" event-name (dict "detail" detail "bubbles" true)))) ((evt (host-new "CustomEvent" event-name (dict "detail" detail "bubbles" true))))
(host-call el "dispatchEvent" evt)))) (host-call el "dispatchEvent" evt))))
(define event-detail (fn (evt) (host-get evt "detail")))
(define event-detail (fn (evt) (host-get evt "detail"))) (define
prevent-default
(define prevent-default (fn (e) (when e (host-call e "preventDefault")))) (fn (e) (when e (host-call e "preventDefault"))))
(define
(define stop-propagation (fn (e) (when e (host-call e "stopPropagation")))) stop-propagation
(fn (e) (when e (host-call e "stopPropagation"))))
(define (define
event-modifier-key? event-modifier-key?
(fn (fn
(e) (e)
@@ -378,8 +409,7 @@
(host-get e "metaKey") (host-get e "metaKey")
(host-get e "shiftKey") (host-get e "shiftKey")
(host-get e "altKey"))))) (host-get e "altKey")))))
(define
(define
element-value element-value
(fn (fn
(el) (el)
@@ -387,22 +417,19 @@
(and el (not (nil? (host-get el "value")))) (and el (not (nil? (host-get el "value"))))
(host-get el "value") (host-get el "value")
nil))) nil)))
(define
(define
error-message error-message
(fn (fn
(e) (e)
(if (and e (host-get e "message")) (host-get e "message") (str e)))) (if (and e (host-get e "message")) (host-get e "message") (str e))))
(define
(define
dom-get-data dom-get-data
(fn (fn
(el key) (el key)
(let (let
((store (host-get el "__sx_data"))) ((store (host-get el "__sx_data")))
(if store (host-get store key) nil)))) (if store (host-get store key) nil))))
(define
(define
dom-set-data dom-set-data
(fn (fn
(el key val) (el key val)
@@ -410,17 +437,21 @@
(not (host-get el "__sx_data")) (not (host-get el "__sx_data"))
(host-set! el "__sx_data" (dict))) (host-set! el "__sx_data" (dict)))
(host-set! (host-get el "__sx_data") key val))) (host-set! (host-get el "__sx_data") key val)))
(define
(define
dom-append-to-head dom-append-to-head
(fn (el) (when (dom-head) (host-call (dom-head) "appendChild" el)))) (fn (el) (when (dom-head) (host-call (dom-head) "appendChild" el))))
(define
(define
set-document-title set-document-title
(fn (title) (host-set! (dom-document) "title" 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))