From bd821c044501478d4ad2e31f38c0634a016e1292 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 24 Apr 2026 06:35:30 +0000 Subject: [PATCH] HS: toggle multi-class + until event (+2 tests) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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) --- lib/hyperscript/compiler.sx | 14 ++++++++ lib/hyperscript/parser.sx | 45 +++++++++++++++++++---- shared/static/wasm/sx/hs-compiler.sx | 14 ++++++++ shared/static/wasm/sx/hs-parser.sx | 53 ++++++++++++++++++++-------- 4 files changed, 104 insertions(+), 22 deletions(-) diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index f00d6fef..e34fa5e0 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -1426,6 +1426,20 @@ (quote hs-toggle-class!) (hs-to-sx (nth ast 2)) (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)) (list (quote hs-set-on!) diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index 233eb9b7..aba0bf5d 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -1132,14 +1132,45 @@ ((= (tp-type) "class") (let ((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 - ((tgt (parse-tgt-kw "on" (list (quote me))))) - (if - (match-kw "for") - (let - ((dur (parse-expr))) - (list (quote toggle-class-for) cls tgt dur)) - (list (quote toggle-class) cls tgt))))) + ((extra-classes (collect-classes (list)))) + (let + ((tgt (parse-tgt-kw "on" (list (quote me))))) + (cond + ((> (len extra-classes) 0) + (list + (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") (let ((prop (get (adv!) "value"))) diff --git a/shared/static/wasm/sx/hs-compiler.sx b/shared/static/wasm/sx/hs-compiler.sx index f00d6fef..e34fa5e0 100644 --- a/shared/static/wasm/sx/hs-compiler.sx +++ b/shared/static/wasm/sx/hs-compiler.sx @@ -1426,6 +1426,20 @@ (quote hs-toggle-class!) (hs-to-sx (nth ast 2)) (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)) (list (quote hs-set-on!) diff --git a/shared/static/wasm/sx/hs-parser.sx b/shared/static/wasm/sx/hs-parser.sx index 30523f26..aba0bf5d 100644 --- a/shared/static/wasm/sx/hs-parser.sx +++ b/shared/static/wasm/sx/hs-parser.sx @@ -1132,14 +1132,45 @@ ((= (tp-type) "class") (let ((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 - ((tgt (parse-tgt-kw "on" (list (quote me))))) - (if - (match-kw "for") - (let - ((dur (parse-expr))) - (list (quote toggle-class-for) cls tgt dur)) - (list (quote toggle-class) cls tgt))))) + ((extra-classes (collect-classes (list)))) + (let + ((tgt (parse-tgt-kw "on" (list (quote me))))) + (cond + ((> (len extra-classes) 0) + (list + (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") (let ((prop (get (adv!) "value"))) @@ -2472,14 +2503,6 @@ (let ((acc2 (append acc (list cmd)))) (cond - ((match-kw "unless") - (let - ((cnd (parse-expr))) - (cl-collect - (append - acc - (list - (list (quote if) (list (quote no) cnd) cmd)))))) ((match-kw "then") (cl-collect (append acc2 (list (quote __then__))))) ((and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val)))