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

HS: toggle multi-class + until event (+2 tests)

Browse Source 
Parser `parse-toggle-cmd`: after the leading class ref, collect any
additional class refs and treat `toggle .foo .bar` as `toggle-between`
(pair-only). Recognise a `until EVENT [from SOURCE]` modifier and emit
a new `toggle-class-until` AST node. Compiler handles the new node by
emitting `(begin (hs-toggle-class! tgt cls) (hs-wait-for src ev)
(hs-toggle-class! tgt cls))` which uses the existing event-waiter
machinery to flip the class back when the specified event fires.

Remaining toggle test (`can toggle for a fixed amount of time`)
depends on the mock's sync io-sleep resuming immediately — the click
handler toggles on/off synchronously, so the pre-timeout assertion
can never see the `.foo` class present. Needs an async scheduler in
the mock to handle.

Suite hs-upstream-toggle: 22/25 → 24/25. Smoke 0-195: 162/195
unchanged.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-24 06:35:30 +00:00
parent 16df723e08
commit bd821c0445
4 changed files with 104 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
lib/hyperscript/compiler.sx
View File

@@ -1426,6 +1426,20 @@
(quote hs-toggle-class!) (quote hs-toggle-class!)
(hs-to-sx (nth ast 2)) (hs-to-sx (nth ast 2))
(nth ast 1)))) (nth ast 1))))
((= head (quote toggle-class-until))
(let
((cls (nth ast 1))
(tgt (hs-to-sx (nth ast 2)))
(event-name (nth ast 3))
(source (nth ast 4)))
(list
(quote do)
(list (quote hs-toggle-class!) tgt cls)
(list
(quote hs-wait-for)
(if source (hs-to-sx source) (quote me))
event-name)
(list (quote hs-toggle-class!) tgt cls))))
((= head (quote set-on)) ((= head (quote set-on))
(list (list
(quote hs-set-on!) (quote hs-set-on!)

45
lib/hyperscript/parser.sx
View File

@@ -1132,14 +1132,45 @@
((= (tp-type) "class") ((= (tp-type) "class")
(let (let
((cls (do (let ((v (tp-val))) (adv!) v)))) ((cls (do (let ((v (tp-val))) (adv!) v))))
(define
collect-classes
(fn
(acc)
(if
(= (tp-type) "class")
(let
((v (tp-val)))
(adv!)
(collect-classes (append acc (list v))))
acc)))
(let (let
((tgt (parse-tgt-kw "on" (list (quote me))))) ((extra-classes (collect-classes (list))))
(if (let
(match-kw "for") ((tgt (parse-tgt-kw "on" (list (quote me)))))
(let (cond
((dur (parse-expr))) ((> (len extra-classes) 0)
(list (quote toggle-class-for) cls tgt dur)) (list
(list (quote toggle-class) cls tgt))))) (quote toggle-between)
cls
(first extra-classes)
tgt))
((match-kw "for")
(let
((dur (parse-expr)))
(list (quote toggle-class-for) cls tgt dur)))
((match-kw "until")
(let
((event-name (tp-val)))
(adv!)
(let
((source (if (match-kw "from") (parse-expr) nil)))
(list
(quote toggle-class-until)
cls
tgt
event-name
source))))
(true (list (quote toggle-class) cls tgt)))))))
((= (tp-type) "style") ((= (tp-type) "style")
(let (let
((prop (get (adv!) "value"))) ((prop (get (adv!) "value")))

14
shared/static/wasm/sx/hs-compiler.sx
View File

@@ -1426,6 +1426,20 @@
(quote hs-toggle-class!) (quote hs-toggle-class!)
(hs-to-sx (nth ast 2)) (hs-to-sx (nth ast 2))
(nth ast 1)))) (nth ast 1))))
((= head (quote toggle-class-until))
(let
((cls (nth ast 1))
(tgt (hs-to-sx (nth ast 2)))
(event-name (nth ast 3))
(source (nth ast 4)))
(list
(quote do)
(list (quote hs-toggle-class!) tgt cls)
(list
(quote hs-wait-for)
(if source (hs-to-sx source) (quote me))
event-name)
(list (quote hs-toggle-class!) tgt cls))))
((= head (quote set-on)) ((= head (quote set-on))
(list (list
(quote hs-set-on!) (quote hs-set-on!)

53
shared/static/wasm/sx/hs-parser.sx
View File

@@ -1132,14 +1132,45 @@
((= (tp-type) "class") ((= (tp-type) "class")
(let (let
((cls (do (let ((v (tp-val))) (adv!) v)))) ((cls (do (let ((v (tp-val))) (adv!) v))))
(define
collect-classes
(fn
(acc)
(if
(= (tp-type) "class")
(let
((v (tp-val)))
(adv!)
(collect-classes (append acc (list v))))
acc)))
(let (let
((tgt (parse-tgt-kw "on" (list (quote me))))) ((extra-classes (collect-classes (list))))
(if (let
(match-kw "for") ((tgt (parse-tgt-kw "on" (list (quote me)))))
(let (cond
((dur (parse-expr))) ((> (len extra-classes) 0)
(list (quote toggle-class-for) cls tgt dur)) (list
(list (quote toggle-class) cls tgt))))) (quote toggle-between)
cls
(first extra-classes)
tgt))
((match-kw "for")
(let
((dur (parse-expr)))
(list (quote toggle-class-for) cls tgt dur)))
((match-kw "until")
(let
((event-name (tp-val)))
(adv!)
(let
((source (if (match-kw "from") (parse-expr) nil)))
(list
(quote toggle-class-until)
cls
tgt
event-name
source))))
(true (list (quote toggle-class) cls tgt)))))))
((= (tp-type) "style") ((= (tp-type) "style")
(let (let
((prop (get (adv!) "value"))) ((prop (get (adv!) "value")))
@@ -2472,14 +2503,6 @@
(let (let
((acc2 (append acc (list cmd)))) ((acc2 (append acc (list cmd))))
(cond (cond
((match-kw "unless")
(let
((cnd (parse-expr)))
(cl-collect
(append
acc
(list
(list (quote if) (list (quote no) cnd) cmd))))))
((match-kw "then") ((match-kw "then")
(cl-collect (append acc2 (list (quote __then__))))) (cl-collect (append acc2 (list (quote __then__)))))
((and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val))) ((and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val)))