From 13e0254261397dc4d2b412796f10745c143c7e5e Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 25 Apr 2026 11:52:54 +0000 Subject: [PATCH] HS: MutationObserver mock + on mutation dispatch (+7 tests) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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) --- lib/hyperscript/compiler.sx | 87 ++++++++++---- lib/hyperscript/parser.sx | 87 +++++++------- lib/hyperscript/runtime.sx | 138 +++++++++++++--------- shared/static/wasm/sx/hs-compiler.sx | 87 ++++++++++---- shared/static/wasm/sx/hs-parser.sx | 87 +++++++------- shared/static/wasm/sx/hs-runtime.sx | 138 +++++++++++++--------- spec/tests/test-hyperscript-behavioral.sx | 52 ++++++-- tests/hs-run-filtered.js | 112 +++++++++++++++++- tests/playwright/generate-sx-tests.py | 33 ++++-- 9 files changed, 560 insertions(+), 261 deletions(-) diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index 1e22f874..97f3642e 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -164,7 +164,8 @@ every? catch-info finally-info - having-info) + having-info + of-filter-info) (cond ((<= (len items) 1) (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))))) (let ((on-call (if every? (list (quote hs-on-every) target event-name handler) (list (quote hs-on) target event-name handler)))) - (if - (= event-name "intersection") - (list - (quote do) - on-call + (cond + ((= event-name "mutation") (list - (quote hs-on-intersection-attach!) - target - (if - having-info - (get having-info "margin") - nil) - (if - having-info - (get having-info "threshold") - nil))) - on-call))))))))))) + (quote do) + on-call + (list + (quote hs-on-mutation-attach!) + target + (if + of-filter-info + (get of-filter-info "type") + "any") + (if + 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) (scan-on (rest (rest items)) @@ -210,7 +232,8 @@ every? catch-info finally-info - having-info)) + having-info + of-filter-info)) ((= (first items) :filter) (scan-on (rest (rest items)) @@ -219,7 +242,8 @@ every? catch-info finally-info - having-info)) + having-info + of-filter-info)) ((= (first items) :every) (scan-on (rest (rest items)) @@ -228,7 +252,8 @@ true catch-info finally-info - having-info)) + having-info + of-filter-info)) ((= (first items) :catch) (scan-on (rest (rest items)) @@ -237,7 +262,8 @@ every? (nth items 1) finally-info - having-info)) + having-info + of-filter-info)) ((= (first items) :finally) (scan-on (rest (rest items)) @@ -246,7 +272,8 @@ every? catch-info (nth items 1) - having-info)) + having-info + of-filter-info)) ((= (first items) :having) (scan-on (rest (rest items)) @@ -255,6 +282,17 @@ every? catch-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))) (true (scan-on @@ -264,8 +302,9 @@ every? catch-info finally-info - having-info))))) - (scan-on (rest parts) nil nil false nil nil nil))))) + having-info + of-filter-info))))) + (scan-on (rest parts) nil nil false nil nil nil nil))))) (define emit-send (fn diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index 6dfdaa60..0ed783d8 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -2605,59 +2605,66 @@ (let ((event-name (parse-compound-event-name))) (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 - ((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 - ((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!) + ((source (if (match-kw "from") (parse-expr) nil))) (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 - ((body (parse-cmd-list))) + ((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil))) (let - ((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") + ((body (parse-cmd-list))) (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 - ((parts (if every? (append parts (list :every true)) parts))) + ((parts (list (quote on) event-name))) (let - ((parts (if flt (append parts (list :filter flt)) parts))) + ((parts (if every? (append parts (list :every true)) parts))) (let - ((parts (if source (append parts (list :from source)) parts))) + ((parts (if flt (append parts (list :filter flt)) parts))) (let - ((parts (if having (append parts (list :having having)) parts))) + ((parts (if source (append parts (list :from source)) parts))) (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 - ((parts (if finally-clause (append parts (list :finally finally-clause)) parts))) + ((parts (if having (append parts (list :having having)) parts))) (let - ((parts (append parts (list body)))) - parts)))))))))))))))))) + ((parts (if catch-clause (append parts (list :catch catch-clause)) parts))) + (let + ((parts (if finally-clause (append parts (list :finally finally-clause)) parts))) + (let + ((parts (append parts (list body)))) + parts)))))))))))))))))))) (define parse-init-feat (fn diff --git a/lib/hyperscript/runtime.sx b/lib/hyperscript/runtime.sx index bcfce8cb..18a1e9ac 100644 --- a/lib/hyperscript/runtime.sx +++ b/lib/hyperscript/runtime.sx @@ -82,14 +82,36 @@ observer))))) ;; 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 ────────────────────────────────────────── ;; 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. +(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 (define hs-wait-for @@ -102,21 +124,20 @@ (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 ─────────────────────────────────────────────── ;; Put content at a position relative to a target. ;; pos: "into" | "before" | "after" -(define - hs-toggle-class! - (fn (target cls) (host-call (host-get target "classList") "toggle" cls))) +(define hs-settle (fn (target) (perform (list (quote io-settle) target)))) ;; ── Navigation / traversal ────────────────────────────────────── ;; 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 hs-toggle-between! (fn @@ -126,7 +147,7 @@ (do (dom-remove-class target cls1) (dom-add-class target cls2)) (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 hs-toggle-style! (fn @@ -150,7 +171,7 @@ (dom-set-style target prop "hidden") (dom-set-style target prop ""))))))) -;; Find previous sibling matching a selector. +;; First element matching selector within a scope. (define hs-toggle-style-between! (fn @@ -162,7 +183,7 @@ (dom-set-style target prop val2) (dom-set-style target prop val1))))) -;; First element matching selector within a scope. +;; Last element matching selector. (define hs-toggle-style-cycle! (fn @@ -183,7 +204,7 @@ (true (find-next (rest remaining)))))) (dom-set-style target prop (find-next vals))))) -;; Last element matching selector. +;; First/last within a specific scope. (define hs-take! (fn @@ -223,7 +244,6 @@ (dom-set-attr target name attr-val) (dom-set-attr target name "")))))))) -;; First/last within a specific scope. (begin (define hs-element? @@ -335,6 +355,9 @@ (dom-insert-adjacent-html target "beforeend" value) (hs-boot-subtree! target))))))))) +;; ── Iteration ─────────────────────────────────────────────────── + +;; Repeat a thunk N times. (define hs-add-to! (fn @@ -347,9 +370,7 @@ (append target (list value)))) (true (do (host-call target "push" value) target))))) -;; ── Iteration ─────────────────────────────────────────────────── - -;; Repeat a thunk N times. +;; Repeat forever (until break — relies on exception/continuation). (define hs-remove-from! (fn @@ -359,7 +380,10 @@ (filter (fn (x) (not (= x value))) target) (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 hs-splice-at! (fn @@ -383,10 +407,10 @@ (host-call target "splice" i 1)))) target)))) -;; ── Fetch ─────────────────────────────────────────────────────── +;; ── Type coercion ─────────────────────────────────────────────── -;; Fetch a URL, parse response according to format. -;; (hs-fetch url format) — format is "json" | "text" | "html" +;; Coerce a value to a type by name. +;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc. (define hs-index (fn @@ -398,10 +422,10 @@ ((string? obj) (nth obj key)) (true (host-get obj key))))) -;; ── Type coercion ─────────────────────────────────────────────── +;; ── Object creation ───────────────────────────────────────────── -;; Coerce a value to a type by name. -;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc. +;; Make a new object of a given type. +;; (hs-make type-name) — creates empty object/collection (define hs-put-at! (fn @@ -423,10 +447,11 @@ ((= pos "start") (host-call target "unshift" value))) target))))))) -;; ── Object creation ───────────────────────────────────────────── +;; ── Behavior installation ─────────────────────────────────────── -;; Make a new object of a given type. -;; (hs-make type-name) — creates empty object/collection +;; Install a behavior on an element. +;; A behavior is a function that takes (me ...params) and sets up features. +;; (hs-install behavior-fn me ...args) (define hs-dict-without (fn @@ -447,27 +472,27 @@ (host-call (host-global "Reflect") "deleteProperty" out key) out))))) -;; ── Behavior installation ─────────────────────────────────────── +;; ── Measurement ───────────────────────────────────────────────── -;; Install a behavior on an element. -;; A behavior is a function that takes (me ...params) and sets up features. -;; (hs-install behavior-fn me ...args) +;; Measure an element's bounding rect, store as local variables. +;; Returns a dict with x, y, width, height, top, left, right, bottom. (define hs-set-on! (fn (props target) (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 ;; `window.getSelection().toString()`. In the mock test runner, a test ;; setup stashes the desired selection text at `window.__test_selection` ;; 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 hs-ask (fn @@ -476,11 +501,6 @@ ((w (host-global "window"))) (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 hs-answer (fn @@ -634,6 +654,10 @@ hs-query-all (fn (sel) (host-call (dom-body) "querySelectorAll" sel))) + + + + (define hs-query-all-in (fn @@ -643,25 +667,21 @@ (hs-query-all sel) (host-call target "querySelectorAll" sel)))) - - - - (define hs-list-set (fn (lst idx val) (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 ────────────────────────────── ;; 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 hs-query-first (fn (sel) (host-call (host-global "document") "querySelector" sel))) -;; DOM query stub — sandbox returns empty list +;; Method dispatch — obj.method(args) (define hs-query-last (fn @@ -669,11 +689,11 @@ (let ((all (dom-query-all (dom-body) sel))) (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 ───────────────────────────────────────────── ;; 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 hs-last (fn @@ -681,7 +701,7 @@ (let ((all (dom-query-all scope sel))) (if (> (len all) 0) (nth all (- (len all) 1)) nil)))) -;; Property-based is — check obj.key truthiness +;; Array slicing (inclusive both ends) (define hs-repeat-times (fn @@ -699,7 +719,7 @@ ((= signal "hs-continue") (do-repeat (+ i 1))) (true (do-repeat (+ i 1)))))))) (do-repeat 0))) -;; Array slicing (inclusive both ends) +;; Collection: sorted by (define hs-repeat-forever (fn @@ -715,7 +735,7 @@ ((= signal "hs-continue") (do-forever)) (true (do-forever)))))) (do-forever))) -;; Collection: sorted by +;; Collection: sorted by descending (define hs-repeat-while (fn @@ -728,7 +748,7 @@ ((= signal "hs-break") nil) ((= signal "hs-continue") (hs-repeat-while cond-fn thunk)) (true (hs-repeat-while cond-fn thunk))))))) -;; Collection: sorted by descending +;; Collection: split by (define hs-repeat-until (fn @@ -740,7 +760,7 @@ ((= signal "hs-continue") (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 hs-for-each (fn @@ -760,7 +780,7 @@ ((= signal "hs-continue") (do-loop (rest remaining))) (true (do-loop (rest remaining)))))))) (do-loop items)))) -;; Collection: joined by + (begin (define hs-append diff --git a/shared/static/wasm/sx/hs-compiler.sx b/shared/static/wasm/sx/hs-compiler.sx index 1e22f874..97f3642e 100644 --- a/shared/static/wasm/sx/hs-compiler.sx +++ b/shared/static/wasm/sx/hs-compiler.sx @@ -164,7 +164,8 @@ every? catch-info finally-info - having-info) + having-info + of-filter-info) (cond ((<= (len items) 1) (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))))) (let ((on-call (if every? (list (quote hs-on-every) target event-name handler) (list (quote hs-on) target event-name handler)))) - (if - (= event-name "intersection") - (list - (quote do) - on-call + (cond + ((= event-name "mutation") (list - (quote hs-on-intersection-attach!) - target - (if - having-info - (get having-info "margin") - nil) - (if - having-info - (get having-info "threshold") - nil))) - on-call))))))))))) + (quote do) + on-call + (list + (quote hs-on-mutation-attach!) + target + (if + of-filter-info + (get of-filter-info "type") + "any") + (if + 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) (scan-on (rest (rest items)) @@ -210,7 +232,8 @@ every? catch-info finally-info - having-info)) + having-info + of-filter-info)) ((= (first items) :filter) (scan-on (rest (rest items)) @@ -219,7 +242,8 @@ every? catch-info finally-info - having-info)) + having-info + of-filter-info)) ((= (first items) :every) (scan-on (rest (rest items)) @@ -228,7 +252,8 @@ true catch-info finally-info - having-info)) + having-info + of-filter-info)) ((= (first items) :catch) (scan-on (rest (rest items)) @@ -237,7 +262,8 @@ every? (nth items 1) finally-info - having-info)) + having-info + of-filter-info)) ((= (first items) :finally) (scan-on (rest (rest items)) @@ -246,7 +272,8 @@ every? catch-info (nth items 1) - having-info)) + having-info + of-filter-info)) ((= (first items) :having) (scan-on (rest (rest items)) @@ -255,6 +282,17 @@ every? catch-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))) (true (scan-on @@ -264,8 +302,9 @@ every? catch-info finally-info - having-info))))) - (scan-on (rest parts) nil nil false nil nil nil))))) + having-info + of-filter-info))))) + (scan-on (rest parts) nil nil false nil nil nil nil))))) (define emit-send (fn diff --git a/shared/static/wasm/sx/hs-parser.sx b/shared/static/wasm/sx/hs-parser.sx index 6dfdaa60..0ed783d8 100644 --- a/shared/static/wasm/sx/hs-parser.sx +++ b/shared/static/wasm/sx/hs-parser.sx @@ -2605,59 +2605,66 @@ (let ((event-name (parse-compound-event-name))) (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 - ((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 - ((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!) + ((source (if (match-kw "from") (parse-expr) nil))) (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 - ((body (parse-cmd-list))) + ((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil))) (let - ((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") + ((body (parse-cmd-list))) (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 - ((parts (if every? (append parts (list :every true)) parts))) + ((parts (list (quote on) event-name))) (let - ((parts (if flt (append parts (list :filter flt)) parts))) + ((parts (if every? (append parts (list :every true)) parts))) (let - ((parts (if source (append parts (list :from source)) parts))) + ((parts (if flt (append parts (list :filter flt)) parts))) (let - ((parts (if having (append parts (list :having having)) parts))) + ((parts (if source (append parts (list :from source)) parts))) (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 - ((parts (if finally-clause (append parts (list :finally finally-clause)) parts))) + ((parts (if having (append parts (list :having having)) parts))) (let - ((parts (append parts (list body)))) - parts)))))))))))))))))) + ((parts (if catch-clause (append parts (list :catch catch-clause)) parts))) + (let + ((parts (if finally-clause (append parts (list :finally finally-clause)) parts))) + (let + ((parts (append parts (list body)))) + parts)))))))))))))))))))) (define parse-init-feat (fn diff --git a/shared/static/wasm/sx/hs-runtime.sx b/shared/static/wasm/sx/hs-runtime.sx index bcfce8cb..18a1e9ac 100644 --- a/shared/static/wasm/sx/hs-runtime.sx +++ b/shared/static/wasm/sx/hs-runtime.sx @@ -82,14 +82,36 @@ observer))))) ;; 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 ────────────────────────────────────────── ;; 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. +(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 (define hs-wait-for @@ -102,21 +124,20 @@ (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 ─────────────────────────────────────────────── ;; Put content at a position relative to a target. ;; pos: "into" | "before" | "after" -(define - hs-toggle-class! - (fn (target cls) (host-call (host-get target "classList") "toggle" cls))) +(define hs-settle (fn (target) (perform (list (quote io-settle) target)))) ;; ── Navigation / traversal ────────────────────────────────────── ;; 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 hs-toggle-between! (fn @@ -126,7 +147,7 @@ (do (dom-remove-class target cls1) (dom-add-class target cls2)) (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 hs-toggle-style! (fn @@ -150,7 +171,7 @@ (dom-set-style target prop "hidden") (dom-set-style target prop ""))))))) -;; Find previous sibling matching a selector. +;; First element matching selector within a scope. (define hs-toggle-style-between! (fn @@ -162,7 +183,7 @@ (dom-set-style target prop val2) (dom-set-style target prop val1))))) -;; First element matching selector within a scope. +;; Last element matching selector. (define hs-toggle-style-cycle! (fn @@ -183,7 +204,7 @@ (true (find-next (rest remaining)))))) (dom-set-style target prop (find-next vals))))) -;; Last element matching selector. +;; First/last within a specific scope. (define hs-take! (fn @@ -223,7 +244,6 @@ (dom-set-attr target name attr-val) (dom-set-attr target name "")))))))) -;; First/last within a specific scope. (begin (define hs-element? @@ -335,6 +355,9 @@ (dom-insert-adjacent-html target "beforeend" value) (hs-boot-subtree! target))))))))) +;; ── Iteration ─────────────────────────────────────────────────── + +;; Repeat a thunk N times. (define hs-add-to! (fn @@ -347,9 +370,7 @@ (append target (list value)))) (true (do (host-call target "push" value) target))))) -;; ── Iteration ─────────────────────────────────────────────────── - -;; Repeat a thunk N times. +;; Repeat forever (until break — relies on exception/continuation). (define hs-remove-from! (fn @@ -359,7 +380,10 @@ (filter (fn (x) (not (= x value))) target) (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 hs-splice-at! (fn @@ -383,10 +407,10 @@ (host-call target "splice" i 1)))) target)))) -;; ── Fetch ─────────────────────────────────────────────────────── +;; ── Type coercion ─────────────────────────────────────────────── -;; Fetch a URL, parse response according to format. -;; (hs-fetch url format) — format is "json" | "text" | "html" +;; Coerce a value to a type by name. +;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc. (define hs-index (fn @@ -398,10 +422,10 @@ ((string? obj) (nth obj key)) (true (host-get obj key))))) -;; ── Type coercion ─────────────────────────────────────────────── +;; ── Object creation ───────────────────────────────────────────── -;; Coerce a value to a type by name. -;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc. +;; Make a new object of a given type. +;; (hs-make type-name) — creates empty object/collection (define hs-put-at! (fn @@ -423,10 +447,11 @@ ((= pos "start") (host-call target "unshift" value))) target))))))) -;; ── Object creation ───────────────────────────────────────────── +;; ── Behavior installation ─────────────────────────────────────── -;; Make a new object of a given type. -;; (hs-make type-name) — creates empty object/collection +;; Install a behavior on an element. +;; A behavior is a function that takes (me ...params) and sets up features. +;; (hs-install behavior-fn me ...args) (define hs-dict-without (fn @@ -447,27 +472,27 @@ (host-call (host-global "Reflect") "deleteProperty" out key) out))))) -;; ── Behavior installation ─────────────────────────────────────── +;; ── Measurement ───────────────────────────────────────────────── -;; Install a behavior on an element. -;; A behavior is a function that takes (me ...params) and sets up features. -;; (hs-install behavior-fn me ...args) +;; Measure an element's bounding rect, store as local variables. +;; Returns a dict with x, y, width, height, top, left, right, bottom. (define hs-set-on! (fn (props target) (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 ;; `window.getSelection().toString()`. In the mock test runner, a test ;; setup stashes the desired selection text at `window.__test_selection` ;; 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 hs-ask (fn @@ -476,11 +501,6 @@ ((w (host-global "window"))) (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 hs-answer (fn @@ -634,6 +654,10 @@ hs-query-all (fn (sel) (host-call (dom-body) "querySelectorAll" sel))) + + + + (define hs-query-all-in (fn @@ -643,25 +667,21 @@ (hs-query-all sel) (host-call target "querySelectorAll" sel)))) - - - - (define hs-list-set (fn (lst idx val) (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 ────────────────────────────── ;; 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 hs-query-first (fn (sel) (host-call (host-global "document") "querySelector" sel))) -;; DOM query stub — sandbox returns empty list +;; Method dispatch — obj.method(args) (define hs-query-last (fn @@ -669,11 +689,11 @@ (let ((all (dom-query-all (dom-body) sel))) (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 ───────────────────────────────────────────── ;; 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 hs-last (fn @@ -681,7 +701,7 @@ (let ((all (dom-query-all scope sel))) (if (> (len all) 0) (nth all (- (len all) 1)) nil)))) -;; Property-based is — check obj.key truthiness +;; Array slicing (inclusive both ends) (define hs-repeat-times (fn @@ -699,7 +719,7 @@ ((= signal "hs-continue") (do-repeat (+ i 1))) (true (do-repeat (+ i 1)))))))) (do-repeat 0))) -;; Array slicing (inclusive both ends) +;; Collection: sorted by (define hs-repeat-forever (fn @@ -715,7 +735,7 @@ ((= signal "hs-continue") (do-forever)) (true (do-forever)))))) (do-forever))) -;; Collection: sorted by +;; Collection: sorted by descending (define hs-repeat-while (fn @@ -728,7 +748,7 @@ ((= signal "hs-break") nil) ((= signal "hs-continue") (hs-repeat-while cond-fn thunk)) (true (hs-repeat-while cond-fn thunk))))))) -;; Collection: sorted by descending +;; Collection: split by (define hs-repeat-until (fn @@ -740,7 +760,7 @@ ((= signal "hs-continue") (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 hs-for-each (fn @@ -760,7 +780,7 @@ ((= signal "hs-continue") (do-loop (rest remaining))) (true (do-loop (rest remaining)))))))) (do-loop items)))) -;; Collection: joined by + (begin (define hs-append diff --git a/spec/tests/test-hyperscript-behavioral.sx b/spec/tests/test-hyperscript-behavioral.sx index ee391c9b..ed8572b7 100644 --- a/spec/tests/test-hyperscript-behavioral.sx +++ b/spec/tests/test-hyperscript-behavioral.sx @@ -8849,9 +8849,22 @@ (hs-activate! _el-div) )) (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" - (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" (hs-cleanup!) (let ((_el-div (dom-create-element "div"))) @@ -8867,7 +8880,12 @@ (hs-activate! _el-div) )) (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)" (hs-cleanup!) (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) )) (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" - (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" - (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" - (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" (hs-cleanup!) (let ((_el-div (dom-create-element "div"))) diff --git a/tests/hs-run-filtered.js b/tests/hs-run-filtered.js index 59256e33..9a5f02db 100755 --- a/tests/hs-run-filtered.js +++ b/tests/hs-run-filtered.js @@ -375,7 +375,115 @@ globalThis.prompt = function(_msg){ }; 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.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 // 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 @@ -571,6 +679,8 @@ for(let i=startTest;i 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(); # var textNode = document.getElementById(ID).firstChild; # range.setStart(textNode, N); range.setEnd(textNode, M);