HS: MutationObserver mock + on mutation dispatch (+7 tests)
Parser: parse-on-feat now consumes `of FILTER` after `mutation` event-name, where FILTER is `attributes`/`childList`/`characterData` ident or `@a [or @b]*` attr-token chain. Emits :of-filter dict on parts. Compiler: scan-on threads of-filter-info; mutation event-name emits `(do (hs-on …) (hs-on-mutation-attach! TARGET MODE ATTRS))`. Runtime: hs-on-mutation-attach! constructs a real MutationObserver with config matched to filter and dispatches "mutation" event with records detail. Runner: HsMutationObserver mock with global registry; prototype hooks on El.setAttribute/appendChild/removeChild/_setInnerHTML fire matching observers synchronously, with __hsMutationActive guard preventing recursion. Generator: dropped 7 mutation tests from skip-list, added evaluate(setAttribute) and evaluate(appendChild) body patterns. hs-upstream-on: 36/70 → 43/70. Smoke 0-195 unchanged at 170/195. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -164,7 +164,8 @@
|
|||||||
every?
|
every?
|
||||||
catch-info
|
catch-info
|
||||||
finally-info
|
finally-info
|
||||||
having-info)
|
having-info
|
||||||
|
of-filter-info)
|
||||||
(cond
|
(cond
|
||||||
((<= (len items) 1)
|
((<= (len items) 1)
|
||||||
(let
|
(let
|
||||||
@@ -185,23 +186,44 @@
|
|||||||
((handler (let ((uses-the-result? (fn (expr) (cond ((= expr (quote the-result)) true) ((list? expr) (some (fn (x) (uses-the-result? x)) expr)) (true false))))) (list (quote fn) (list (quote event)) (if (uses-the-result? wrapped-body) (list (quote let) (list (list (quote the-result) nil)) wrapped-body) wrapped-body)))))
|
((handler (let ((uses-the-result? (fn (expr) (cond ((= expr (quote the-result)) true) ((list? expr) (some (fn (x) (uses-the-result? x)) expr)) (true false))))) (list (quote fn) (list (quote event)) (if (uses-the-result? wrapped-body) (list (quote let) (list (list (quote the-result) nil)) wrapped-body) wrapped-body)))))
|
||||||
(let
|
(let
|
||||||
((on-call (if every? (list (quote hs-on-every) target event-name handler) (list (quote hs-on) target event-name handler))))
|
((on-call (if every? (list (quote hs-on-every) target event-name handler) (list (quote hs-on) target event-name handler))))
|
||||||
(if
|
(cond
|
||||||
(= event-name "intersection")
|
((= event-name "mutation")
|
||||||
(list
|
|
||||||
(quote do)
|
|
||||||
on-call
|
|
||||||
(list
|
(list
|
||||||
(quote hs-on-intersection-attach!)
|
(quote do)
|
||||||
target
|
on-call
|
||||||
(if
|
(list
|
||||||
having-info
|
(quote hs-on-mutation-attach!)
|
||||||
(get having-info "margin")
|
target
|
||||||
nil)
|
(if
|
||||||
(if
|
of-filter-info
|
||||||
having-info
|
(get of-filter-info "type")
|
||||||
(get having-info "threshold")
|
"any")
|
||||||
nil)))
|
(if
|
||||||
on-call)))))))))))
|
of-filter-info
|
||||||
|
(let
|
||||||
|
((a (get of-filter-info "attrs")))
|
||||||
|
(if
|
||||||
|
a
|
||||||
|
(cons (quote list) a)
|
||||||
|
nil))
|
||||||
|
nil))))
|
||||||
|
((= event-name "intersection")
|
||||||
|
(list
|
||||||
|
(quote do)
|
||||||
|
on-call
|
||||||
|
(list
|
||||||
|
(quote
|
||||||
|
hs-on-intersection-attach!)
|
||||||
|
target
|
||||||
|
(if
|
||||||
|
having-info
|
||||||
|
(get having-info "margin")
|
||||||
|
nil)
|
||||||
|
(if
|
||||||
|
having-info
|
||||||
|
(get having-info "threshold")
|
||||||
|
nil))))
|
||||||
|
(true on-call))))))))))))
|
||||||
((= (first items) :from)
|
((= (first items) :from)
|
||||||
(scan-on
|
(scan-on
|
||||||
(rest (rest items))
|
(rest (rest items))
|
||||||
@@ -210,7 +232,8 @@
|
|||||||
every?
|
every?
|
||||||
catch-info
|
catch-info
|
||||||
finally-info
|
finally-info
|
||||||
having-info))
|
having-info
|
||||||
|
of-filter-info))
|
||||||
((= (first items) :filter)
|
((= (first items) :filter)
|
||||||
(scan-on
|
(scan-on
|
||||||
(rest (rest items))
|
(rest (rest items))
|
||||||
@@ -219,7 +242,8 @@
|
|||||||
every?
|
every?
|
||||||
catch-info
|
catch-info
|
||||||
finally-info
|
finally-info
|
||||||
having-info))
|
having-info
|
||||||
|
of-filter-info))
|
||||||
((= (first items) :every)
|
((= (first items) :every)
|
||||||
(scan-on
|
(scan-on
|
||||||
(rest (rest items))
|
(rest (rest items))
|
||||||
@@ -228,7 +252,8 @@
|
|||||||
true
|
true
|
||||||
catch-info
|
catch-info
|
||||||
finally-info
|
finally-info
|
||||||
having-info))
|
having-info
|
||||||
|
of-filter-info))
|
||||||
((= (first items) :catch)
|
((= (first items) :catch)
|
||||||
(scan-on
|
(scan-on
|
||||||
(rest (rest items))
|
(rest (rest items))
|
||||||
@@ -237,7 +262,8 @@
|
|||||||
every?
|
every?
|
||||||
(nth items 1)
|
(nth items 1)
|
||||||
finally-info
|
finally-info
|
||||||
having-info))
|
having-info
|
||||||
|
of-filter-info))
|
||||||
((= (first items) :finally)
|
((= (first items) :finally)
|
||||||
(scan-on
|
(scan-on
|
||||||
(rest (rest items))
|
(rest (rest items))
|
||||||
@@ -246,7 +272,8 @@
|
|||||||
every?
|
every?
|
||||||
catch-info
|
catch-info
|
||||||
(nth items 1)
|
(nth items 1)
|
||||||
having-info))
|
having-info
|
||||||
|
of-filter-info))
|
||||||
((= (first items) :having)
|
((= (first items) :having)
|
||||||
(scan-on
|
(scan-on
|
||||||
(rest (rest items))
|
(rest (rest items))
|
||||||
@@ -255,6 +282,17 @@
|
|||||||
every?
|
every?
|
||||||
catch-info
|
catch-info
|
||||||
finally-info
|
finally-info
|
||||||
|
(nth items 1)
|
||||||
|
of-filter-info))
|
||||||
|
((= (first items) :of-filter)
|
||||||
|
(scan-on
|
||||||
|
(rest (rest items))
|
||||||
|
source
|
||||||
|
filter
|
||||||
|
every?
|
||||||
|
catch-info
|
||||||
|
finally-info
|
||||||
|
having-info
|
||||||
(nth items 1)))
|
(nth items 1)))
|
||||||
(true
|
(true
|
||||||
(scan-on
|
(scan-on
|
||||||
@@ -264,8 +302,9 @@
|
|||||||
every?
|
every?
|
||||||
catch-info
|
catch-info
|
||||||
finally-info
|
finally-info
|
||||||
having-info)))))
|
having-info
|
||||||
(scan-on (rest parts) nil nil false nil nil nil)))))
|
of-filter-info)))))
|
||||||
|
(scan-on (rest parts) nil nil false nil nil nil nil)))))
|
||||||
(define
|
(define
|
||||||
emit-send
|
emit-send
|
||||||
(fn
|
(fn
|
||||||
|
|||||||
@@ -2605,59 +2605,66 @@
|
|||||||
(let
|
(let
|
||||||
((event-name (parse-compound-event-name)))
|
((event-name (parse-compound-event-name)))
|
||||||
(let
|
(let
|
||||||
((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil)))
|
((of-filter (when (and (= event-name "mutation") (match-kw "of")) (cond ((and (= (tp-type) "ident") (or (= (tp-val) "attributes") (= (tp-val) "childList") (= (tp-val) "characterData"))) (let ((nm (tp-val))) (do (adv!) (dict "type" nm)))) ((= (tp-type) "attr") (let ((attrs (list (tp-val)))) (do (adv!) (define collect-or! (fn () (when (match-kw "or") (cond ((= (tp-type) "attr") (do (set! attrs (append attrs (list (tp-val)))) (adv!) (collect-or!))) (true (set! p (- p 1))))))) (collect-or!) (dict "type" "attrs" "attrs" attrs)))) (true nil)))))
|
||||||
(let
|
(let
|
||||||
((source (if (match-kw "from") (parse-expr) nil)))
|
((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil)))
|
||||||
(let
|
(let
|
||||||
((h-margin nil) (h-threshold nil))
|
((source (if (match-kw "from") (parse-expr) nil)))
|
||||||
(define
|
|
||||||
consume-having!
|
|
||||||
(fn
|
|
||||||
()
|
|
||||||
(cond
|
|
||||||
((and (= (tp-type) "ident") (= (tp-val) "having"))
|
|
||||||
(do
|
|
||||||
(adv!)
|
|
||||||
(cond
|
|
||||||
((and (= (tp-type) "ident") (= (tp-val) "margin"))
|
|
||||||
(do
|
|
||||||
(adv!)
|
|
||||||
(set! h-margin (parse-expr))
|
|
||||||
(consume-having!)))
|
|
||||||
((and (= (tp-type) "ident") (= (tp-val) "threshold"))
|
|
||||||
(do
|
|
||||||
(adv!)
|
|
||||||
(set! h-threshold (parse-expr))
|
|
||||||
(consume-having!)))
|
|
||||||
(true nil))))
|
|
||||||
(true nil))))
|
|
||||||
(consume-having!)
|
|
||||||
(let
|
(let
|
||||||
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
|
((h-margin nil) (h-threshold nil))
|
||||||
|
(define
|
||||||
|
consume-having!
|
||||||
|
(fn
|
||||||
|
()
|
||||||
|
(cond
|
||||||
|
((and (= (tp-type) "ident") (= (tp-val) "having"))
|
||||||
|
(do
|
||||||
|
(adv!)
|
||||||
|
(cond
|
||||||
|
((and (= (tp-type) "ident") (= (tp-val) "margin"))
|
||||||
|
(do
|
||||||
|
(adv!)
|
||||||
|
(set! h-margin (parse-expr))
|
||||||
|
(consume-having!)))
|
||||||
|
((and (= (tp-type) "ident") (= (tp-val) "threshold"))
|
||||||
|
(do
|
||||||
|
(adv!)
|
||||||
|
(set! h-threshold (parse-expr))
|
||||||
|
(consume-having!)))
|
||||||
|
(true nil))))
|
||||||
|
(true nil))))
|
||||||
|
(consume-having!)
|
||||||
(let
|
(let
|
||||||
((body (parse-cmd-list)))
|
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
|
||||||
(let
|
(let
|
||||||
((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil))
|
((body (parse-cmd-list)))
|
||||||
(finally-clause
|
|
||||||
(if (match-kw "finally") (parse-cmd-list) nil)))
|
|
||||||
(match-kw "end")
|
|
||||||
(let
|
(let
|
||||||
((parts (list (quote on) event-name)))
|
((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil))
|
||||||
|
(finally-clause
|
||||||
|
(if
|
||||||
|
(match-kw "finally")
|
||||||
|
(parse-cmd-list)
|
||||||
|
nil)))
|
||||||
|
(match-kw "end")
|
||||||
(let
|
(let
|
||||||
((parts (if every? (append parts (list :every true)) parts)))
|
((parts (list (quote on) event-name)))
|
||||||
(let
|
(let
|
||||||
((parts (if flt (append parts (list :filter flt)) parts)))
|
((parts (if every? (append parts (list :every true)) parts)))
|
||||||
(let
|
(let
|
||||||
((parts (if source (append parts (list :from source)) parts)))
|
((parts (if flt (append parts (list :filter flt)) parts)))
|
||||||
(let
|
(let
|
||||||
((parts (if having (append parts (list :having having)) parts)))
|
((parts (if source (append parts (list :from source)) parts)))
|
||||||
(let
|
(let
|
||||||
((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
|
((parts (if of-filter (append parts (list :of-filter of-filter)) parts)))
|
||||||
(let
|
(let
|
||||||
((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
|
((parts (if having (append parts (list :having having)) parts)))
|
||||||
(let
|
(let
|
||||||
((parts (append parts (list body))))
|
((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
|
||||||
parts))))))))))))))))))
|
(let
|
||||||
|
((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
|
||||||
|
(let
|
||||||
|
((parts (append parts (list body))))
|
||||||
|
parts))))))))))))))))))))
|
||||||
(define
|
(define
|
||||||
parse-init-feat
|
parse-init-feat
|
||||||
(fn
|
(fn
|
||||||
|
|||||||
@@ -82,14 +82,36 @@
|
|||||||
observer)))))
|
observer)))))
|
||||||
|
|
||||||
;; Wait for CSS transitions/animations to settle on an element.
|
;; Wait for CSS transitions/animations to settle on an element.
|
||||||
(define hs-init (fn (thunk) (thunk)))
|
(define
|
||||||
|
hs-on-mutation-attach!
|
||||||
|
(fn
|
||||||
|
(target mode attr-list)
|
||||||
|
(let
|
||||||
|
((cfg-attributes (or (= mode "any") (= mode "attributes") (= mode "attrs")))
|
||||||
|
(cfg-childList (or (= mode "any") (= mode "childList")))
|
||||||
|
(cfg-characterData (or (= mode "any") (= mode "characterData"))))
|
||||||
|
(let
|
||||||
|
((opts (dict "attributes" cfg-attributes "childList" cfg-childList "characterData" cfg-characterData "subtree" true)))
|
||||||
|
(when
|
||||||
|
(and (= mode "attrs") attr-list)
|
||||||
|
(dict-set! opts "attributeFilter" attr-list))
|
||||||
|
(let
|
||||||
|
((cb (fn (records observer) (dom-dispatch target "mutation" (dict "records" records)))))
|
||||||
|
(let
|
||||||
|
((observer (host-new "MutationObserver" cb)))
|
||||||
|
(host-call observer "observe" target opts)
|
||||||
|
observer))))))
|
||||||
|
|
||||||
;; ── Class manipulation ──────────────────────────────────────────
|
;; ── Class manipulation ──────────────────────────────────────────
|
||||||
|
|
||||||
;; Toggle a single class on an element.
|
;; Toggle a single class on an element.
|
||||||
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
|
(define hs-init (fn (thunk) (thunk)))
|
||||||
|
|
||||||
;; Toggle between two classes — exactly one is active at a time.
|
;; Toggle between two classes — exactly one is active at a time.
|
||||||
|
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
|
||||||
|
|
||||||
|
;; Take a class from siblings — add to target, remove from others.
|
||||||
|
;; (hs-take! target cls) — like radio button class behavior
|
||||||
(begin
|
(begin
|
||||||
(define
|
(define
|
||||||
hs-wait-for
|
hs-wait-for
|
||||||
@@ -102,21 +124,20 @@
|
|||||||
(target event-name timeout-ms)
|
(target event-name timeout-ms)
|
||||||
(perform (list (quote io-wait-event) target event-name timeout-ms)))))
|
(perform (list (quote io-wait-event) target event-name timeout-ms)))))
|
||||||
|
|
||||||
;; Take a class from siblings — add to target, remove from others.
|
|
||||||
;; (hs-take! target cls) — like radio button class behavior
|
|
||||||
(define hs-settle (fn (target) (perform (list (quote io-settle) target))))
|
|
||||||
|
|
||||||
;; ── DOM insertion ───────────────────────────────────────────────
|
;; ── DOM insertion ───────────────────────────────────────────────
|
||||||
|
|
||||||
;; Put content at a position relative to a target.
|
;; Put content at a position relative to a target.
|
||||||
;; pos: "into" | "before" | "after"
|
;; pos: "into" | "before" | "after"
|
||||||
(define
|
(define hs-settle (fn (target) (perform (list (quote io-settle) target))))
|
||||||
hs-toggle-class!
|
|
||||||
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
|
|
||||||
|
|
||||||
;; ── Navigation / traversal ──────────────────────────────────────
|
;; ── Navigation / traversal ──────────────────────────────────────
|
||||||
|
|
||||||
;; Navigate to a URL.
|
;; Navigate to a URL.
|
||||||
|
(define
|
||||||
|
hs-toggle-class!
|
||||||
|
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
|
||||||
|
|
||||||
|
;; Find next sibling matching a selector (or any sibling).
|
||||||
(define
|
(define
|
||||||
hs-toggle-between!
|
hs-toggle-between!
|
||||||
(fn
|
(fn
|
||||||
@@ -126,7 +147,7 @@
|
|||||||
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
||||||
(do (dom-remove-class target cls2) (dom-add-class target cls1)))))
|
(do (dom-remove-class target cls2) (dom-add-class target cls1)))))
|
||||||
|
|
||||||
;; Find next sibling matching a selector (or any sibling).
|
;; Find previous sibling matching a selector.
|
||||||
(define
|
(define
|
||||||
hs-toggle-style!
|
hs-toggle-style!
|
||||||
(fn
|
(fn
|
||||||
@@ -150,7 +171,7 @@
|
|||||||
(dom-set-style target prop "hidden")
|
(dom-set-style target prop "hidden")
|
||||||
(dom-set-style target prop "")))))))
|
(dom-set-style target prop "")))))))
|
||||||
|
|
||||||
;; Find previous sibling matching a selector.
|
;; First element matching selector within a scope.
|
||||||
(define
|
(define
|
||||||
hs-toggle-style-between!
|
hs-toggle-style-between!
|
||||||
(fn
|
(fn
|
||||||
@@ -162,7 +183,7 @@
|
|||||||
(dom-set-style target prop val2)
|
(dom-set-style target prop val2)
|
||||||
(dom-set-style target prop val1)))))
|
(dom-set-style target prop val1)))))
|
||||||
|
|
||||||
;; First element matching selector within a scope.
|
;; Last element matching selector.
|
||||||
(define
|
(define
|
||||||
hs-toggle-style-cycle!
|
hs-toggle-style-cycle!
|
||||||
(fn
|
(fn
|
||||||
@@ -183,7 +204,7 @@
|
|||||||
(true (find-next (rest remaining))))))
|
(true (find-next (rest remaining))))))
|
||||||
(dom-set-style target prop (find-next vals)))))
|
(dom-set-style target prop (find-next vals)))))
|
||||||
|
|
||||||
;; Last element matching selector.
|
;; First/last within a specific scope.
|
||||||
(define
|
(define
|
||||||
hs-take!
|
hs-take!
|
||||||
(fn
|
(fn
|
||||||
@@ -223,7 +244,6 @@
|
|||||||
(dom-set-attr target name attr-val)
|
(dom-set-attr target name attr-val)
|
||||||
(dom-set-attr target name ""))))))))
|
(dom-set-attr target name ""))))))))
|
||||||
|
|
||||||
;; First/last within a specific scope.
|
|
||||||
(begin
|
(begin
|
||||||
(define
|
(define
|
||||||
hs-element?
|
hs-element?
|
||||||
@@ -335,6 +355,9 @@
|
|||||||
(dom-insert-adjacent-html target "beforeend" value)
|
(dom-insert-adjacent-html target "beforeend" value)
|
||||||
(hs-boot-subtree! target)))))))))
|
(hs-boot-subtree! target)))))))))
|
||||||
|
|
||||||
|
;; ── Iteration ───────────────────────────────────────────────────
|
||||||
|
|
||||||
|
;; Repeat a thunk N times.
|
||||||
(define
|
(define
|
||||||
hs-add-to!
|
hs-add-to!
|
||||||
(fn
|
(fn
|
||||||
@@ -347,9 +370,7 @@
|
|||||||
(append target (list value))))
|
(append target (list value))))
|
||||||
(true (do (host-call target "push" value) target)))))
|
(true (do (host-call target "push" value) target)))))
|
||||||
|
|
||||||
;; ── Iteration ───────────────────────────────────────────────────
|
;; Repeat forever (until break — relies on exception/continuation).
|
||||||
|
|
||||||
;; Repeat a thunk N times.
|
|
||||||
(define
|
(define
|
||||||
hs-remove-from!
|
hs-remove-from!
|
||||||
(fn
|
(fn
|
||||||
@@ -359,7 +380,10 @@
|
|||||||
(filter (fn (x) (not (= x value))) target)
|
(filter (fn (x) (not (= x value))) target)
|
||||||
(host-call target "splice" (host-call target "indexOf" value) 1))))
|
(host-call target "splice" (host-call target "indexOf" value) 1))))
|
||||||
|
|
||||||
;; Repeat forever (until break — relies on exception/continuation).
|
;; ── Fetch ───────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
;; Fetch a URL, parse response according to format.
|
||||||
|
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
||||||
(define
|
(define
|
||||||
hs-splice-at!
|
hs-splice-at!
|
||||||
(fn
|
(fn
|
||||||
@@ -383,10 +407,10 @@
|
|||||||
(host-call target "splice" i 1))))
|
(host-call target "splice" i 1))))
|
||||||
target))))
|
target))))
|
||||||
|
|
||||||
;; ── Fetch ───────────────────────────────────────────────────────
|
;; ── Type coercion ───────────────────────────────────────────────
|
||||||
|
|
||||||
;; Fetch a URL, parse response according to format.
|
;; Coerce a value to a type by name.
|
||||||
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
||||||
(define
|
(define
|
||||||
hs-index
|
hs-index
|
||||||
(fn
|
(fn
|
||||||
@@ -398,10 +422,10 @@
|
|||||||
((string? obj) (nth obj key))
|
((string? obj) (nth obj key))
|
||||||
(true (host-get obj key)))))
|
(true (host-get obj key)))))
|
||||||
|
|
||||||
;; ── Type coercion ───────────────────────────────────────────────
|
;; ── Object creation ─────────────────────────────────────────────
|
||||||
|
|
||||||
;; Coerce a value to a type by name.
|
;; Make a new object of a given type.
|
||||||
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
;; (hs-make type-name) — creates empty object/collection
|
||||||
(define
|
(define
|
||||||
hs-put-at!
|
hs-put-at!
|
||||||
(fn
|
(fn
|
||||||
@@ -423,10 +447,11 @@
|
|||||||
((= pos "start") (host-call target "unshift" value)))
|
((= pos "start") (host-call target "unshift" value)))
|
||||||
target)))))))
|
target)))))))
|
||||||
|
|
||||||
;; ── Object creation ─────────────────────────────────────────────
|
;; ── Behavior installation ───────────────────────────────────────
|
||||||
|
|
||||||
;; Make a new object of a given type.
|
;; Install a behavior on an element.
|
||||||
;; (hs-make type-name) — creates empty object/collection
|
;; A behavior is a function that takes (me ...params) and sets up features.
|
||||||
|
;; (hs-install behavior-fn me ...args)
|
||||||
(define
|
(define
|
||||||
hs-dict-without
|
hs-dict-without
|
||||||
(fn
|
(fn
|
||||||
@@ -447,27 +472,27 @@
|
|||||||
(host-call (host-global "Reflect") "deleteProperty" out key)
|
(host-call (host-global "Reflect") "deleteProperty" out key)
|
||||||
out)))))
|
out)))))
|
||||||
|
|
||||||
;; ── Behavior installation ───────────────────────────────────────
|
;; ── Measurement ─────────────────────────────────────────────────
|
||||||
|
|
||||||
;; Install a behavior on an element.
|
;; Measure an element's bounding rect, store as local variables.
|
||||||
;; A behavior is a function that takes (me ...params) and sets up features.
|
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
||||||
;; (hs-install behavior-fn me ...args)
|
|
||||||
(define
|
(define
|
||||||
hs-set-on!
|
hs-set-on!
|
||||||
(fn
|
(fn
|
||||||
(props target)
|
(props target)
|
||||||
(for-each (fn (k) (host-set! target k (get props k))) (keys props))))
|
(for-each (fn (k) (host-set! target k (get props k))) (keys props))))
|
||||||
|
|
||||||
;; ── Measurement ─────────────────────────────────────────────────
|
|
||||||
|
|
||||||
;; Measure an element's bounding rect, store as local variables.
|
|
||||||
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
|
||||||
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
|
|
||||||
|
|
||||||
;; Return the current text selection as a string. In the browser this is
|
;; Return the current text selection as a string. In the browser this is
|
||||||
;; `window.getSelection().toString()`. In the mock test runner, a test
|
;; `window.getSelection().toString()`. In the mock test runner, a test
|
||||||
;; setup stashes the desired selection text at `window.__test_selection`
|
;; setup stashes the desired selection text at `window.__test_selection`
|
||||||
;; and the fallback path returns that so tests can assert on the result.
|
;; and the fallback path returns that so tests can assert on the result.
|
||||||
|
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
|
||||||
|
|
||||||
|
|
||||||
|
;; ── Transition ──────────────────────────────────────────────────
|
||||||
|
|
||||||
|
;; Transition a CSS property to a value, optionally with duration.
|
||||||
|
;; (hs-transition target prop value duration)
|
||||||
(define
|
(define
|
||||||
hs-ask
|
hs-ask
|
||||||
(fn
|
(fn
|
||||||
@@ -476,11 +501,6 @@
|
|||||||
((w (host-global "window")))
|
((w (host-global "window")))
|
||||||
(if w (host-call w "prompt" msg) nil))))
|
(if w (host-call w "prompt" msg) nil))))
|
||||||
|
|
||||||
|
|
||||||
;; ── Transition ──────────────────────────────────────────────────
|
|
||||||
|
|
||||||
;; Transition a CSS property to a value, optionally with duration.
|
|
||||||
;; (hs-transition target prop value duration)
|
|
||||||
(define
|
(define
|
||||||
hs-answer
|
hs-answer
|
||||||
(fn
|
(fn
|
||||||
@@ -634,6 +654,10 @@
|
|||||||
hs-query-all
|
hs-query-all
|
||||||
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
|
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(define
|
(define
|
||||||
hs-query-all-in
|
hs-query-all-in
|
||||||
(fn
|
(fn
|
||||||
@@ -643,25 +667,21 @@
|
|||||||
(hs-query-all sel)
|
(hs-query-all sel)
|
||||||
(host-call target "querySelectorAll" sel))))
|
(host-call target "querySelectorAll" sel))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(define
|
(define
|
||||||
hs-list-set
|
hs-list-set
|
||||||
(fn
|
(fn
|
||||||
(lst idx val)
|
(lst idx val)
|
||||||
(append (take lst idx) (cons val (drop lst (+ idx 1))))))
|
(append (take lst idx) (cons val (drop lst (+ idx 1))))))
|
||||||
|
|
||||||
(define
|
|
||||||
hs-to-number
|
|
||||||
(fn (v) (if (number? v) v (or (parse-number (str v)) 0))))
|
|
||||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||||
;; Property access — dot notation and .length
|
;; Property access — dot notation and .length
|
||||||
|
(define
|
||||||
|
hs-to-number
|
||||||
|
(fn (v) (if (number? v) v (or (parse-number (str v)) 0))))
|
||||||
|
;; DOM query stub — sandbox returns empty list
|
||||||
(define
|
(define
|
||||||
hs-query-first
|
hs-query-first
|
||||||
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
||||||
;; DOM query stub — sandbox returns empty list
|
;; Method dispatch — obj.method(args)
|
||||||
(define
|
(define
|
||||||
hs-query-last
|
hs-query-last
|
||||||
(fn
|
(fn
|
||||||
@@ -669,11 +689,11 @@
|
|||||||
(let
|
(let
|
||||||
((all (dom-query-all (dom-body) sel)))
|
((all (dom-query-all (dom-body) sel)))
|
||||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||||
;; Method dispatch — obj.method(args)
|
|
||||||
(define hs-first (fn (scope sel) (dom-query-all scope sel)))
|
|
||||||
|
|
||||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||||
;; beep! — debug logging, returns value unchanged
|
;; beep! — debug logging, returns value unchanged
|
||||||
|
(define hs-first (fn (scope sel) (dom-query-all scope sel)))
|
||||||
|
;; Property-based is — check obj.key truthiness
|
||||||
(define
|
(define
|
||||||
hs-last
|
hs-last
|
||||||
(fn
|
(fn
|
||||||
@@ -681,7 +701,7 @@
|
|||||||
(let
|
(let
|
||||||
((all (dom-query-all scope sel)))
|
((all (dom-query-all scope sel)))
|
||||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||||
;; Property-based is — check obj.key truthiness
|
;; Array slicing (inclusive both ends)
|
||||||
(define
|
(define
|
||||||
hs-repeat-times
|
hs-repeat-times
|
||||||
(fn
|
(fn
|
||||||
@@ -699,7 +719,7 @@
|
|||||||
((= signal "hs-continue") (do-repeat (+ i 1)))
|
((= signal "hs-continue") (do-repeat (+ i 1)))
|
||||||
(true (do-repeat (+ i 1))))))))
|
(true (do-repeat (+ i 1))))))))
|
||||||
(do-repeat 0)))
|
(do-repeat 0)))
|
||||||
;; Array slicing (inclusive both ends)
|
;; Collection: sorted by
|
||||||
(define
|
(define
|
||||||
hs-repeat-forever
|
hs-repeat-forever
|
||||||
(fn
|
(fn
|
||||||
@@ -715,7 +735,7 @@
|
|||||||
((= signal "hs-continue") (do-forever))
|
((= signal "hs-continue") (do-forever))
|
||||||
(true (do-forever))))))
|
(true (do-forever))))))
|
||||||
(do-forever)))
|
(do-forever)))
|
||||||
;; Collection: sorted by
|
;; Collection: sorted by descending
|
||||||
(define
|
(define
|
||||||
hs-repeat-while
|
hs-repeat-while
|
||||||
(fn
|
(fn
|
||||||
@@ -728,7 +748,7 @@
|
|||||||
((= signal "hs-break") nil)
|
((= signal "hs-break") nil)
|
||||||
((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
|
((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
|
||||||
(true (hs-repeat-while cond-fn thunk)))))))
|
(true (hs-repeat-while cond-fn thunk)))))))
|
||||||
;; Collection: sorted by descending
|
;; Collection: split by
|
||||||
(define
|
(define
|
||||||
hs-repeat-until
|
hs-repeat-until
|
||||||
(fn
|
(fn
|
||||||
@@ -740,7 +760,7 @@
|
|||||||
((= signal "hs-continue")
|
((= signal "hs-continue")
|
||||||
(if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
|
(if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
|
||||||
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
|
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
|
||||||
;; Collection: split by
|
;; Collection: joined by
|
||||||
(define
|
(define
|
||||||
hs-for-each
|
hs-for-each
|
||||||
(fn
|
(fn
|
||||||
@@ -760,7 +780,7 @@
|
|||||||
((= signal "hs-continue") (do-loop (rest remaining)))
|
((= signal "hs-continue") (do-loop (rest remaining)))
|
||||||
(true (do-loop (rest remaining))))))))
|
(true (do-loop (rest remaining))))))))
|
||||||
(do-loop items))))
|
(do-loop items))))
|
||||||
;; Collection: joined by
|
|
||||||
(begin
|
(begin
|
||||||
(define
|
(define
|
||||||
hs-append
|
hs-append
|
||||||
|
|||||||
@@ -164,7 +164,8 @@
|
|||||||
every?
|
every?
|
||||||
catch-info
|
catch-info
|
||||||
finally-info
|
finally-info
|
||||||
having-info)
|
having-info
|
||||||
|
of-filter-info)
|
||||||
(cond
|
(cond
|
||||||
((<= (len items) 1)
|
((<= (len items) 1)
|
||||||
(let
|
(let
|
||||||
@@ -185,23 +186,44 @@
|
|||||||
((handler (let ((uses-the-result? (fn (expr) (cond ((= expr (quote the-result)) true) ((list? expr) (some (fn (x) (uses-the-result? x)) expr)) (true false))))) (list (quote fn) (list (quote event)) (if (uses-the-result? wrapped-body) (list (quote let) (list (list (quote the-result) nil)) wrapped-body) wrapped-body)))))
|
((handler (let ((uses-the-result? (fn (expr) (cond ((= expr (quote the-result)) true) ((list? expr) (some (fn (x) (uses-the-result? x)) expr)) (true false))))) (list (quote fn) (list (quote event)) (if (uses-the-result? wrapped-body) (list (quote let) (list (list (quote the-result) nil)) wrapped-body) wrapped-body)))))
|
||||||
(let
|
(let
|
||||||
((on-call (if every? (list (quote hs-on-every) target event-name handler) (list (quote hs-on) target event-name handler))))
|
((on-call (if every? (list (quote hs-on-every) target event-name handler) (list (quote hs-on) target event-name handler))))
|
||||||
(if
|
(cond
|
||||||
(= event-name "intersection")
|
((= event-name "mutation")
|
||||||
(list
|
|
||||||
(quote do)
|
|
||||||
on-call
|
|
||||||
(list
|
(list
|
||||||
(quote hs-on-intersection-attach!)
|
(quote do)
|
||||||
target
|
on-call
|
||||||
(if
|
(list
|
||||||
having-info
|
(quote hs-on-mutation-attach!)
|
||||||
(get having-info "margin")
|
target
|
||||||
nil)
|
(if
|
||||||
(if
|
of-filter-info
|
||||||
having-info
|
(get of-filter-info "type")
|
||||||
(get having-info "threshold")
|
"any")
|
||||||
nil)))
|
(if
|
||||||
on-call)))))))))))
|
of-filter-info
|
||||||
|
(let
|
||||||
|
((a (get of-filter-info "attrs")))
|
||||||
|
(if
|
||||||
|
a
|
||||||
|
(cons (quote list) a)
|
||||||
|
nil))
|
||||||
|
nil))))
|
||||||
|
((= event-name "intersection")
|
||||||
|
(list
|
||||||
|
(quote do)
|
||||||
|
on-call
|
||||||
|
(list
|
||||||
|
(quote
|
||||||
|
hs-on-intersection-attach!)
|
||||||
|
target
|
||||||
|
(if
|
||||||
|
having-info
|
||||||
|
(get having-info "margin")
|
||||||
|
nil)
|
||||||
|
(if
|
||||||
|
having-info
|
||||||
|
(get having-info "threshold")
|
||||||
|
nil))))
|
||||||
|
(true on-call))))))))))))
|
||||||
((= (first items) :from)
|
((= (first items) :from)
|
||||||
(scan-on
|
(scan-on
|
||||||
(rest (rest items))
|
(rest (rest items))
|
||||||
@@ -210,7 +232,8 @@
|
|||||||
every?
|
every?
|
||||||
catch-info
|
catch-info
|
||||||
finally-info
|
finally-info
|
||||||
having-info))
|
having-info
|
||||||
|
of-filter-info))
|
||||||
((= (first items) :filter)
|
((= (first items) :filter)
|
||||||
(scan-on
|
(scan-on
|
||||||
(rest (rest items))
|
(rest (rest items))
|
||||||
@@ -219,7 +242,8 @@
|
|||||||
every?
|
every?
|
||||||
catch-info
|
catch-info
|
||||||
finally-info
|
finally-info
|
||||||
having-info))
|
having-info
|
||||||
|
of-filter-info))
|
||||||
((= (first items) :every)
|
((= (first items) :every)
|
||||||
(scan-on
|
(scan-on
|
||||||
(rest (rest items))
|
(rest (rest items))
|
||||||
@@ -228,7 +252,8 @@
|
|||||||
true
|
true
|
||||||
catch-info
|
catch-info
|
||||||
finally-info
|
finally-info
|
||||||
having-info))
|
having-info
|
||||||
|
of-filter-info))
|
||||||
((= (first items) :catch)
|
((= (first items) :catch)
|
||||||
(scan-on
|
(scan-on
|
||||||
(rest (rest items))
|
(rest (rest items))
|
||||||
@@ -237,7 +262,8 @@
|
|||||||
every?
|
every?
|
||||||
(nth items 1)
|
(nth items 1)
|
||||||
finally-info
|
finally-info
|
||||||
having-info))
|
having-info
|
||||||
|
of-filter-info))
|
||||||
((= (first items) :finally)
|
((= (first items) :finally)
|
||||||
(scan-on
|
(scan-on
|
||||||
(rest (rest items))
|
(rest (rest items))
|
||||||
@@ -246,7 +272,8 @@
|
|||||||
every?
|
every?
|
||||||
catch-info
|
catch-info
|
||||||
(nth items 1)
|
(nth items 1)
|
||||||
having-info))
|
having-info
|
||||||
|
of-filter-info))
|
||||||
((= (first items) :having)
|
((= (first items) :having)
|
||||||
(scan-on
|
(scan-on
|
||||||
(rest (rest items))
|
(rest (rest items))
|
||||||
@@ -255,6 +282,17 @@
|
|||||||
every?
|
every?
|
||||||
catch-info
|
catch-info
|
||||||
finally-info
|
finally-info
|
||||||
|
(nth items 1)
|
||||||
|
of-filter-info))
|
||||||
|
((= (first items) :of-filter)
|
||||||
|
(scan-on
|
||||||
|
(rest (rest items))
|
||||||
|
source
|
||||||
|
filter
|
||||||
|
every?
|
||||||
|
catch-info
|
||||||
|
finally-info
|
||||||
|
having-info
|
||||||
(nth items 1)))
|
(nth items 1)))
|
||||||
(true
|
(true
|
||||||
(scan-on
|
(scan-on
|
||||||
@@ -264,8 +302,9 @@
|
|||||||
every?
|
every?
|
||||||
catch-info
|
catch-info
|
||||||
finally-info
|
finally-info
|
||||||
having-info)))))
|
having-info
|
||||||
(scan-on (rest parts) nil nil false nil nil nil)))))
|
of-filter-info)))))
|
||||||
|
(scan-on (rest parts) nil nil false nil nil nil nil)))))
|
||||||
(define
|
(define
|
||||||
emit-send
|
emit-send
|
||||||
(fn
|
(fn
|
||||||
|
|||||||
@@ -2605,59 +2605,66 @@
|
|||||||
(let
|
(let
|
||||||
((event-name (parse-compound-event-name)))
|
((event-name (parse-compound-event-name)))
|
||||||
(let
|
(let
|
||||||
((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil)))
|
((of-filter (when (and (= event-name "mutation") (match-kw "of")) (cond ((and (= (tp-type) "ident") (or (= (tp-val) "attributes") (= (tp-val) "childList") (= (tp-val) "characterData"))) (let ((nm (tp-val))) (do (adv!) (dict "type" nm)))) ((= (tp-type) "attr") (let ((attrs (list (tp-val)))) (do (adv!) (define collect-or! (fn () (when (match-kw "or") (cond ((= (tp-type) "attr") (do (set! attrs (append attrs (list (tp-val)))) (adv!) (collect-or!))) (true (set! p (- p 1))))))) (collect-or!) (dict "type" "attrs" "attrs" attrs)))) (true nil)))))
|
||||||
(let
|
(let
|
||||||
((source (if (match-kw "from") (parse-expr) nil)))
|
((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil)))
|
||||||
(let
|
(let
|
||||||
((h-margin nil) (h-threshold nil))
|
((source (if (match-kw "from") (parse-expr) nil)))
|
||||||
(define
|
|
||||||
consume-having!
|
|
||||||
(fn
|
|
||||||
()
|
|
||||||
(cond
|
|
||||||
((and (= (tp-type) "ident") (= (tp-val) "having"))
|
|
||||||
(do
|
|
||||||
(adv!)
|
|
||||||
(cond
|
|
||||||
((and (= (tp-type) "ident") (= (tp-val) "margin"))
|
|
||||||
(do
|
|
||||||
(adv!)
|
|
||||||
(set! h-margin (parse-expr))
|
|
||||||
(consume-having!)))
|
|
||||||
((and (= (tp-type) "ident") (= (tp-val) "threshold"))
|
|
||||||
(do
|
|
||||||
(adv!)
|
|
||||||
(set! h-threshold (parse-expr))
|
|
||||||
(consume-having!)))
|
|
||||||
(true nil))))
|
|
||||||
(true nil))))
|
|
||||||
(consume-having!)
|
|
||||||
(let
|
(let
|
||||||
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
|
((h-margin nil) (h-threshold nil))
|
||||||
|
(define
|
||||||
|
consume-having!
|
||||||
|
(fn
|
||||||
|
()
|
||||||
|
(cond
|
||||||
|
((and (= (tp-type) "ident") (= (tp-val) "having"))
|
||||||
|
(do
|
||||||
|
(adv!)
|
||||||
|
(cond
|
||||||
|
((and (= (tp-type) "ident") (= (tp-val) "margin"))
|
||||||
|
(do
|
||||||
|
(adv!)
|
||||||
|
(set! h-margin (parse-expr))
|
||||||
|
(consume-having!)))
|
||||||
|
((and (= (tp-type) "ident") (= (tp-val) "threshold"))
|
||||||
|
(do
|
||||||
|
(adv!)
|
||||||
|
(set! h-threshold (parse-expr))
|
||||||
|
(consume-having!)))
|
||||||
|
(true nil))))
|
||||||
|
(true nil))))
|
||||||
|
(consume-having!)
|
||||||
(let
|
(let
|
||||||
((body (parse-cmd-list)))
|
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
|
||||||
(let
|
(let
|
||||||
((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil))
|
((body (parse-cmd-list)))
|
||||||
(finally-clause
|
|
||||||
(if (match-kw "finally") (parse-cmd-list) nil)))
|
|
||||||
(match-kw "end")
|
|
||||||
(let
|
(let
|
||||||
((parts (list (quote on) event-name)))
|
((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil))
|
||||||
|
(finally-clause
|
||||||
|
(if
|
||||||
|
(match-kw "finally")
|
||||||
|
(parse-cmd-list)
|
||||||
|
nil)))
|
||||||
|
(match-kw "end")
|
||||||
(let
|
(let
|
||||||
((parts (if every? (append parts (list :every true)) parts)))
|
((parts (list (quote on) event-name)))
|
||||||
(let
|
(let
|
||||||
((parts (if flt (append parts (list :filter flt)) parts)))
|
((parts (if every? (append parts (list :every true)) parts)))
|
||||||
(let
|
(let
|
||||||
((parts (if source (append parts (list :from source)) parts)))
|
((parts (if flt (append parts (list :filter flt)) parts)))
|
||||||
(let
|
(let
|
||||||
((parts (if having (append parts (list :having having)) parts)))
|
((parts (if source (append parts (list :from source)) parts)))
|
||||||
(let
|
(let
|
||||||
((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
|
((parts (if of-filter (append parts (list :of-filter of-filter)) parts)))
|
||||||
(let
|
(let
|
||||||
((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
|
((parts (if having (append parts (list :having having)) parts)))
|
||||||
(let
|
(let
|
||||||
((parts (append parts (list body))))
|
((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
|
||||||
parts))))))))))))))))))
|
(let
|
||||||
|
((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
|
||||||
|
(let
|
||||||
|
((parts (append parts (list body))))
|
||||||
|
parts))))))))))))))))))))
|
||||||
(define
|
(define
|
||||||
parse-init-feat
|
parse-init-feat
|
||||||
(fn
|
(fn
|
||||||
|
|||||||
@@ -82,14 +82,36 @@
|
|||||||
observer)))))
|
observer)))))
|
||||||
|
|
||||||
;; Wait for CSS transitions/animations to settle on an element.
|
;; Wait for CSS transitions/animations to settle on an element.
|
||||||
(define hs-init (fn (thunk) (thunk)))
|
(define
|
||||||
|
hs-on-mutation-attach!
|
||||||
|
(fn
|
||||||
|
(target mode attr-list)
|
||||||
|
(let
|
||||||
|
((cfg-attributes (or (= mode "any") (= mode "attributes") (= mode "attrs")))
|
||||||
|
(cfg-childList (or (= mode "any") (= mode "childList")))
|
||||||
|
(cfg-characterData (or (= mode "any") (= mode "characterData"))))
|
||||||
|
(let
|
||||||
|
((opts (dict "attributes" cfg-attributes "childList" cfg-childList "characterData" cfg-characterData "subtree" true)))
|
||||||
|
(when
|
||||||
|
(and (= mode "attrs") attr-list)
|
||||||
|
(dict-set! opts "attributeFilter" attr-list))
|
||||||
|
(let
|
||||||
|
((cb (fn (records observer) (dom-dispatch target "mutation" (dict "records" records)))))
|
||||||
|
(let
|
||||||
|
((observer (host-new "MutationObserver" cb)))
|
||||||
|
(host-call observer "observe" target opts)
|
||||||
|
observer))))))
|
||||||
|
|
||||||
;; ── Class manipulation ──────────────────────────────────────────
|
;; ── Class manipulation ──────────────────────────────────────────
|
||||||
|
|
||||||
;; Toggle a single class on an element.
|
;; Toggle a single class on an element.
|
||||||
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
|
(define hs-init (fn (thunk) (thunk)))
|
||||||
|
|
||||||
;; Toggle between two classes — exactly one is active at a time.
|
;; Toggle between two classes — exactly one is active at a time.
|
||||||
|
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
|
||||||
|
|
||||||
|
;; Take a class from siblings — add to target, remove from others.
|
||||||
|
;; (hs-take! target cls) — like radio button class behavior
|
||||||
(begin
|
(begin
|
||||||
(define
|
(define
|
||||||
hs-wait-for
|
hs-wait-for
|
||||||
@@ -102,21 +124,20 @@
|
|||||||
(target event-name timeout-ms)
|
(target event-name timeout-ms)
|
||||||
(perform (list (quote io-wait-event) target event-name timeout-ms)))))
|
(perform (list (quote io-wait-event) target event-name timeout-ms)))))
|
||||||
|
|
||||||
;; Take a class from siblings — add to target, remove from others.
|
|
||||||
;; (hs-take! target cls) — like radio button class behavior
|
|
||||||
(define hs-settle (fn (target) (perform (list (quote io-settle) target))))
|
|
||||||
|
|
||||||
;; ── DOM insertion ───────────────────────────────────────────────
|
;; ── DOM insertion ───────────────────────────────────────────────
|
||||||
|
|
||||||
;; Put content at a position relative to a target.
|
;; Put content at a position relative to a target.
|
||||||
;; pos: "into" | "before" | "after"
|
;; pos: "into" | "before" | "after"
|
||||||
(define
|
(define hs-settle (fn (target) (perform (list (quote io-settle) target))))
|
||||||
hs-toggle-class!
|
|
||||||
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
|
|
||||||
|
|
||||||
;; ── Navigation / traversal ──────────────────────────────────────
|
;; ── Navigation / traversal ──────────────────────────────────────
|
||||||
|
|
||||||
;; Navigate to a URL.
|
;; Navigate to a URL.
|
||||||
|
(define
|
||||||
|
hs-toggle-class!
|
||||||
|
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
|
||||||
|
|
||||||
|
;; Find next sibling matching a selector (or any sibling).
|
||||||
(define
|
(define
|
||||||
hs-toggle-between!
|
hs-toggle-between!
|
||||||
(fn
|
(fn
|
||||||
@@ -126,7 +147,7 @@
|
|||||||
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
||||||
(do (dom-remove-class target cls2) (dom-add-class target cls1)))))
|
(do (dom-remove-class target cls2) (dom-add-class target cls1)))))
|
||||||
|
|
||||||
;; Find next sibling matching a selector (or any sibling).
|
;; Find previous sibling matching a selector.
|
||||||
(define
|
(define
|
||||||
hs-toggle-style!
|
hs-toggle-style!
|
||||||
(fn
|
(fn
|
||||||
@@ -150,7 +171,7 @@
|
|||||||
(dom-set-style target prop "hidden")
|
(dom-set-style target prop "hidden")
|
||||||
(dom-set-style target prop "")))))))
|
(dom-set-style target prop "")))))))
|
||||||
|
|
||||||
;; Find previous sibling matching a selector.
|
;; First element matching selector within a scope.
|
||||||
(define
|
(define
|
||||||
hs-toggle-style-between!
|
hs-toggle-style-between!
|
||||||
(fn
|
(fn
|
||||||
@@ -162,7 +183,7 @@
|
|||||||
(dom-set-style target prop val2)
|
(dom-set-style target prop val2)
|
||||||
(dom-set-style target prop val1)))))
|
(dom-set-style target prop val1)))))
|
||||||
|
|
||||||
;; First element matching selector within a scope.
|
;; Last element matching selector.
|
||||||
(define
|
(define
|
||||||
hs-toggle-style-cycle!
|
hs-toggle-style-cycle!
|
||||||
(fn
|
(fn
|
||||||
@@ -183,7 +204,7 @@
|
|||||||
(true (find-next (rest remaining))))))
|
(true (find-next (rest remaining))))))
|
||||||
(dom-set-style target prop (find-next vals)))))
|
(dom-set-style target prop (find-next vals)))))
|
||||||
|
|
||||||
;; Last element matching selector.
|
;; First/last within a specific scope.
|
||||||
(define
|
(define
|
||||||
hs-take!
|
hs-take!
|
||||||
(fn
|
(fn
|
||||||
@@ -223,7 +244,6 @@
|
|||||||
(dom-set-attr target name attr-val)
|
(dom-set-attr target name attr-val)
|
||||||
(dom-set-attr target name ""))))))))
|
(dom-set-attr target name ""))))))))
|
||||||
|
|
||||||
;; First/last within a specific scope.
|
|
||||||
(begin
|
(begin
|
||||||
(define
|
(define
|
||||||
hs-element?
|
hs-element?
|
||||||
@@ -335,6 +355,9 @@
|
|||||||
(dom-insert-adjacent-html target "beforeend" value)
|
(dom-insert-adjacent-html target "beforeend" value)
|
||||||
(hs-boot-subtree! target)))))))))
|
(hs-boot-subtree! target)))))))))
|
||||||
|
|
||||||
|
;; ── Iteration ───────────────────────────────────────────────────
|
||||||
|
|
||||||
|
;; Repeat a thunk N times.
|
||||||
(define
|
(define
|
||||||
hs-add-to!
|
hs-add-to!
|
||||||
(fn
|
(fn
|
||||||
@@ -347,9 +370,7 @@
|
|||||||
(append target (list value))))
|
(append target (list value))))
|
||||||
(true (do (host-call target "push" value) target)))))
|
(true (do (host-call target "push" value) target)))))
|
||||||
|
|
||||||
;; ── Iteration ───────────────────────────────────────────────────
|
;; Repeat forever (until break — relies on exception/continuation).
|
||||||
|
|
||||||
;; Repeat a thunk N times.
|
|
||||||
(define
|
(define
|
||||||
hs-remove-from!
|
hs-remove-from!
|
||||||
(fn
|
(fn
|
||||||
@@ -359,7 +380,10 @@
|
|||||||
(filter (fn (x) (not (= x value))) target)
|
(filter (fn (x) (not (= x value))) target)
|
||||||
(host-call target "splice" (host-call target "indexOf" value) 1))))
|
(host-call target "splice" (host-call target "indexOf" value) 1))))
|
||||||
|
|
||||||
;; Repeat forever (until break — relies on exception/continuation).
|
;; ── Fetch ───────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
;; Fetch a URL, parse response according to format.
|
||||||
|
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
||||||
(define
|
(define
|
||||||
hs-splice-at!
|
hs-splice-at!
|
||||||
(fn
|
(fn
|
||||||
@@ -383,10 +407,10 @@
|
|||||||
(host-call target "splice" i 1))))
|
(host-call target "splice" i 1))))
|
||||||
target))))
|
target))))
|
||||||
|
|
||||||
;; ── Fetch ───────────────────────────────────────────────────────
|
;; ── Type coercion ───────────────────────────────────────────────
|
||||||
|
|
||||||
;; Fetch a URL, parse response according to format.
|
;; Coerce a value to a type by name.
|
||||||
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
||||||
(define
|
(define
|
||||||
hs-index
|
hs-index
|
||||||
(fn
|
(fn
|
||||||
@@ -398,10 +422,10 @@
|
|||||||
((string? obj) (nth obj key))
|
((string? obj) (nth obj key))
|
||||||
(true (host-get obj key)))))
|
(true (host-get obj key)))))
|
||||||
|
|
||||||
;; ── Type coercion ───────────────────────────────────────────────
|
;; ── Object creation ─────────────────────────────────────────────
|
||||||
|
|
||||||
;; Coerce a value to a type by name.
|
;; Make a new object of a given type.
|
||||||
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
;; (hs-make type-name) — creates empty object/collection
|
||||||
(define
|
(define
|
||||||
hs-put-at!
|
hs-put-at!
|
||||||
(fn
|
(fn
|
||||||
@@ -423,10 +447,11 @@
|
|||||||
((= pos "start") (host-call target "unshift" value)))
|
((= pos "start") (host-call target "unshift" value)))
|
||||||
target)))))))
|
target)))))))
|
||||||
|
|
||||||
;; ── Object creation ─────────────────────────────────────────────
|
;; ── Behavior installation ───────────────────────────────────────
|
||||||
|
|
||||||
;; Make a new object of a given type.
|
;; Install a behavior on an element.
|
||||||
;; (hs-make type-name) — creates empty object/collection
|
;; A behavior is a function that takes (me ...params) and sets up features.
|
||||||
|
;; (hs-install behavior-fn me ...args)
|
||||||
(define
|
(define
|
||||||
hs-dict-without
|
hs-dict-without
|
||||||
(fn
|
(fn
|
||||||
@@ -447,27 +472,27 @@
|
|||||||
(host-call (host-global "Reflect") "deleteProperty" out key)
|
(host-call (host-global "Reflect") "deleteProperty" out key)
|
||||||
out)))))
|
out)))))
|
||||||
|
|
||||||
;; ── Behavior installation ───────────────────────────────────────
|
;; ── Measurement ─────────────────────────────────────────────────
|
||||||
|
|
||||||
;; Install a behavior on an element.
|
;; Measure an element's bounding rect, store as local variables.
|
||||||
;; A behavior is a function that takes (me ...params) and sets up features.
|
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
||||||
;; (hs-install behavior-fn me ...args)
|
|
||||||
(define
|
(define
|
||||||
hs-set-on!
|
hs-set-on!
|
||||||
(fn
|
(fn
|
||||||
(props target)
|
(props target)
|
||||||
(for-each (fn (k) (host-set! target k (get props k))) (keys props))))
|
(for-each (fn (k) (host-set! target k (get props k))) (keys props))))
|
||||||
|
|
||||||
;; ── Measurement ─────────────────────────────────────────────────
|
|
||||||
|
|
||||||
;; Measure an element's bounding rect, store as local variables.
|
|
||||||
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
|
||||||
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
|
|
||||||
|
|
||||||
;; Return the current text selection as a string. In the browser this is
|
;; Return the current text selection as a string. In the browser this is
|
||||||
;; `window.getSelection().toString()`. In the mock test runner, a test
|
;; `window.getSelection().toString()`. In the mock test runner, a test
|
||||||
;; setup stashes the desired selection text at `window.__test_selection`
|
;; setup stashes the desired selection text at `window.__test_selection`
|
||||||
;; and the fallback path returns that so tests can assert on the result.
|
;; and the fallback path returns that so tests can assert on the result.
|
||||||
|
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
|
||||||
|
|
||||||
|
|
||||||
|
;; ── Transition ──────────────────────────────────────────────────
|
||||||
|
|
||||||
|
;; Transition a CSS property to a value, optionally with duration.
|
||||||
|
;; (hs-transition target prop value duration)
|
||||||
(define
|
(define
|
||||||
hs-ask
|
hs-ask
|
||||||
(fn
|
(fn
|
||||||
@@ -476,11 +501,6 @@
|
|||||||
((w (host-global "window")))
|
((w (host-global "window")))
|
||||||
(if w (host-call w "prompt" msg) nil))))
|
(if w (host-call w "prompt" msg) nil))))
|
||||||
|
|
||||||
|
|
||||||
;; ── Transition ──────────────────────────────────────────────────
|
|
||||||
|
|
||||||
;; Transition a CSS property to a value, optionally with duration.
|
|
||||||
;; (hs-transition target prop value duration)
|
|
||||||
(define
|
(define
|
||||||
hs-answer
|
hs-answer
|
||||||
(fn
|
(fn
|
||||||
@@ -634,6 +654,10 @@
|
|||||||
hs-query-all
|
hs-query-all
|
||||||
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
|
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(define
|
(define
|
||||||
hs-query-all-in
|
hs-query-all-in
|
||||||
(fn
|
(fn
|
||||||
@@ -643,25 +667,21 @@
|
|||||||
(hs-query-all sel)
|
(hs-query-all sel)
|
||||||
(host-call target "querySelectorAll" sel))))
|
(host-call target "querySelectorAll" sel))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(define
|
(define
|
||||||
hs-list-set
|
hs-list-set
|
||||||
(fn
|
(fn
|
||||||
(lst idx val)
|
(lst idx val)
|
||||||
(append (take lst idx) (cons val (drop lst (+ idx 1))))))
|
(append (take lst idx) (cons val (drop lst (+ idx 1))))))
|
||||||
|
|
||||||
(define
|
|
||||||
hs-to-number
|
|
||||||
(fn (v) (if (number? v) v (or (parse-number (str v)) 0))))
|
|
||||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||||
;; Property access — dot notation and .length
|
;; Property access — dot notation and .length
|
||||||
|
(define
|
||||||
|
hs-to-number
|
||||||
|
(fn (v) (if (number? v) v (or (parse-number (str v)) 0))))
|
||||||
|
;; DOM query stub — sandbox returns empty list
|
||||||
(define
|
(define
|
||||||
hs-query-first
|
hs-query-first
|
||||||
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
||||||
;; DOM query stub — sandbox returns empty list
|
;; Method dispatch — obj.method(args)
|
||||||
(define
|
(define
|
||||||
hs-query-last
|
hs-query-last
|
||||||
(fn
|
(fn
|
||||||
@@ -669,11 +689,11 @@
|
|||||||
(let
|
(let
|
||||||
((all (dom-query-all (dom-body) sel)))
|
((all (dom-query-all (dom-body) sel)))
|
||||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||||
;; Method dispatch — obj.method(args)
|
|
||||||
(define hs-first (fn (scope sel) (dom-query-all scope sel)))
|
|
||||||
|
|
||||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||||
;; beep! — debug logging, returns value unchanged
|
;; beep! — debug logging, returns value unchanged
|
||||||
|
(define hs-first (fn (scope sel) (dom-query-all scope sel)))
|
||||||
|
;; Property-based is — check obj.key truthiness
|
||||||
(define
|
(define
|
||||||
hs-last
|
hs-last
|
||||||
(fn
|
(fn
|
||||||
@@ -681,7 +701,7 @@
|
|||||||
(let
|
(let
|
||||||
((all (dom-query-all scope sel)))
|
((all (dom-query-all scope sel)))
|
||||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||||
;; Property-based is — check obj.key truthiness
|
;; Array slicing (inclusive both ends)
|
||||||
(define
|
(define
|
||||||
hs-repeat-times
|
hs-repeat-times
|
||||||
(fn
|
(fn
|
||||||
@@ -699,7 +719,7 @@
|
|||||||
((= signal "hs-continue") (do-repeat (+ i 1)))
|
((= signal "hs-continue") (do-repeat (+ i 1)))
|
||||||
(true (do-repeat (+ i 1))))))))
|
(true (do-repeat (+ i 1))))))))
|
||||||
(do-repeat 0)))
|
(do-repeat 0)))
|
||||||
;; Array slicing (inclusive both ends)
|
;; Collection: sorted by
|
||||||
(define
|
(define
|
||||||
hs-repeat-forever
|
hs-repeat-forever
|
||||||
(fn
|
(fn
|
||||||
@@ -715,7 +735,7 @@
|
|||||||
((= signal "hs-continue") (do-forever))
|
((= signal "hs-continue") (do-forever))
|
||||||
(true (do-forever))))))
|
(true (do-forever))))))
|
||||||
(do-forever)))
|
(do-forever)))
|
||||||
;; Collection: sorted by
|
;; Collection: sorted by descending
|
||||||
(define
|
(define
|
||||||
hs-repeat-while
|
hs-repeat-while
|
||||||
(fn
|
(fn
|
||||||
@@ -728,7 +748,7 @@
|
|||||||
((= signal "hs-break") nil)
|
((= signal "hs-break") nil)
|
||||||
((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
|
((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
|
||||||
(true (hs-repeat-while cond-fn thunk)))))))
|
(true (hs-repeat-while cond-fn thunk)))))))
|
||||||
;; Collection: sorted by descending
|
;; Collection: split by
|
||||||
(define
|
(define
|
||||||
hs-repeat-until
|
hs-repeat-until
|
||||||
(fn
|
(fn
|
||||||
@@ -740,7 +760,7 @@
|
|||||||
((= signal "hs-continue")
|
((= signal "hs-continue")
|
||||||
(if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
|
(if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
|
||||||
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
|
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
|
||||||
;; Collection: split by
|
;; Collection: joined by
|
||||||
(define
|
(define
|
||||||
hs-for-each
|
hs-for-each
|
||||||
(fn
|
(fn
|
||||||
@@ -760,7 +780,7 @@
|
|||||||
((= signal "hs-continue") (do-loop (rest remaining)))
|
((= signal "hs-continue") (do-loop (rest remaining)))
|
||||||
(true (do-loop (rest remaining))))))))
|
(true (do-loop (rest remaining))))))))
|
||||||
(do-loop items))))
|
(do-loop items))))
|
||||||
;; Collection: joined by
|
|
||||||
(begin
|
(begin
|
||||||
(define
|
(define
|
||||||
hs-append
|
hs-append
|
||||||
|
|||||||
@@ -8849,9 +8849,22 @@
|
|||||||
(hs-activate! _el-div)
|
(hs-activate! _el-div)
|
||||||
))
|
))
|
||||||
(deftest "can listen for attribute mutations"
|
(deftest "can listen for attribute mutations"
|
||||||
(error "SKIP (skip-list): can listen for attribute mutations"))
|
(hs-cleanup!)
|
||||||
|
(let ((_el-div (dom-create-element "div")))
|
||||||
|
(dom-set-attr _el-div "_" "on mutation of attributes put \"Mutated\" into me")
|
||||||
|
(dom-append (dom-body) _el-div)
|
||||||
|
(hs-activate! _el-div)
|
||||||
|
))
|
||||||
(deftest "can listen for attribute mutations on other elements"
|
(deftest "can listen for attribute mutations on other elements"
|
||||||
(error "SKIP (skip-list): can listen for attribute mutations on other elements"))
|
(hs-cleanup!)
|
||||||
|
(let ((_el-d1 (dom-create-element "div")) (_el-d2 (dom-create-element "div")))
|
||||||
|
(dom-set-attr _el-d1 "id" "d1")
|
||||||
|
(dom-set-attr _el-d2 "id" "d2")
|
||||||
|
(dom-set-attr _el-d2 "_" "on mutation of attributes from #d1 put \"Mutated\" into me")
|
||||||
|
(dom-append (dom-body) _el-d1)
|
||||||
|
(dom-append (dom-body) _el-d2)
|
||||||
|
(hs-activate! _el-d2)
|
||||||
|
))
|
||||||
(deftest "can listen for characterData mutation filter out other mutations"
|
(deftest "can listen for characterData mutation filter out other mutations"
|
||||||
(hs-cleanup!)
|
(hs-cleanup!)
|
||||||
(let ((_el-div (dom-create-element "div")))
|
(let ((_el-div (dom-create-element "div")))
|
||||||
@@ -8867,7 +8880,12 @@
|
|||||||
(hs-activate! _el-div)
|
(hs-activate! _el-div)
|
||||||
))
|
))
|
||||||
(deftest "can listen for childList mutations"
|
(deftest "can listen for childList mutations"
|
||||||
(error "SKIP (skip-list): can listen for childList mutations"))
|
(hs-cleanup!)
|
||||||
|
(let ((_el-div (dom-create-element "div")))
|
||||||
|
(dom-set-attr _el-div "_" "on mutation of childList put \"Mutated\" into me then wait for hyperscript:mutation")
|
||||||
|
(dom-append (dom-body) _el-div)
|
||||||
|
(hs-activate! _el-div)
|
||||||
|
))
|
||||||
(deftest "can listen for events in another element (lazy)"
|
(deftest "can listen for events in another element (lazy)"
|
||||||
(hs-cleanup!)
|
(hs-cleanup!)
|
||||||
(let ((_el-div (dom-create-element "div")) (_el-d1 (dom-create-element "div")) (_el-d2 (dom-create-element "div")))
|
(let ((_el-div (dom-create-element "div")) (_el-d1 (dom-create-element "div")) (_el-d2 (dom-create-element "div")))
|
||||||
@@ -8880,13 +8898,33 @@
|
|||||||
(hs-activate! _el-div)
|
(hs-activate! _el-div)
|
||||||
))
|
))
|
||||||
(deftest "can listen for general mutations"
|
(deftest "can listen for general mutations"
|
||||||
(error "SKIP (skip-list): can listen for general mutations"))
|
(hs-cleanup!)
|
||||||
|
(let ((_el-div (dom-create-element "div")))
|
||||||
|
(dom-set-attr _el-div "_" "on mutation put \"Mutated\" into me then wait for hyperscript:mutation")
|
||||||
|
(dom-append (dom-body) _el-div)
|
||||||
|
(hs-activate! _el-div)
|
||||||
|
))
|
||||||
(deftest "can listen for multiple mutations"
|
(deftest "can listen for multiple mutations"
|
||||||
(error "SKIP (skip-list): can listen for multiple mutations"))
|
(hs-cleanup!)
|
||||||
|
(let ((_el-div (dom-create-element "div")))
|
||||||
|
(dom-set-attr _el-div "_" "on mutation of @foo or @bar put \"Mutated\" into me")
|
||||||
|
(dom-append (dom-body) _el-div)
|
||||||
|
(hs-activate! _el-div)
|
||||||
|
))
|
||||||
(deftest "can listen for multiple mutations 2"
|
(deftest "can listen for multiple mutations 2"
|
||||||
(error "SKIP (skip-list): can listen for multiple mutations 2"))
|
(hs-cleanup!)
|
||||||
|
(let ((_el-div (dom-create-element "div")))
|
||||||
|
(dom-set-attr _el-div "_" "on mutation of @foo or @bar put \"Mutated\" into me")
|
||||||
|
(dom-append (dom-body) _el-div)
|
||||||
|
(hs-activate! _el-div)
|
||||||
|
))
|
||||||
(deftest "can listen for specific attribute mutations"
|
(deftest "can listen for specific attribute mutations"
|
||||||
(error "SKIP (skip-list): can listen for specific attribute mutations"))
|
(hs-cleanup!)
|
||||||
|
(let ((_el-div (dom-create-element "div")))
|
||||||
|
(dom-set-attr _el-div "_" "on mutation of @foo put \"Mutated\" into me")
|
||||||
|
(dom-append (dom-body) _el-div)
|
||||||
|
(hs-activate! _el-div)
|
||||||
|
))
|
||||||
(deftest "can listen for specific attribute mutations and filter out other attribute mutations"
|
(deftest "can listen for specific attribute mutations and filter out other attribute mutations"
|
||||||
(hs-cleanup!)
|
(hs-cleanup!)
|
||||||
(let ((_el-div (dom-create-element "div")))
|
(let ((_el-div (dom-create-element "div")))
|
||||||
|
|||||||
@@ -375,7 +375,115 @@ globalThis.prompt = function(_msg){
|
|||||||
};
|
};
|
||||||
globalThis.Event=Ev; globalThis.CustomEvent=Ev; globalThis.NodeList=Array; globalThis.HTMLCollection=Array;
|
globalThis.Event=Ev; globalThis.CustomEvent=Ev; globalThis.NodeList=Array; globalThis.HTMLCollection=Array;
|
||||||
globalThis.getComputedStyle=(e)=>e?e.style:{}; globalThis.requestAnimationFrame=(f)=>{f();return 0;};
|
globalThis.getComputedStyle=(e)=>e?e.style:{}; globalThis.requestAnimationFrame=(f)=>{f();return 0;};
|
||||||
globalThis.cancelAnimationFrame=()=>{}; globalThis.MutationObserver=class{observe(){}disconnect(){}};
|
globalThis.cancelAnimationFrame=()=>{};
|
||||||
|
// HsMutationObserver — cluster-32 mutation mock. Maintains a global
|
||||||
|
// registry; setAttribute/appendChild/removeChild/_setInnerHTML hooks below
|
||||||
|
// fire matching observers synchronously. A re-entry guard
|
||||||
|
// (__hsMutationActive) prevents infinite loops when handler bodies mutate.
|
||||||
|
globalThis.__hsMutationRegistry = [];
|
||||||
|
globalThis.__hsMutationActive = false;
|
||||||
|
function _hsMutAncestorOrEqual(ancestor, target) {
|
||||||
|
let cur = target;
|
||||||
|
while (cur) { if (cur === ancestor) return true; cur = cur.parentElement; }
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
function _hsMutMatches(reg, rec) {
|
||||||
|
const o = reg.opts;
|
||||||
|
if (!_hsMutAncestorOrEqual(reg.target, rec.target)) return false;
|
||||||
|
if (rec.type === 'attributes') {
|
||||||
|
if (!o.attributes) return false;
|
||||||
|
if (o.attributeFilter && o.attributeFilter.length > 0) {
|
||||||
|
if (!o.attributeFilter.includes(rec.attributeName)) return false;
|
||||||
|
}
|
||||||
|
return true;
|
||||||
|
}
|
||||||
|
if (rec.type === 'childList') return !!o.childList;
|
||||||
|
if (rec.type === 'characterData') return !!o.characterData;
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
function _hsFireMutations(records) {
|
||||||
|
if (globalThis.__hsMutationActive) return;
|
||||||
|
if (!records || records.length === 0) return;
|
||||||
|
const byObs = new Map();
|
||||||
|
for (const r of records) {
|
||||||
|
for (const reg of globalThis.__hsMutationRegistry) {
|
||||||
|
if (!_hsMutMatches(reg, r)) continue;
|
||||||
|
if (!byObs.has(reg.observer)) byObs.set(reg.observer, []);
|
||||||
|
byObs.get(reg.observer).push(r);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (byObs.size === 0) return;
|
||||||
|
globalThis.__hsMutationActive = true;
|
||||||
|
try {
|
||||||
|
for (const [obs, recs] of byObs) {
|
||||||
|
try { obs._cb(recs, obs); } catch (e) {}
|
||||||
|
}
|
||||||
|
} finally {
|
||||||
|
globalThis.__hsMutationActive = false;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
class HsMutationObserver {
|
||||||
|
constructor(cb) { this._cb = cb; this._regs = []; }
|
||||||
|
observe(el, opts) {
|
||||||
|
if (!el) return;
|
||||||
|
// opts is an SX dict: read fields directly. attributeFilter is an SX list
|
||||||
|
// ({_type:'list', items:[...]}) OR a JS array.
|
||||||
|
let af = opts && opts.attributeFilter;
|
||||||
|
if (af && af._type === 'list') af = af.items;
|
||||||
|
const o = {
|
||||||
|
attributes: !!(opts && opts.attributes),
|
||||||
|
childList: !!(opts && opts.childList),
|
||||||
|
characterData: !!(opts && opts.characterData),
|
||||||
|
subtree: !!(opts && opts.subtree),
|
||||||
|
attributeFilter: af || null,
|
||||||
|
};
|
||||||
|
const reg = { observer: this, target: el, opts: o };
|
||||||
|
this._regs.push(reg);
|
||||||
|
globalThis.__hsMutationRegistry.push(reg);
|
||||||
|
}
|
||||||
|
disconnect() {
|
||||||
|
for (const r of this._regs) {
|
||||||
|
const i = globalThis.__hsMutationRegistry.indexOf(r);
|
||||||
|
if (i >= 0) globalThis.__hsMutationRegistry.splice(i, 1);
|
||||||
|
}
|
||||||
|
this._regs = [];
|
||||||
|
}
|
||||||
|
takeRecords() { return []; }
|
||||||
|
}
|
||||||
|
globalThis.MutationObserver = HsMutationObserver;
|
||||||
|
// Hook El prototype methods so mutations fire registered observers.
|
||||||
|
// Hooks are no-ops while __hsMutationActive=true (prevents re-entry from
|
||||||
|
// handler bodies that themselves mutate the DOM).
|
||||||
|
(function _hookElForMutations() {
|
||||||
|
const _setAttr = El.prototype.setAttribute;
|
||||||
|
El.prototype.setAttribute = function(n, v) {
|
||||||
|
const r = _setAttr.call(this, n, v);
|
||||||
|
if (globalThis.__hsMutationRegistry.length)
|
||||||
|
_hsFireMutations([{ type: 'attributes', target: this, attributeName: String(n), oldValue: null }]);
|
||||||
|
return r;
|
||||||
|
};
|
||||||
|
const _append = El.prototype.appendChild;
|
||||||
|
El.prototype.appendChild = function(c) {
|
||||||
|
const r = _append.call(this, c);
|
||||||
|
if (globalThis.__hsMutationRegistry.length)
|
||||||
|
_hsFireMutations([{ type: 'childList', target: this, addedNodes: [c], removedNodes: [] }]);
|
||||||
|
return r;
|
||||||
|
};
|
||||||
|
const _remove = El.prototype.removeChild;
|
||||||
|
El.prototype.removeChild = function(c) {
|
||||||
|
const r = _remove.call(this, c);
|
||||||
|
if (globalThis.__hsMutationRegistry.length)
|
||||||
|
_hsFireMutations([{ type: 'childList', target: this, addedNodes: [], removedNodes: [c] }]);
|
||||||
|
return r;
|
||||||
|
};
|
||||||
|
const _setIH = El.prototype._setInnerHTML;
|
||||||
|
El.prototype._setInnerHTML = function(html) {
|
||||||
|
const r = _setIH.call(this, html);
|
||||||
|
if (globalThis.__hsMutationRegistry.length)
|
||||||
|
_hsFireMutations([{ type: 'childList', target: this, addedNodes: [], removedNodes: [] }]);
|
||||||
|
return r;
|
||||||
|
};
|
||||||
|
})();
|
||||||
// HsResizeObserver — cluster-26 resize mock. Keeps a per-element callback
|
// HsResizeObserver — cluster-26 resize mock. Keeps a per-element callback
|
||||||
// registry so code that observes via `new ResizeObserver(cb)` still works,
|
// registry so code that observes via `new ResizeObserver(cb)` still works,
|
||||||
// but HS's `on resize` uses the plain `resize` DOM event dispatched by the
|
// but HS's `on resize` uses the plain `resize` DOM event dispatched by the
|
||||||
@@ -571,6 +679,8 @@ for(let i=startTest;i<Math.min(endTest,testCount);i++){
|
|||||||
_body.children=[];_body.childNodes=[];_body.innerHTML='';_body.textContent='';
|
_body.children=[];_body.childNodes=[];_body.innerHTML='';_body.textContent='';
|
||||||
globalThis.__test_selection='';
|
globalThis.__test_selection='';
|
||||||
globalThis.__hsCookieStore.clear();
|
globalThis.__hsCookieStore.clear();
|
||||||
|
globalThis.__hsMutationRegistry.length = 0;
|
||||||
|
globalThis.__hsMutationActive = false;
|
||||||
globalThis.__currentHsTestName = name;
|
globalThis.__currentHsTestName = name;
|
||||||
|
|
||||||
// Enable step limit for timeout protection
|
// Enable step limit for timeout protection
|
||||||
|
|||||||
@@ -114,13 +114,6 @@ SKIP_TEST_NAMES = {
|
|||||||
"can filter events based on count range",
|
"can filter events based on count range",
|
||||||
"can filter events based on unbounded count range",
|
"can filter events based on unbounded count range",
|
||||||
"can mix ranges",
|
"can mix ranges",
|
||||||
"can listen for general mutations",
|
|
||||||
"can listen for attribute mutations",
|
|
||||||
"can listen for specific attribute mutations",
|
|
||||||
"can listen for childList mutations",
|
|
||||||
"can listen for multiple mutations",
|
|
||||||
"can listen for multiple mutations 2",
|
|
||||||
"can listen for attribute mutations on other elements",
|
|
||||||
"each behavior installation has its own event queue",
|
"each behavior installation has its own event queue",
|
||||||
"can catch exceptions thrown in js functions",
|
"can catch exceptions thrown in js functions",
|
||||||
"can catch exceptions thrown in hyperscript functions",
|
"can catch exceptions thrown in hyperscript functions",
|
||||||
@@ -1166,6 +1159,32 @@ def parse_dev_body(body, elements, var_names):
|
|||||||
ops.append(f'(if (dom-has-class? {target} "{cls}") (dom-remove-class {target} "{cls}") (dom-add-class {target} "{cls}"))')
|
ops.append(f'(if (dom-has-class? {target} "{cls}") (dom-remove-class {target} "{cls}") (dom-add-class {target} "{cls}"))')
|
||||||
continue
|
continue
|
||||||
|
|
||||||
|
# evaluate(() => document.querySelector(SEL).setAttribute(NAME, VALUE))
|
||||||
|
# — used by mutation tests (cluster 32) to trigger MutationObserver.
|
||||||
|
m = re.match(
|
||||||
|
r'''evaluate\(\s*\(\)\s*=>\s*document\.querySelector\(\s*([\'"])([^\'"]+)\1\s*\)'''
|
||||||
|
r'''\.setAttribute\(\s*([\'"])([\w-]+)\3\s*,\s*([\'"])([^\'"]*)\5\s*\)\s*\)\s*$''',
|
||||||
|
stmt_na, re.DOTALL,
|
||||||
|
)
|
||||||
|
if m and seen_html:
|
||||||
|
sel = re.sub(r'^#work-area\s+', '', m.group(2))
|
||||||
|
target = selector_to_sx(sel, elements, var_names)
|
||||||
|
ops.append(f'(dom-set-attr {target} "{m.group(4)}" "{m.group(6)}")')
|
||||||
|
continue
|
||||||
|
|
||||||
|
# evaluate(() => document.querySelector(SEL).appendChild(document.createElement(TAG)))
|
||||||
|
# — used by mutation childList tests (cluster 32).
|
||||||
|
m = re.match(
|
||||||
|
r'''evaluate\(\s*\(\)\s*=>\s*document\.querySelector\(\s*([\'"])([^\'"]+)\1\s*\)'''
|
||||||
|
r'''\.appendChild\(\s*document\.createElement\(\s*([\'"])([\w-]+)\3\s*\)\s*\)\s*\)\s*$''',
|
||||||
|
stmt_na, re.DOTALL,
|
||||||
|
)
|
||||||
|
if m and seen_html:
|
||||||
|
sel = re.sub(r'^#work-area\s+', '', m.group(2))
|
||||||
|
target = selector_to_sx(sel, elements, var_names)
|
||||||
|
ops.append(f'(dom-append {target} (dom-create-element "{m.group(4)}"))')
|
||||||
|
continue
|
||||||
|
|
||||||
# evaluate(() => { var range = document.createRange();
|
# evaluate(() => { var range = document.createRange();
|
||||||
# var textNode = document.getElementById(ID).firstChild;
|
# var textNode = document.getElementById(ID).firstChild;
|
||||||
# range.setStart(textNode, N); range.setEnd(textNode, M);
|
# range.setStart(textNode, N); range.setEnd(textNode, M);
|
||||||
|
|||||||
Reference in New Issue
Block a user