HS: MutationObserver mock + on mutation dispatch (+7 tests)
Parser: parse-on-feat now consumes `of FILTER` after `mutation` event-name, where FILTER is `attributes`/`childList`/`characterData` ident or `@a [or @b]*` attr-token chain. Emits :of-filter dict on parts. Compiler: scan-on threads of-filter-info; mutation event-name emits `(do (hs-on …) (hs-on-mutation-attach! TARGET MODE ATTRS))`. Runtime: hs-on-mutation-attach! constructs a real MutationObserver with config matched to filter and dispatches "mutation" event with records detail. Runner: HsMutationObserver mock with global registry; prototype hooks on El.setAttribute/appendChild/removeChild/_setInnerHTML fire matching observers synchronously, with __hsMutationActive guard preventing recursion. Generator: dropped 7 mutation tests from skip-list, added evaluate(setAttribute) and evaluate(appendChild) body patterns. hs-upstream-on: 36/70 → 43/70. Smoke 0-195 unchanged at 170/195. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -164,7 +164,8 @@
|
||||
every?
|
||||
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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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")))
|
||||
|
||||
@@ -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<Math.min(endTest,testCount);i++){
|
||||
_body.children=[];_body.childNodes=[];_body.innerHTML='';_body.textContent='';
|
||||
globalThis.__test_selection='';
|
||||
globalThis.__hsCookieStore.clear();
|
||||
globalThis.__hsMutationRegistry.length = 0;
|
||||
globalThis.__hsMutationActive = false;
|
||||
globalThis.__currentHsTestName = name;
|
||||
|
||||
// Enable step limit for timeout protection
|
||||
|
||||
@@ -114,13 +114,6 @@ SKIP_TEST_NAMES = {
|
||||
"can filter events based on count range",
|
||||
"can filter events based on unbounded count range",
|
||||
"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",
|
||||
"can catch exceptions thrown in js 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}"))')
|
||||
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();
|
||||
# var textNode = document.getElementById(ID).firstChild;
|
||||
# range.setStart(textNode, N); range.setEnd(textNode, M);
|
||||
|
||||
Reference in New Issue
Block a user