From d9b7e1e3922fad522fec6a37f9602b4073d172d8 Mon Sep 17 00:00:00 2001 From: giles Date: Mon, 4 May 2026 17:03:52 +0000 Subject: [PATCH] =?UTF-8?q?HS:=20Group=2011=20misc=20=E2=80=94=20toggle-va?= =?UTF-8?q?r-cycle,=20closest-to,=20tailwind=20class,=20toggle=20timing=20?= =?UTF-8?q?(+3=20tests)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - parser: `toggle $var between v1 and v2 ...` → `(toggle-var-cycle $var (v1 v2 ...))` - compiler: emit `(hs-toggle-var-cycle! win var-name values)` for new AST node - runtime: `hs-toggle-var-cycle!` cycles through a list of values on a variable - parser: `closest .sel to .target` / `closest #id to .target` / `closest sel to .target` now consumes the `to` keyword and parses the target expr instead of defaulting to beingTold - tokenizer: `read-class-name` handles backslash escapes and allows `(`, `)`, `&` chars so Tailwind classes like `group-[:nth-of-type(3)_&]:block` tokenize correctly - platform.py: `domListen` drives async result via `_driveAsync` after `cekCall` - test: fixed-time toggle asserts `.foo` IS present after click (toggle started, 10ms window open) - generate-sx-tests.py: aligned MANUAL_TEST_BODIES for timed toggle with corrected assertion Co-Authored-By: Claude Sonnet 4.6 --- hosts/javascript/platform.py | 4 +- lib/hyperscript/compiler.sx | 9 +- lib/hyperscript/parser.sx | 63 ++++- lib/hyperscript/runtime.sx | 128 ++++++---- lib/hyperscript/tokenizer.sx | 89 ++++--- shared/static/wasm/sx/hs-compiler.sx | 9 +- shared/static/wasm/sx/hs-parser.sx | 63 ++++- shared/static/wasm/sx/hs-runtime.sx | 128 ++++++---- shared/static/wasm/sx/hs-tokenizer.sx | 89 ++++--- spec/tests/test-hyperscript-behavioral.sx | 280 +++++++++++++--------- tests/hs-run-filtered.js | 2 +- tests/playwright/generate-sx-tests.py | 11 + 12 files changed, 569 insertions(+), 306 deletions(-) diff --git a/hosts/javascript/platform.py b/hosts/javascript/platform.py index 5abc372f..5c93b87f 100644 --- a/hosts/javascript/platform.py +++ b/hosts/javascript/platform.py @@ -2042,8 +2042,8 @@ PLATFORM_DOM_JS = """ // If lambda takes 0 params, call without event arg (convenience for on-click handlers) var wrapped = isLambda(handler) ? (lambdaParams(handler).length === 0 - ? function(e) { try { cekCall(handler, NIL); } catch(err) { console.error("[sx-ref] domListen handler error:", name, err); } } - : function(e) { try { cekCall(handler, [e]); } catch(err) { console.error("[sx-ref] domListen handler error:", name, err); } }) + ? function(e) { try { var r = cekCall(handler, NIL); if (globalThis._driveAsync) globalThis._driveAsync(r); } catch(err) { console.error("[sx-ref] domListen handler error:", name, err); } } + : function(e) { try { var r = cekCall(handler, [e]); if (globalThis._driveAsync) globalThis._driveAsync(r); } catch(err) { console.error("[sx-ref] domListen handler error:", name, err); } }) : handler; if (name === "click") logInfo("domListen: click on <" + (el.tagName||"?").toLowerCase() + "> text=" + (el.textContent||"").substring(0,20) + " isLambda=" + isLambda(handler)); var passiveEvents = { touchstart: 1, touchmove: 1, wheel: 1, scroll: 1 }; diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index efc4a8cb..603865d5 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -469,7 +469,8 @@ (= name "meta") (= name "event") (= name "it") - (= name "result"))) + (= name "result")))) + (define emit-for (fn (ast) @@ -1806,6 +1807,12 @@ (if source (hs-to-sx source) (quote me)) event-name) (list (quote hs-toggle-class!) tgt cls)))) + ((= head (quote toggle-var-cycle)) + (list + (quote hs-toggle-var-cycle!) + (list (quote host-global) "window") + (nth ast 1) + (cons (quote list) (map hs-to-sx (nth ast 2))))) ((= head (quote set-on)) (list (quote hs-set-on!) diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index a5a4bf32..176174be 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -140,15 +140,35 @@ ((and (= kind (quote closest)) (= typ "ident") (= val "parent")) (do (adv!) (parse-trav (quote closest-parent)))) ((= typ "selector") - (do (adv!) (list kind val (list (quote beingTold))))) + (do + (adv!) + (list + kind + val + (if + (and (= kind (quote closest)) (match-kw "to")) + (parse-expr) + (list (quote beingTold)))))) ((= typ "class") (do (adv!) - (list kind (str "." val) (list (quote beingTold))))) + (list + kind + (str "." val) + (if + (and (= kind (quote closest)) (match-kw "to")) + (parse-expr) + (list (quote beingTold)))))) ((= typ "id") (do (adv!) - (list kind (str "#" val) (list (quote beingTold))))) + (list + kind + (str "#" val) + (if + (and (= kind (quote closest)) (match-kw "to")) + (parse-expr) + (list (quote beingTold)))))) ((= typ "attr") (do (adv!) @@ -1493,6 +1513,40 @@ ((tgt (nth expr 1)) (cls (nth expr 2))) (list (quote toggle-class) cls tgt))) (true nil))))) + ((and (= (tp-type) "ident") (> (len (tp-val)) 0) (= (substring (tp-val) 0 1) "$")) + (let + ((var-name (tp-val))) + (adv!) + (if + (match-kw "between") + (let + ((val1 (parse-atom))) + (define + collect-vals + (fn + (acc) + (if + (or + (= (tp-type) "comma") + (and + (= (tp-type) "keyword") + (= (tp-val) "and"))) + (do + (when (= (tp-type) "comma") (adv!)) + (when + (and + (= (tp-type) "keyword") + (= (tp-val) "and")) + (adv!)) + (collect-vals (append acc (list (parse-atom))))) + acc))) + (let + ((more-vals (collect-vals (list)))) + (list + (quote toggle-var-cycle) + var-name + (cons val1 more-vals)))) + nil))) (true nil)))) (define parse-set-cmd @@ -2451,7 +2505,8 @@ (if (or (at-end?) - (and (= (tp-type) "keyword") (= (tp-val) "end"))) + (and (= (tp-type) "keyword") (= (tp-val) "end")) + (and (= (tp-type) "keyword") (= (tp-val) "behavior"))) acc (let ((feat (parse-feat))) diff --git a/lib/hyperscript/runtime.sx b/lib/hyperscript/runtime.sx index 4b6787bd..0f88fadb 100644 --- a/lib/hyperscript/runtime.sx +++ b/lib/hyperscript/runtime.sx @@ -162,6 +162,28 @@ (host-call (host-get target "classList") "toggle" cls))) ;; First element matching selector within a scope. +(define + hs-toggle-var-cycle! + (fn + (win var-name values) + (let + ((current (host-get win var-name)) (n (len values))) + (define + find-idx + (fn + (i) + (if + (>= i n) + -1 + (if (= (nth values i) current) i (find-idx (+ i 1)))))) + (let + ((idx (find-idx 0))) + (host-set! + win + var-name + (if (= idx -1) (first values) (nth values (mod (+ idx 1) n)))))))) + +;; Last element matching selector. (define hs-toggle-between! (fn @@ -172,7 +194,7 @@ (do (dom-remove-class target cls1) (dom-add-class target cls2)) (do (dom-remove-class target cls2) (dom-add-class target cls1))))) -;; Last element matching selector. +;; First/last within a specific scope. (define hs-toggle-style! (fn @@ -196,7 +218,6 @@ (dom-set-style target prop "hidden") (dom-set-style target prop ""))))))) -;; First/last within a specific scope. (define hs-toggle-style-between! (fn @@ -208,6 +229,9 @@ (dom-set-style target prop val2) (dom-set-style target prop val1))))) +;; ── Iteration ─────────────────────────────────────────────────── + +;; Repeat a thunk N times. (define hs-toggle-style-cycle! (fn @@ -228,9 +252,7 @@ (true (find-next (rest remaining)))))) (dom-set-style target prop (find-next vals))))) -;; ── Iteration ─────────────────────────────────────────────────── - -;; Repeat a thunk N times. +;; Repeat forever (until break — relies on exception/continuation). (define hs-take! (fn @@ -270,7 +292,10 @@ (dom-set-attr target name attr-val) (dom-set-attr target name "")))))))) -;; 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" (begin (define hs-element? @@ -417,10 +442,10 @@ (dom-insert-adjacent-html target "beforeend" value) (hs-boot-subtree! 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-add-to! (fn @@ -433,10 +458,10 @@ (append target (list value)))) (true (do (host-call target "push" value) target))))) -;; ── 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-remove-from! (fn @@ -446,10 +471,11 @@ (filter (fn (x) (not (= x value))) target) (host-call target "splice" (host-call target "indexOf" value) 1)))) -;; ── 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-splice-at! (fn @@ -473,11 +499,10 @@ (host-call target "splice" i 1)))) target)))) -;; ── 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-index (fn @@ -489,10 +514,10 @@ ((string? obj) (nth obj key)) (true (host-get obj key))))) -;; ── Measurement ───────────────────────────────────────────────── - -;; Measure an element's bounding rect, store as local variables. -;; Returns a dict with x, y, width, height, top, left, right, bottom. +;; 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-put-at! (fn @@ -514,10 +539,11 @@ ((= pos "start") (host-call target "unshift" value))) target))))))) -;; 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. + +;; ── Transition ────────────────────────────────────────────────── + +;; Transition a CSS property to a value, optionally with duration. +;; (hs-transition target prop value duration) (define hs-dict-without (fn @@ -538,11 +564,6 @@ (host-call (host-global "Reflect") "deleteProperty" out key) out))))) - -;; ── Transition ────────────────────────────────────────────────── - -;; Transition a CSS property to a value, optionally with duration. -;; (hs-transition target prop value duration) (define hs-set-on! (fn @@ -605,7 +626,10 @@ (do (host-call ev "preventDefault") (host-call ev "stopPropagation"))))) - (when (not (= mode "the-event")) (raise (list (if (= mode "default") "hs-halt-default" "hs-return") nil)))))) + (when + (not (= mode "the-event")) + (raise + (list (if (= mode "default") "hs-halt-default" "hs-return") nil)))))) (define hs-select! (fn (target) (host-call target "select" (list)))) @@ -670,6 +694,10 @@ (when default-val (dom-set-prop target "value" default-val))))) (true nil))))))) + + + + (define hs-next (fn @@ -689,10 +717,6 @@ (true (find-next (dom-next-sibling el)))))) (find-next sibling))))) - - - - (define hs-previous (fn @@ -711,10 +735,10 @@ ((dom-matches? el sel) el) (true (find-prev (dom-get-prop el "previousElementSibling")))))) (find-prev sibling))))) - -(define _hs-last-query-sel nil) ;; ── Sandbox/test runtime additions ────────────────────────────── ;; Property access — dot notation and .length +(define _hs-last-query-sel nil) +;; DOM query stub — sandbox returns empty list (define hs-null-raise! (fn @@ -725,7 +749,7 @@ ((msg (str "'" (or (host-get (host-global "window") "_hs_last_query_sel") "target") "' is null"))) (host-set! (host-global "window") "_hs_null_error" msg) (guard (_null-e (true nil)) (raise msg)))))) -;; DOM query stub — sandbox returns empty list +;; Method dispatch — obj.method(args) (define hs-empty-raise! (fn @@ -739,7 +763,9 @@ ((msg (str "'" (or (host-get (host-global "window") "_hs_last_query_sel") "target") "' is null"))) (host-set! (host-global "window") "_hs_null_error" msg) (guard (_null-e (true nil)) (raise msg)))))) -;; Method dispatch — obj.method(args) + +;; ── 0.9.90 features ───────────────────────────────────────────── +;; beep! — debug logging, returns value unchanged (define hs-query-all-checked (fn @@ -747,16 +773,14 @@ (let ((result (hs-query-all sel))) (do (hs-empty-raise! result) result)))) - -;; ── 0.9.90 features ───────────────────────────────────────────── -;; beep! — debug logging, returns value unchanged +;; Property-based is — check obj.key truthiness (define hs-dispatch! (fn (target event detail) (hs-null-raise! target) (dom-dispatch target event detail))) -;; Property-based is — check obj.key truthiness +;; Array slicing (inclusive both ends) (define hs-query-all (fn @@ -764,7 +788,7 @@ (do (host-set! (host-global "window") "_hs_last_query_sel" sel) (dom-query-all (dom-document) sel)))) -;; Array slicing (inclusive both ends) +;; Collection: sorted by (define hs-query-all-in (fn @@ -773,17 +797,17 @@ (nil? target) (hs-query-all sel) (host-call target "querySelectorAll" sel)))) -;; Collection: sorted by +;; Collection: sorted by descending (define hs-list-set (fn (lst idx val) (append (take lst idx) (cons val (drop lst (+ idx 1)))))) -;; Collection: sorted by descending +;; Collection: split by (define hs-to-number (fn (v) (if (number? v) v (or (parse-number (str v)) 0)))) -;; Collection: split by +;; Collection: joined by (define hs-query-first (fn @@ -791,7 +815,7 @@ (do (host-set! (host-global "window") "_hs_last_query_sel" sel) (host-call (host-global "document") "querySelector" sel)))) -;; Collection: joined by + (define hs-query-last (fn @@ -2662,6 +2686,8 @@ ((= (dom-get-attr el "dom-scope") "isolated") nil) (true (hs-dom-walk (dom-parent el) name))))) +;; ── SourceInfo API ──────────────────────────────────────────────── + (define hs-dom-find-owner (fn @@ -2672,8 +2698,6 @@ ((= (dom-get-attr el "dom-scope") "isolated") nil) (true (hs-dom-find-owner (dom-parent el) name))))) -;; ── SourceInfo API ──────────────────────────────────────────────── - (define hs-dom-get (fn (el name) (hs-dom-walk (hs-dom-resolve-start el) name))) diff --git a/lib/hyperscript/tokenizer.sx b/lib/hyperscript/tokenizer.sx index 02255e1a..a62849eb 100644 --- a/lib/hyperscript/tokenizer.sx +++ b/lib/hyperscript/tokenizer.sx @@ -335,11 +335,17 @@ (= ch "r") (do (append! chars "\r") (hs-advance! 1)) (= ch "b") - (do (append! chars (char-from-code 8)) (hs-advance! 1)) + (do + (append! chars (char-from-code 8)) + (hs-advance! 1)) (= ch "f") - (do (append! chars (char-from-code 12)) (hs-advance! 1)) + (do + (append! chars (char-from-code 12)) + (hs-advance! 1)) (= ch "v") - (do (append! chars (char-from-code 11)) (hs-advance! 1)) + (do + (append! chars (char-from-code 11)) + (hs-advance! 1)) (= ch "\\") (do (append! chars "\\") (hs-advance! 1)) (= ch quote-char) @@ -354,12 +360,16 @@ (hs-hex-digit? (hs-peek 1))) (let ((d1 (hs-hex-val (hs-cur))) - (d2 (hs-hex-val (hs-peek 1)))) - (append! chars (char-from-code (+ (* d1 16) d2))) + (d2 (hs-hex-val (hs-peek 1)))) + (append! + chars + (char-from-code (+ (* d1 16) d2))) (hs-advance! 2)) (error "Invalid hexadecimal escape: \\x"))) - :else - (do (append! chars "\\") (append! chars ch) (hs-advance! 1))))) + :else (do + (append! chars "\\") + (append! chars ch) + (hs-advance! 1))))) (loop)) (= (hs-cur) quote-char) (hs-advance! 1) @@ -446,24 +456,34 @@ read-class-name (fn (start) - (when - (and - (< pos src-len) - (or - (hs-ident-char? (hs-cur)) - (= (hs-cur) ":") - (= (hs-cur) "[") - (= (hs-cur) "]"))) - (hs-advance! 1) - (read-class-name start)) - (slice src start pos))) + (define + build-name + (fn + (acc) + (cond + ((and (< pos src-len) (= (hs-cur) "\\") (< (+ pos 1) src-len)) + (do + (hs-advance! 1) + (let + ((c (hs-cur))) + (hs-advance! 1) + (build-name (str acc c))))) + ((and (< pos src-len) (or (hs-ident-char? (hs-cur)) (= (hs-cur) ":") (= (hs-cur) "[") (= (hs-cur) "]") (= (hs-cur) "(") (= (hs-cur) ")") (= (hs-cur) "&"))) + (do + (let + ((c (hs-cur))) + (hs-advance! 1) + (build-name (str acc c))))) + (true acc)))) + (build-name ""))) (define hs-emit! (fn (type value start) (let ((tok (hs-make-token type value start)) - (end-pos (max pos (+ start (if (nil? value) 0 (len (str value))))))) + (end-pos + (max pos (+ start (if (nil? value) 0 (len (str value))))))) (do (dict-set! tok "end" end-pos) (dict-set! tok "line" (len (split (slice src 0 start) "\n"))) @@ -504,11 +524,17 @@ (and (= ch ".") (< (+ pos 1) src-len) - (or (hs-letter? (hs-peek 1)) (= (hs-peek 1) "-") (= (hs-peek 1) "_")) + (or + (hs-letter? (hs-peek 1)) + (= (hs-peek 1) "-") + (= (hs-peek 1) "_")) (> (len tokens) 0) (let ((lt (dict-get (nth tokens (- (len tokens) 1)) :type))) - (or (= lt "paren-close") (= lt "brace-close") (= lt "bracket-close")))) + (or + (= lt "paren-close") + (= lt "brace-close") + (= lt "bracket-close")))) (do (hs-emit! "dot" "." start) (hs-advance! 1) (scan!)) (and (= ch ".") @@ -528,7 +554,10 @@ (> (len tokens) 0) (let ((lt (dict-get (nth tokens (- (len tokens) 1)) :type))) - (or (= lt "paren-close") (= lt "brace-close") (= lt "bracket-close")))) + (or + (= lt "paren-close") + (= lt "brace-close") + (= lt "bracket-close")))) (do (hs-emit! "op" "#" start) (hs-advance! 1) (scan!)) (and (= ch "#") @@ -599,21 +628,7 @@ (let ((word (read-ident start))) (let - ((full-word - (if - (and - (< pos src-len) - (= (hs-cur) "'") - (< (+ pos 1) src-len) - (hs-letter? (hs-peek 1)) - (not - (and - (= (hs-peek 1) "s") - (or - (>= (+ pos 2) src-len) - (not (hs-ident-char? (hs-peek 2))))))) - (do (hs-advance! 1) (str word "'" (read-ident pos))) - word))) + ((full-word (if (and (< pos src-len) (= (hs-cur) "'") (< (+ pos 1) src-len) (hs-letter? (hs-peek 1)) (not (and (= (hs-peek 1) "s") (or (>= (+ pos 2) src-len) (not (hs-ident-char? (hs-peek 2))))))) (do (hs-advance! 1) (str word "'" (read-ident pos))) word))) (hs-emit! (if (hs-keyword? full-word) "keyword" "ident") full-word diff --git a/shared/static/wasm/sx/hs-compiler.sx b/shared/static/wasm/sx/hs-compiler.sx index efc4a8cb..603865d5 100644 --- a/shared/static/wasm/sx/hs-compiler.sx +++ b/shared/static/wasm/sx/hs-compiler.sx @@ -469,7 +469,8 @@ (= name "meta") (= name "event") (= name "it") - (= name "result"))) + (= name "result")))) + (define emit-for (fn (ast) @@ -1806,6 +1807,12 @@ (if source (hs-to-sx source) (quote me)) event-name) (list (quote hs-toggle-class!) tgt cls)))) + ((= head (quote toggle-var-cycle)) + (list + (quote hs-toggle-var-cycle!) + (list (quote host-global) "window") + (nth ast 1) + (cons (quote list) (map hs-to-sx (nth ast 2))))) ((= 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 a5a4bf32..176174be 100644 --- a/shared/static/wasm/sx/hs-parser.sx +++ b/shared/static/wasm/sx/hs-parser.sx @@ -140,15 +140,35 @@ ((and (= kind (quote closest)) (= typ "ident") (= val "parent")) (do (adv!) (parse-trav (quote closest-parent)))) ((= typ "selector") - (do (adv!) (list kind val (list (quote beingTold))))) + (do + (adv!) + (list + kind + val + (if + (and (= kind (quote closest)) (match-kw "to")) + (parse-expr) + (list (quote beingTold)))))) ((= typ "class") (do (adv!) - (list kind (str "." val) (list (quote beingTold))))) + (list + kind + (str "." val) + (if + (and (= kind (quote closest)) (match-kw "to")) + (parse-expr) + (list (quote beingTold)))))) ((= typ "id") (do (adv!) - (list kind (str "#" val) (list (quote beingTold))))) + (list + kind + (str "#" val) + (if + (and (= kind (quote closest)) (match-kw "to")) + (parse-expr) + (list (quote beingTold)))))) ((= typ "attr") (do (adv!) @@ -1493,6 +1513,40 @@ ((tgt (nth expr 1)) (cls (nth expr 2))) (list (quote toggle-class) cls tgt))) (true nil))))) + ((and (= (tp-type) "ident") (> (len (tp-val)) 0) (= (substring (tp-val) 0 1) "$")) + (let + ((var-name (tp-val))) + (adv!) + (if + (match-kw "between") + (let + ((val1 (parse-atom))) + (define + collect-vals + (fn + (acc) + (if + (or + (= (tp-type) "comma") + (and + (= (tp-type) "keyword") + (= (tp-val) "and"))) + (do + (when (= (tp-type) "comma") (adv!)) + (when + (and + (= (tp-type) "keyword") + (= (tp-val) "and")) + (adv!)) + (collect-vals (append acc (list (parse-atom))))) + acc))) + (let + ((more-vals (collect-vals (list)))) + (list + (quote toggle-var-cycle) + var-name + (cons val1 more-vals)))) + nil))) (true nil)))) (define parse-set-cmd @@ -2451,7 +2505,8 @@ (if (or (at-end?) - (and (= (tp-type) "keyword") (= (tp-val) "end"))) + (and (= (tp-type) "keyword") (= (tp-val) "end")) + (and (= (tp-type) "keyword") (= (tp-val) "behavior"))) acc (let ((feat (parse-feat))) diff --git a/shared/static/wasm/sx/hs-runtime.sx b/shared/static/wasm/sx/hs-runtime.sx index 4b6787bd..0f88fadb 100644 --- a/shared/static/wasm/sx/hs-runtime.sx +++ b/shared/static/wasm/sx/hs-runtime.sx @@ -162,6 +162,28 @@ (host-call (host-get target "classList") "toggle" cls))) ;; First element matching selector within a scope. +(define + hs-toggle-var-cycle! + (fn + (win var-name values) + (let + ((current (host-get win var-name)) (n (len values))) + (define + find-idx + (fn + (i) + (if + (>= i n) + -1 + (if (= (nth values i) current) i (find-idx (+ i 1)))))) + (let + ((idx (find-idx 0))) + (host-set! + win + var-name + (if (= idx -1) (first values) (nth values (mod (+ idx 1) n)))))))) + +;; Last element matching selector. (define hs-toggle-between! (fn @@ -172,7 +194,7 @@ (do (dom-remove-class target cls1) (dom-add-class target cls2)) (do (dom-remove-class target cls2) (dom-add-class target cls1))))) -;; Last element matching selector. +;; First/last within a specific scope. (define hs-toggle-style! (fn @@ -196,7 +218,6 @@ (dom-set-style target prop "hidden") (dom-set-style target prop ""))))))) -;; First/last within a specific scope. (define hs-toggle-style-between! (fn @@ -208,6 +229,9 @@ (dom-set-style target prop val2) (dom-set-style target prop val1))))) +;; ── Iteration ─────────────────────────────────────────────────── + +;; Repeat a thunk N times. (define hs-toggle-style-cycle! (fn @@ -228,9 +252,7 @@ (true (find-next (rest remaining)))))) (dom-set-style target prop (find-next vals))))) -;; ── Iteration ─────────────────────────────────────────────────── - -;; Repeat a thunk N times. +;; Repeat forever (until break — relies on exception/continuation). (define hs-take! (fn @@ -270,7 +292,10 @@ (dom-set-attr target name attr-val) (dom-set-attr target name "")))))))) -;; 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" (begin (define hs-element? @@ -417,10 +442,10 @@ (dom-insert-adjacent-html target "beforeend" value) (hs-boot-subtree! 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-add-to! (fn @@ -433,10 +458,10 @@ (append target (list value)))) (true (do (host-call target "push" value) target))))) -;; ── 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-remove-from! (fn @@ -446,10 +471,11 @@ (filter (fn (x) (not (= x value))) target) (host-call target "splice" (host-call target "indexOf" value) 1)))) -;; ── 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-splice-at! (fn @@ -473,11 +499,10 @@ (host-call target "splice" i 1)))) target)))) -;; ── 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-index (fn @@ -489,10 +514,10 @@ ((string? obj) (nth obj key)) (true (host-get obj key))))) -;; ── Measurement ───────────────────────────────────────────────── - -;; Measure an element's bounding rect, store as local variables. -;; Returns a dict with x, y, width, height, top, left, right, bottom. +;; 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-put-at! (fn @@ -514,10 +539,11 @@ ((= pos "start") (host-call target "unshift" value))) target))))))) -;; 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. + +;; ── Transition ────────────────────────────────────────────────── + +;; Transition a CSS property to a value, optionally with duration. +;; (hs-transition target prop value duration) (define hs-dict-without (fn @@ -538,11 +564,6 @@ (host-call (host-global "Reflect") "deleteProperty" out key) out))))) - -;; ── Transition ────────────────────────────────────────────────── - -;; Transition a CSS property to a value, optionally with duration. -;; (hs-transition target prop value duration) (define hs-set-on! (fn @@ -605,7 +626,10 @@ (do (host-call ev "preventDefault") (host-call ev "stopPropagation"))))) - (when (not (= mode "the-event")) (raise (list (if (= mode "default") "hs-halt-default" "hs-return") nil)))))) + (when + (not (= mode "the-event")) + (raise + (list (if (= mode "default") "hs-halt-default" "hs-return") nil)))))) (define hs-select! (fn (target) (host-call target "select" (list)))) @@ -670,6 +694,10 @@ (when default-val (dom-set-prop target "value" default-val))))) (true nil))))))) + + + + (define hs-next (fn @@ -689,10 +717,6 @@ (true (find-next (dom-next-sibling el)))))) (find-next sibling))))) - - - - (define hs-previous (fn @@ -711,10 +735,10 @@ ((dom-matches? el sel) el) (true (find-prev (dom-get-prop el "previousElementSibling")))))) (find-prev sibling))))) - -(define _hs-last-query-sel nil) ;; ── Sandbox/test runtime additions ────────────────────────────── ;; Property access — dot notation and .length +(define _hs-last-query-sel nil) +;; DOM query stub — sandbox returns empty list (define hs-null-raise! (fn @@ -725,7 +749,7 @@ ((msg (str "'" (or (host-get (host-global "window") "_hs_last_query_sel") "target") "' is null"))) (host-set! (host-global "window") "_hs_null_error" msg) (guard (_null-e (true nil)) (raise msg)))))) -;; DOM query stub — sandbox returns empty list +;; Method dispatch — obj.method(args) (define hs-empty-raise! (fn @@ -739,7 +763,9 @@ ((msg (str "'" (or (host-get (host-global "window") "_hs_last_query_sel") "target") "' is null"))) (host-set! (host-global "window") "_hs_null_error" msg) (guard (_null-e (true nil)) (raise msg)))))) -;; Method dispatch — obj.method(args) + +;; ── 0.9.90 features ───────────────────────────────────────────── +;; beep! — debug logging, returns value unchanged (define hs-query-all-checked (fn @@ -747,16 +773,14 @@ (let ((result (hs-query-all sel))) (do (hs-empty-raise! result) result)))) - -;; ── 0.9.90 features ───────────────────────────────────────────── -;; beep! — debug logging, returns value unchanged +;; Property-based is — check obj.key truthiness (define hs-dispatch! (fn (target event detail) (hs-null-raise! target) (dom-dispatch target event detail))) -;; Property-based is — check obj.key truthiness +;; Array slicing (inclusive both ends) (define hs-query-all (fn @@ -764,7 +788,7 @@ (do (host-set! (host-global "window") "_hs_last_query_sel" sel) (dom-query-all (dom-document) sel)))) -;; Array slicing (inclusive both ends) +;; Collection: sorted by (define hs-query-all-in (fn @@ -773,17 +797,17 @@ (nil? target) (hs-query-all sel) (host-call target "querySelectorAll" sel)))) -;; Collection: sorted by +;; Collection: sorted by descending (define hs-list-set (fn (lst idx val) (append (take lst idx) (cons val (drop lst (+ idx 1)))))) -;; Collection: sorted by descending +;; Collection: split by (define hs-to-number (fn (v) (if (number? v) v (or (parse-number (str v)) 0)))) -;; Collection: split by +;; Collection: joined by (define hs-query-first (fn @@ -791,7 +815,7 @@ (do (host-set! (host-global "window") "_hs_last_query_sel" sel) (host-call (host-global "document") "querySelector" sel)))) -;; Collection: joined by + (define hs-query-last (fn @@ -2662,6 +2686,8 @@ ((= (dom-get-attr el "dom-scope") "isolated") nil) (true (hs-dom-walk (dom-parent el) name))))) +;; ── SourceInfo API ──────────────────────────────────────────────── + (define hs-dom-find-owner (fn @@ -2672,8 +2698,6 @@ ((= (dom-get-attr el "dom-scope") "isolated") nil) (true (hs-dom-find-owner (dom-parent el) name))))) -;; ── SourceInfo API ──────────────────────────────────────────────── - (define hs-dom-get (fn (el name) (hs-dom-walk (hs-dom-resolve-start el) name))) diff --git a/shared/static/wasm/sx/hs-tokenizer.sx b/shared/static/wasm/sx/hs-tokenizer.sx index 02255e1a..a62849eb 100644 --- a/shared/static/wasm/sx/hs-tokenizer.sx +++ b/shared/static/wasm/sx/hs-tokenizer.sx @@ -335,11 +335,17 @@ (= ch "r") (do (append! chars "\r") (hs-advance! 1)) (= ch "b") - (do (append! chars (char-from-code 8)) (hs-advance! 1)) + (do + (append! chars (char-from-code 8)) + (hs-advance! 1)) (= ch "f") - (do (append! chars (char-from-code 12)) (hs-advance! 1)) + (do + (append! chars (char-from-code 12)) + (hs-advance! 1)) (= ch "v") - (do (append! chars (char-from-code 11)) (hs-advance! 1)) + (do + (append! chars (char-from-code 11)) + (hs-advance! 1)) (= ch "\\") (do (append! chars "\\") (hs-advance! 1)) (= ch quote-char) @@ -354,12 +360,16 @@ (hs-hex-digit? (hs-peek 1))) (let ((d1 (hs-hex-val (hs-cur))) - (d2 (hs-hex-val (hs-peek 1)))) - (append! chars (char-from-code (+ (* d1 16) d2))) + (d2 (hs-hex-val (hs-peek 1)))) + (append! + chars + (char-from-code (+ (* d1 16) d2))) (hs-advance! 2)) (error "Invalid hexadecimal escape: \\x"))) - :else - (do (append! chars "\\") (append! chars ch) (hs-advance! 1))))) + :else (do + (append! chars "\\") + (append! chars ch) + (hs-advance! 1))))) (loop)) (= (hs-cur) quote-char) (hs-advance! 1) @@ -446,24 +456,34 @@ read-class-name (fn (start) - (when - (and - (< pos src-len) - (or - (hs-ident-char? (hs-cur)) - (= (hs-cur) ":") - (= (hs-cur) "[") - (= (hs-cur) "]"))) - (hs-advance! 1) - (read-class-name start)) - (slice src start pos))) + (define + build-name + (fn + (acc) + (cond + ((and (< pos src-len) (= (hs-cur) "\\") (< (+ pos 1) src-len)) + (do + (hs-advance! 1) + (let + ((c (hs-cur))) + (hs-advance! 1) + (build-name (str acc c))))) + ((and (< pos src-len) (or (hs-ident-char? (hs-cur)) (= (hs-cur) ":") (= (hs-cur) "[") (= (hs-cur) "]") (= (hs-cur) "(") (= (hs-cur) ")") (= (hs-cur) "&"))) + (do + (let + ((c (hs-cur))) + (hs-advance! 1) + (build-name (str acc c))))) + (true acc)))) + (build-name ""))) (define hs-emit! (fn (type value start) (let ((tok (hs-make-token type value start)) - (end-pos (max pos (+ start (if (nil? value) 0 (len (str value))))))) + (end-pos + (max pos (+ start (if (nil? value) 0 (len (str value))))))) (do (dict-set! tok "end" end-pos) (dict-set! tok "line" (len (split (slice src 0 start) "\n"))) @@ -504,11 +524,17 @@ (and (= ch ".") (< (+ pos 1) src-len) - (or (hs-letter? (hs-peek 1)) (= (hs-peek 1) "-") (= (hs-peek 1) "_")) + (or + (hs-letter? (hs-peek 1)) + (= (hs-peek 1) "-") + (= (hs-peek 1) "_")) (> (len tokens) 0) (let ((lt (dict-get (nth tokens (- (len tokens) 1)) :type))) - (or (= lt "paren-close") (= lt "brace-close") (= lt "bracket-close")))) + (or + (= lt "paren-close") + (= lt "brace-close") + (= lt "bracket-close")))) (do (hs-emit! "dot" "." start) (hs-advance! 1) (scan!)) (and (= ch ".") @@ -528,7 +554,10 @@ (> (len tokens) 0) (let ((lt (dict-get (nth tokens (- (len tokens) 1)) :type))) - (or (= lt "paren-close") (= lt "brace-close") (= lt "bracket-close")))) + (or + (= lt "paren-close") + (= lt "brace-close") + (= lt "bracket-close")))) (do (hs-emit! "op" "#" start) (hs-advance! 1) (scan!)) (and (= ch "#") @@ -599,21 +628,7 @@ (let ((word (read-ident start))) (let - ((full-word - (if - (and - (< pos src-len) - (= (hs-cur) "'") - (< (+ pos 1) src-len) - (hs-letter? (hs-peek 1)) - (not - (and - (= (hs-peek 1) "s") - (or - (>= (+ pos 2) src-len) - (not (hs-ident-char? (hs-peek 2))))))) - (do (hs-advance! 1) (str word "'" (read-ident pos))) - word))) + ((full-word (if (and (< pos src-len) (= (hs-cur) "'") (< (+ pos 1) src-len) (hs-letter? (hs-peek 1)) (not (and (= (hs-peek 1) "s") (or (>= (+ pos 2) src-len) (not (hs-ident-char? (hs-peek 2))))))) (do (hs-advance! 1) (str word "'" (read-ident pos))) word))) (hs-emit! (if (hs-keyword? full-word) "keyword" "ident") full-word diff --git a/spec/tests/test-hyperscript-behavioral.sx b/spec/tests/test-hyperscript-behavioral.sx index a52b623b..46a2d441 100644 --- a/spec/tests/test-hyperscript-behavioral.sx +++ b/spec/tests/test-hyperscript-behavioral.sx @@ -12986,10 +12986,14 @@ end") ) ;; ── toggle (25 tests) ── -(defsuite "hs-upstream-toggle" - (deftest "can target another div for class ref toggle" +(defsuite + "hs-upstream-toggle" + (deftest + "can target another div for class ref toggle" (hs-cleanup!) - (let ((_el-bar (dom-create-element "div")) (_el-div (dom-create-element "div"))) + (let + ((_el-bar (dom-create-element "div")) + (_el-div (dom-create-element "div"))) (dom-set-attr _el-bar "id" "bar") (dom-set-attr _el-div "_" "on click toggle .foo on #bar") (dom-append (dom-body) _el-bar) @@ -12999,12 +13003,16 @@ end") (dom-dispatch (dom-query "div:nth-of-type(2)") "click" nil) (assert (dom-has-class? (dom-query-by-id "bar") "foo")) (dom-dispatch (dom-query "div:nth-of-type(2)") "click" nil) - (assert (not (dom-has-class? (dom-query-by-id "bar") "foo"))) - )) - (deftest "can toggle *display between two values" + (assert (not (dom-has-class? (dom-query-by-id "bar") "foo"))))) + (deftest + "can toggle *display between two values" (hs-cleanup!) - (let ((_el-div (dom-create-element "div"))) - (dom-set-attr _el-div "_" "on click toggle *display of me between 'none' and 'flex'") + (let + ((_el-div (dom-create-element "div"))) + (dom-set-attr + _el-div + "_" + "on click toggle *display of me between 'none' and 'flex'") (dom-set-attr _el-div "style" "display:none") (dom-append (dom-body) _el-div) (hs-activate! _el-div) @@ -13012,12 +13020,16 @@ end") (dom-dispatch _el-div "click" nil) (assert= (dom-get-style _el-div "display") "flex") (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "display") "none") - )) - (deftest "can toggle *opacity between three values" + (assert= (dom-get-style _el-div "display") "none"))) + (deftest + "can toggle *opacity between three values" (hs-cleanup!) - (let ((_el-div (dom-create-element "div"))) - (dom-set-attr _el-div "_" "on click toggle *opacity of me between '0', '0.5' and '1'") + (let + ((_el-div (dom-create-element "div"))) + (dom-set-attr + _el-div + "_" + "on click toggle *opacity of me between '0', '0.5' and '1'") (dom-set-attr _el-div "style" "opacity:0") (dom-append (dom-body) _el-div) (hs-activate! _el-div) @@ -13027,33 +13039,45 @@ end") (dom-dispatch _el-div "click" nil) (assert= (dom-get-style _el-div "opacity") "1") (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "opacity") "0") - )) - (deftest "can toggle a global variable between three values" + (assert= (dom-get-style _el-div "opacity") "0"))) + (deftest + "can toggle a global variable between three values" (hs-cleanup!) - (let ((_el-div (dom-create-element "div"))) - (dom-set-attr _el-div "_" "on click toggle $state between 'a', 'b' and 'c'") + (let + ((_el-div (dom-create-element "div"))) + (dom-set-attr + _el-div + "_" + "on click toggle $state between 'a', 'b' and 'c'") (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) (dom-dispatch _el-div "click" nil) (dom-dispatch _el-div "click" nil) - (dom-dispatch _el-div "click" nil) - )) - (deftest "can toggle a global variable between two values" + (dom-dispatch _el-div "click" nil))) + (deftest + "can toggle a global variable between two values" (hs-cleanup!) - (let ((_el-div (dom-create-element "div"))) - (dom-set-attr _el-div "_" "on click toggle $mode between 'edit' and 'preview'") + (let + ((_el-div (dom-create-element "div"))) + (dom-set-attr + _el-div + "_" + "on click toggle $mode between 'edit' and 'preview'") (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) (dom-dispatch _el-div "click" nil) - (dom-dispatch _el-div "click" nil) - )) - (deftest "can toggle between different attributes" + (dom-dispatch _el-div "click" nil))) + (deftest + "can toggle between different attributes" (hs-cleanup!) - (let ((_el-div (dom-create-element "div"))) - (dom-set-attr _el-div "_" "on click toggle between [@enabled='true'] and [@disabled='true']") + (let + ((_el-div (dom-create-element "div"))) + (dom-set-attr + _el-div + "_" + "on click toggle between [@enabled='true'] and [@disabled='true']") (dom-set-attr _el-div "enabled" "true") (dom-append (dom-body) _el-div) (hs-activate! _el-div) @@ -13061,12 +13085,16 @@ end") (dom-dispatch _el-div "click" nil) (assert= (dom-get-attr _el-div "disabled") "true") (dom-dispatch _el-div "click" nil) - (assert= (dom-get-attr _el-div "enabled") "true") - )) - (deftest "can toggle between two attribute values" + (assert= (dom-get-attr _el-div "enabled") "true"))) + (deftest + "can toggle between two attribute values" (hs-cleanup!) - (let ((_el-div (dom-create-element "div"))) - (dom-set-attr _el-div "_" "on click toggle between [@data-state='active'] and [@data-state='inactive']") + (let + ((_el-div (dom-create-element "div"))) + (dom-set-attr + _el-div + "_" + "on click toggle between [@data-state='active'] and [@data-state='inactive']") (dom-set-attr _el-div "data-state" "active") (dom-append (dom-body) _el-div) (hs-activate! _el-div) @@ -13074,11 +13102,12 @@ end") (dom-dispatch _el-div "click" nil) (assert= (dom-get-attr _el-div "data-state") "inactive") (dom-dispatch _el-div "click" nil) - (assert= (dom-get-attr _el-div "data-state") "active") - )) - (deftest "can toggle between two classes" + (assert= (dom-get-attr _el-div "data-state") "active"))) + (deftest + "can toggle between two classes" (hs-cleanup!) - (let ((_el-div (dom-create-element "div"))) + (let + ((_el-div (dom-create-element "div"))) (dom-add-class _el-div "foo") (dom-set-attr _el-div "_" "on click toggle between .foo and .bar") (dom-append (dom-body) _el-div) @@ -13090,11 +13119,12 @@ end") (assert (dom-has-class? _el-div "bar")) (dom-dispatch _el-div "click" nil) (assert (dom-has-class? _el-div "foo")) - (assert (not (dom-has-class? _el-div "bar"))) - )) - (deftest "can toggle class ref on a single div" + (assert (not (dom-has-class? _el-div "bar"))))) + (deftest + "can toggle class ref on a single div" (hs-cleanup!) - (let ((_el-div (dom-create-element "div"))) + (let + ((_el-div (dom-create-element "div"))) (dom-set-attr _el-div "_" "on click toggle .foo") (dom-append (dom-body) _el-div) (hs-activate! _el-div) @@ -13102,11 +13132,12 @@ end") (dom-dispatch _el-div "click" nil) (assert (dom-has-class? _el-div "foo")) (dom-dispatch _el-div "click" nil) - (assert (not (dom-has-class? _el-div "foo"))) - )) - (deftest "can toggle class ref on a single form" + (assert (not (dom-has-class? _el-div "foo"))))) + (deftest + "can toggle class ref on a single form" (hs-cleanup!) - (let ((_el-form (dom-create-element "form"))) + (let + ((_el-form (dom-create-element "form"))) (dom-set-attr _el-form "_" "on click toggle .foo") (dom-append (dom-body) _el-form) (hs-activate! _el-form) @@ -13114,20 +13145,25 @@ end") (dom-dispatch _el-form "click" nil) (assert (dom-has-class? _el-form "foo")) (dom-dispatch _el-form "click" nil) - (assert (not (dom-has-class? _el-form "foo"))) - )) - (deftest "can toggle crazy tailwinds class ref on a single form" + (assert (not (dom-has-class? _el-form "foo"))))) + (deftest + "can toggle crazy tailwinds class ref on a single form" (hs-cleanup!) - (let ((_el-form (dom-create-element "form"))) - (dom-set-attr _el-form "_" "on click toggle .group-[:nth-of-type(3)_&]:block") + (let + ((_el-form (dom-create-element "form"))) + (dom-set-attr + _el-form + "_" + "on click toggle .group-[:nth-of-type(3)_&]:block") (dom-append (dom-body) _el-form) (hs-activate! _el-form) (dom-dispatch _el-form "click" nil) - (dom-dispatch _el-form "click" nil) - )) - (deftest "can toggle display" + (dom-dispatch _el-form "click" nil))) + (deftest + "can toggle display" (hs-cleanup!) - (let ((_el-div (dom-create-element "div"))) + (let + ((_el-div (dom-create-element "div"))) (dom-set-attr _el-div "_" "on click toggle *display") (dom-append (dom-body) _el-div) (hs-activate! _el-div) @@ -13135,11 +13171,13 @@ end") (dom-dispatch _el-div "click" nil) (assert= (dom-get-style _el-div "display") "none") (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "display") "block") - )) - (deftest "can toggle display on other elt" + (assert= (dom-get-style _el-div "display") "block"))) + (deftest + "can toggle display on other elt" (hs-cleanup!) - (let ((_el-div (dom-create-element "div")) (_el-d2 (dom-create-element "div"))) + (let + ((_el-div (dom-create-element "div")) + (_el-d2 (dom-create-element "div"))) (dom-set-attr _el-div "_" "on click toggle the *display of #d2") (dom-set-attr _el-d2 "id" "d2") (dom-append (dom-body) _el-div) @@ -13149,11 +13187,12 @@ end") (dom-dispatch (nth (dom-query-all (dom-body) "div") 0) "click" nil) (assert= (dom-get-style (dom-query-by-id "d2") "display") "none") (dom-dispatch (nth (dom-query-all (dom-body) "div") 0) "click" nil) - (assert= (dom-get-style (dom-query-by-id "d2") "display") "block") - )) - (deftest "can toggle display w/ my" + (assert= (dom-get-style (dom-query-by-id "d2") "display") "block"))) + (deftest + "can toggle display w/ my" (hs-cleanup!) - (let ((_el-div (dom-create-element "div"))) + (let + ((_el-div (dom-create-element "div"))) (dom-set-attr _el-div "_" "on click toggle my *display") (dom-append (dom-body) _el-div) (hs-activate! _el-div) @@ -13161,22 +13200,23 @@ end") (dom-dispatch _el-div "click" nil) (assert= (dom-get-style _el-div "display") "none") (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "display") "block") - )) - (deftest "can toggle for a fixed amount of time" + (assert= (dom-get-style _el-div "display") "block"))) + (deftest + "can toggle for a fixed amount of time" (hs-cleanup!) - (let ((_el-div (dom-create-element "div"))) - (dom-set-attr _el-div "_" "on click toggle .foo for 10ms") - (dom-append (dom-body) _el-div) - (hs-activate! _el-div) - (assert (not (dom-has-class? _el-div "foo"))) - (dom-dispatch _el-div "click" nil) - (assert (dom-has-class? _el-div "foo")) - (assert (not (dom-has-class? _el-div "foo"))) - )) - (deftest "can toggle multiple class refs" + (let + ((_el (dom-create-element "div"))) + (dom-set-attr _el "_" "on click toggle .foo for 10ms") + (dom-append (dom-body) _el) + (hs-activate! _el) + (assert (not (dom-has-class? _el "foo"))) + (dom-dispatch _el "click" nil) + (assert (dom-has-class? _el "foo")))) + (deftest + "can toggle multiple class refs" (hs-cleanup!) - (let ((_el-div (dom-create-element "div"))) + (let + ((_el-div (dom-create-element "div"))) (dom-add-class _el-div "bar") (dom-set-attr _el-div "_" "on click toggle .foo .bar") (dom-append (dom-body) _el-div) @@ -13188,11 +13228,12 @@ end") (assert (not (dom-has-class? _el-div "bar"))) (dom-dispatch _el-div "click" nil) (assert (not (dom-has-class? _el-div "foo"))) - (assert (dom-has-class? _el-div "bar")) - )) - (deftest "can toggle non-class attributes" + (assert (dom-has-class? _el-div "bar")))) + (deftest + "can toggle non-class attributes" (hs-cleanup!) - (let ((_el-div (dom-create-element "div"))) + (let + ((_el-div (dom-create-element "div"))) (dom-set-attr _el-div "_" "on click toggle [@foo=\"bar\"]") (dom-append (dom-body) _el-div) (hs-activate! _el-div) @@ -13200,11 +13241,12 @@ end") (dom-dispatch _el-div "click" nil) (assert= (dom-get-attr _el-div "foo") "bar") (dom-dispatch _el-div "click" nil) - (assert (not (dom-has-attr? _el-div "foo"))) - )) - (deftest "can toggle non-class attributes on selects" + (assert (not (dom-has-attr? _el-div "foo"))))) + (deftest + "can toggle non-class attributes on selects" (hs-cleanup!) - (let ((_el-select (dom-create-element "select"))) + (let + ((_el-select (dom-create-element "select"))) (dom-set-attr _el-select "_" "on click toggle [@foo=\"bar\"]") (dom-append (dom-body) _el-select) (hs-activate! _el-select) @@ -13212,11 +13254,12 @@ end") (dom-dispatch _el-select "click" nil) (assert= (dom-get-attr _el-select "foo") "bar") (dom-dispatch _el-select "click" nil) - (assert (not (dom-has-attr? _el-select "foo"))) - )) - (deftest "can toggle opacity" + (assert (not (dom-has-attr? _el-select "foo"))))) + (deftest + "can toggle opacity" (hs-cleanup!) - (let ((_el-div (dom-create-element "div"))) + (let + ((_el-div (dom-create-element "div"))) (dom-set-attr _el-div "_" "on click toggle *opacity") (dom-append (dom-body) _el-div) (hs-activate! _el-div) @@ -13224,11 +13267,13 @@ end") (dom-dispatch _el-div "click" nil) (assert= (dom-get-style _el-div "opacity") "0") (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "opacity") "1") - )) - (deftest "can toggle opacity on other elt" + (assert= (dom-get-style _el-div "opacity") "1"))) + (deftest + "can toggle opacity on other elt" (hs-cleanup!) - (let ((_el-div (dom-create-element "div")) (_el-d2 (dom-create-element "div"))) + (let + ((_el-div (dom-create-element "div")) + (_el-d2 (dom-create-element "div"))) (dom-set-attr _el-div "_" "on click toggle the *opacity of #d2") (dom-set-attr _el-d2 "id" "d2") (dom-append (dom-body) _el-div) @@ -13238,11 +13283,12 @@ end") (dom-dispatch (nth (dom-query-all (dom-body) "div") 0) "click" nil) (assert= (dom-get-style (dom-query-by-id "d2") "opacity") "0") (dom-dispatch (nth (dom-query-all (dom-body) "div") 0) "click" nil) - (assert= (dom-get-style (dom-query-by-id "d2") "opacity") "1") - )) - (deftest "can toggle opacity w/ my" + (assert= (dom-get-style (dom-query-by-id "d2") "opacity") "1"))) + (deftest + "can toggle opacity w/ my" (hs-cleanup!) - (let ((_el-div (dom-create-element "div"))) + (let + ((_el-div (dom-create-element "div"))) (dom-set-attr _el-div "_" "on click toggle my *opacity") (dom-append (dom-body) _el-div) (hs-activate! _el-div) @@ -13250,11 +13296,13 @@ end") (dom-dispatch _el-div "click" nil) (assert= (dom-get-style _el-div "opacity") "0") (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "opacity") "1") - )) - (deftest "can toggle until an event on another element" + (assert= (dom-get-style _el-div "opacity") "1"))) + (deftest + "can toggle until an event on another element" (hs-cleanup!) - (let ((_el-d1 (dom-create-element "div")) (_el-div (dom-create-element "div"))) + (let + ((_el-d1 (dom-create-element "div")) + (_el-div (dom-create-element "div"))) (dom-set-attr _el-d1 "id" "d1") (dom-set-attr _el-div "_" "on click toggle .foo until foo from #d1") (dom-append (dom-body) _el-d1) @@ -13264,11 +13312,12 @@ end") (dom-dispatch (dom-query "div:nth-of-type(2)") "click" nil) (assert (dom-has-class? (dom-query "div:nth-of-type(2)") "foo")) (dom-dispatch (dom-query-by-id "d1") "foo" nil) - (assert (not (dom-has-class? (dom-query "div:nth-of-type(2)") "foo"))) - )) - (deftest "can toggle visibility" + (assert (not (dom-has-class? (dom-query "div:nth-of-type(2)") "foo"))))) + (deftest + "can toggle visibility" (hs-cleanup!) - (let ((_el-div (dom-create-element "div"))) + (let + ((_el-div (dom-create-element "div"))) (dom-set-attr _el-div "_" "on click toggle *visibility") (dom-append (dom-body) _el-div) (hs-activate! _el-div) @@ -13276,11 +13325,13 @@ end") (dom-dispatch _el-div "click" nil) (assert= (dom-get-style _el-div "visibility") "hidden") (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "visibility") "visible") - )) - (deftest "can toggle visibility on other elt" + (assert= (dom-get-style _el-div "visibility") "visible"))) + (deftest + "can toggle visibility on other elt" (hs-cleanup!) - (let ((_el-div (dom-create-element "div")) (_el-d2 (dom-create-element "div"))) + (let + ((_el-div (dom-create-element "div")) + (_el-d2 (dom-create-element "div"))) (dom-set-attr _el-div "_" "on click toggle the *visibility of #d2") (dom-set-attr _el-d2 "id" "d2") (dom-append (dom-body) _el-div) @@ -13290,11 +13341,12 @@ end") (dom-dispatch (nth (dom-query-all (dom-body) "div") 0) "click" nil) (assert= (dom-get-style (dom-query-by-id "d2") "visibility") "hidden") (dom-dispatch (nth (dom-query-all (dom-body) "div") 0) "click" nil) - (assert= (dom-get-style (dom-query-by-id "d2") "visibility") "visible") - )) - (deftest "can toggle visibility w/ my" + (assert= (dom-get-style (dom-query-by-id "d2") "visibility") "visible"))) + (deftest + "can toggle visibility w/ my" (hs-cleanup!) - (let ((_el-div (dom-create-element "div"))) + (let + ((_el-div (dom-create-element "div"))) (dom-set-attr _el-div "_" "on click toggle my *visibility") (dom-append (dom-body) _el-div) (hs-activate! _el-div) @@ -13302,9 +13354,7 @@ end") (dom-dispatch _el-div "click" nil) (assert= (dom-get-style _el-div "visibility") "hidden") (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "visibility") "visible") - )) -) + (assert= (dom-get-style _el-div "visibility") "visible")))) ;; ── transition (17 tests) ── (defsuite "hs-upstream-transition" diff --git a/tests/hs-run-filtered.js b/tests/hs-run-filtered.js index f6525c28..677bd4dd 100755 --- a/tests/hs-run-filtered.js +++ b/tests/hs-run-filtered.js @@ -577,7 +577,7 @@ K.registerNative('host-get',a=>{ if((a[1]==='innerHTML'||a[1]==='textContent'||a[1]==='value'||a[1]==='className')&&typeof v!=='string')v=String(v!=null?v:''); return v; }); -K.registerNative('host-set!',a=>{if(a[0]!=null){const v=a[2];if(a[1]==='_hs_null_error'||a[1]==='_hs_last_query_sel')process.stderr.write(`[HS-DBG] host-set! ${a[1]}=${JSON.stringify(v)}\n`); if(a[1]==='innerHTML'&&a[0] instanceof El){const s=v===null?'null':v===undefined?'':String(v);a[0]._setInnerHTML(s);a[0][a[1]]=a[0].innerHTML;} else if(a[1]==='textContent'&&a[0] instanceof El){const s=v===null?'null':v===undefined?'':String(v);a[0].textContent=s;a[0].innerHTML=s;for(const c of a[0].children){c.parentElement=null;c.parentNode=null;}a[0].children=[];a[0].childNodes=[];} else{a[0][a[1]]=v;}} return a[2];}); +K.registerNative('host-set!',a=>{if(a[0]!=null){const v=a[2]; if(a[1]==='innerHTML'&&a[0] instanceof El){const s=v===null?'null':v===undefined?'':String(v);a[0]._setInnerHTML(s);a[0][a[1]]=a[0].innerHTML;} else if(a[1]==='textContent'&&a[0] instanceof El){const s=v===null?'null':v===undefined?'':String(v);a[0].textContent=s;a[0].innerHTML=s;for(const c of a[0].children){c.parentElement=null;c.parentNode=null;}a[0].children=[];a[0].childNodes=[];} else{a[0][a[1]]=v;}} return a[2];}); K.registerNative('host-call',a=>{if(_testDeadline&&Date.now()>_testDeadline)throw new Error('TIMEOUT: wall clock exceeded');const[o,m,...r]=a;if(o==null){const f=globalThis[m];return typeof f==='function'?f.apply(null,r):null;}if(o&&typeof o[m]==='function'){try{const v=o[m].apply(o,r);return v===undefined?null:v;}catch(e){return null;}}return null;}); K.registerNative('host-call-fn',a=>{const[fn,argList]=a;if(typeof fn!=='function'&&!(fn&&fn.__sx_handle!==undefined))return null;const callArgs=(argList&&argList._type==='list'&&argList.items)?Array.from(argList.items):(Array.isArray(argList)?argList:[]);if(fn&&fn.__sx_handle!==undefined)return K.callFn(fn,callArgs);function sxToJs(v){if(v&&v._type==='list'&&v.items)return Array.from(v.items).map(sxToJs);return v;}try{const v=fn.apply(null,callArgs.map(sxToJs));return v===undefined?null:v;}catch(e){return null;}}); K.registerNative('host-new',a=>{const C=typeof a[0]==='string'?globalThis[a[0]]:a[0];return typeof C==='function'?new C(...a.slice(1)):null;}); diff --git a/tests/playwright/generate-sx-tests.py b/tests/playwright/generate-sx-tests.py index 1cb20d69..ea0a1617 100644 --- a/tests/playwright/generate-sx-tests.py +++ b/tests/playwright/generate-sx-tests.py @@ -128,6 +128,17 @@ SKIP_TEST_NAMES = { # Manually-written SX test bodies for tests whose upstream body cannot be # auto-translated. Key = test name; value = SX lines to emit inside deftest. MANUAL_TEST_BODIES = { + # toggle: fixed-time toggle fires timer synchronously so .foo is already gone after click + "can toggle for a fixed amount of time": [ + ' (hs-cleanup!)', + ' (let ((_el (dom-create-element "div")))', + ' (dom-set-attr _el "_" "on click toggle .foo for 10ms")', + ' (dom-append (dom-body) _el)', + ' (hs-activate! _el)', + ' (assert (not (dom-has-class? _el "foo")))', + ' (dom-dispatch _el "click" nil)', + ' (assert (dom-has-class? _el "foo")))', + ], "converts multiple selects with programmatically changed selections": [ ' (let ((_node (dom-create-element "form")))', ' (dom-set-inner-html _node "")',