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

HS: Group 11 misc — toggle-var-cycle, closest-to, tailwind class, toggle timing (+3 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 6m13s
Details

Browse Source 
- 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 <noreply@anthropic.com>
This commit is contained in:
giles
2026-05-04 17:03:52 +00:00
parent d47db58cde
commit d9b7e1e392
12 changed files with 569 additions and 306 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
hosts/javascript/platform.py
View File

@@ -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 };

9
lib/hyperscript/compiler.sx
View File

@@ -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!)

63
lib/hyperscript/parser.sx
View File

@@ -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)))

128
lib/hyperscript/runtime.sx
View File

@@ -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)))

89
lib/hyperscript/tokenizer.sx
View File

@@ -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

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

@@ -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!)

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

@@ -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)))

128
shared/static/wasm/sx/hs-runtime.sx
View File

@@ -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)))

89
shared/static/wasm/sx/hs-tokenizer.sx
View File

@@ -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

280
spec/tests/test-hyperscript-behavioral.sx
View File

@@ -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"

2
tests/hs-run-filtered.js
View File

@@ -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;});

11
tests/playwright/generate-sx-tests.py
View File

@@ -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 "<select name=\"animal\" multiple> <option value=\"dog\" selected>Doggo</option> <option value=\"cat\">Kitteh</option> <option value=\"raccoon\" selected>Trash Panda</option> <option value=\"possum\">Sleepy Boi</option> </select>")',