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:
2026-04-25 11:52:54 +00:00
parent 1340284bc8
commit 13e0254261
9 changed files with 560 additions and 261 deletions

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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")))

View File

@@ -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

View File

@@ -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);