diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index fb0171ad..f00d6fef 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -348,11 +348,30 @@ (fn (ast) (let - ((event-name (nth ast 1))) - (if - (and (> (len ast) 2) (= (nth ast 2) :from)) - (list (quote hs-wait-for) (hs-to-sx (nth ast 3)) event-name) - (list (quote hs-wait-for) (quote me) event-name))))) + ((event-name (nth ast 1)) + (has-from (and (> (len ast) 2) (= (nth ast 2) :from))) + (has-from-or + (and + (> (len ast) 4) + (= (nth ast 2) :from) + (= (nth ast 4) :or))) + (has-or (and (> (len ast) 2) (= (nth ast 2) :or)))) + (cond + (has-from-or + (list + (quote hs-wait-for-or) + (hs-to-sx (nth ast 3)) + event-name + (nth ast 5))) + (has-from + (list (quote hs-wait-for) (hs-to-sx (nth ast 3)) event-name)) + (has-or + (list + (quote hs-wait-for-or) + (quote me) + event-name + (nth ast 3))) + (true (list (quote hs-wait-for) (quote me) event-name)))))) (define emit-transition (fn @@ -666,6 +685,16 @@ (let ((head (first ast))) (cond + ((= head (quote __bind-from-detail__)) + (let + ((name-str (nth ast 1))) + (list + (quote define) + (make-symbol name-str) + (list + (quote host-get) + (list (quote host-get) (quote it) "detail") + name-str)))) ((= head (quote sender)) (list (quote hs-sender) (quote event))) ((= head (quote null-literal)) nil) @@ -1500,47 +1529,50 @@ (hs-to-sx (nth ast 2))))) ((= head (quote do)) (let - ((compiled (map hs-to-sx (rest ast)))) - (if - (and - (> (len compiled) 1) - (some + ((expanded (reduce (fn (acc c) (if (and (list? c) (> (len c) 0) (= (first c) (quote wait-for)) (contains? c :destructure)) (let ((dest-names (let ((lst c)) (define scan-dest (fn (i) (cond ((>= i (- (len lst) 1)) (list)) ((= (nth lst i) :destructure) (nth lst (+ i 1))) (true (scan-dest (+ i 2)))))) (scan-dest 2))) (stripped (let ((lst c)) (define strip-dest (fn (i) (cond ((>= i (len lst)) (list)) ((and (< i (- (len lst) 1)) (= (nth lst i) :destructure)) (strip-dest (+ i 2))) (true (cons (nth lst i) (strip-dest (+ i 1))))))) (strip-dest 0)))) (append (append acc (list stripped)) (map (fn (n) (list (quote __bind-from-detail__) n)) dest-names))) (append acc (list c)))) (list) (rest ast)))) + (let + ((compiled (map hs-to-sx expanded))) + (if + (and + (> (len compiled) 1) + (some + (fn + (c) + (and + (list? c) + (or + (= (first c) (quote hs-fetch)) + (= (first c) (quote hs-wait)) + (= (first c) (quote hs-wait-for)) + (= (first c) (quote hs-wait-for-or)) + (= (first c) (quote hs-query-first)) + (= (first c) (quote hs-query-all)) + (= (first c) (quote perform))))) + compiled)) + (reduce (fn - (c) - (and - (list? c) - (or - (= (first c) (quote hs-fetch)) - (= (first c) (quote hs-wait)) - (= (first c) (quote hs-wait-for)) - (= (first c) (quote hs-query-first)) - (= (first c) (quote hs-query-all)) - (= (first c) (quote perform))))) - compiled)) - (reduce - (fn - (body cmd) - (if - (and - (list? cmd) - (= (first cmd) (quote hs-fetch))) - (list - (quote let) - (list (list (quote it) cmd)) + (body cmd) + (if + (and + (list? cmd) + (= (first cmd) (quote hs-fetch))) (list - (quote begin) + (quote let) + (list (list (quote it) cmd)) (list - (quote set!) - (quote the-result) - (quote it)) - body)) - (list - (quote let) - (list (list (quote it) cmd)) - body))) - (nth compiled (- (len compiled) 1)) - (rest (reverse compiled))) - (cons (quote do) compiled)))) + (quote begin) + (list + (quote set!) + (quote the-result) + (quote it)) + body)) + (list + (quote let) + (list (list (quote it) cmd)) + body))) + (nth compiled (- (len compiled) 1)) + (rest (reverse compiled))) + (cons (quote do) compiled))))) ((= head (quote wait)) (list (quote hs-wait) (nth ast 1))) ((= head (quote wait-for)) (emit-wait-for ast)) ((= head (quote log)) diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index 92556fd9..233eb9b7 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -1386,21 +1386,17 @@ ((event-name (tp-val))) (adv!) (let - ((source (if (match-kw "from") (parse-expr) nil))) + ((destructure (if (= (tp-type) "paren-open") (let ((_ (adv!))) (define collect-dnames (fn (acc) (cond ((or (= (tp-type) "paren-close") (at-end?)) (do (if (= (tp-type) "paren-close") (adv!) nil) acc)) ((= (tp-type) "comma") (do (adv!) (collect-dnames acc))) (true (let ((name (tp-val))) (adv!) (collect-dnames (append acc (list name)))))))) (collect-dnames (list))) nil))) (let - ((timeout-dur (if (match-kw "or") (if (= (tp-type) "number") (let ((tok (adv!))) (let ((raw (get tok "value")) (suffix (if (and (= (tp-type) "ident") (or (= (tp-val) "ms") (= (tp-val) "s"))) (get (adv!) "value") ""))) (parse-dur (str raw suffix)))) nil) nil))) - (cond - ((and source timeout-dur) - (list - (quote wait-for) - event-name - :from source - :or timeout-dur)) - (source - (list (quote wait-for) event-name :from source)) - (timeout-dur - (list (quote wait-for) event-name :or timeout-dur)) - (true (list (quote wait-for) event-name))))))) + ((source (if (match-kw "from") (parse-expr) nil))) + (let + ((timeout-dur (if (match-kw "or") (if (= (tp-type) "number") (let ((tok (adv!))) (let ((raw (get tok "value")) (suffix (if (and (= (tp-type) "ident") (or (= (tp-val) "ms") (= (tp-val) "s"))) (get (adv!) "value") ""))) (parse-dur (str raw suffix)))) nil) nil))) + (let + ((base (cond ((and source timeout-dur) (list (quote wait-for) event-name :from source :or timeout-dur)) (source (list (quote wait-for) event-name :from source)) (timeout-dur (list (quote wait-for) event-name :or timeout-dur)) (true (list (quote wait-for) event-name))))) + (if + destructure + (append base (list :destructure destructure)) + base))))))) ((= (tp-type) "number") (let ((tok (adv!))) diff --git a/lib/hyperscript/runtime.sx b/lib/hyperscript/runtime.sx index 2576b3f9..eb7103c6 100644 --- a/lib/hyperscript/runtime.sx +++ b/lib/hyperscript/runtime.sx @@ -48,11 +48,17 @@ (define hs-wait (fn (ms) (perform (list (quote io-sleep) ms)))) ;; Wait for CSS transitions/animations to settle on an element. -(define - hs-wait-for - (fn - (target event-name) - (perform (list (quote io-wait-event) target event-name)))) +(begin + (define + hs-wait-for + (fn + (target event-name) + (perform (list (quote io-wait-event) target event-name)))) + (define + hs-wait-for-or + (fn + (target event-name timeout-ms) + (perform (list (quote io-wait-event) target event-name timeout-ms))))) ;; ── Class manipulation ────────────────────────────────────────── diff --git a/shared/static/wasm/sx/hs-compiler.sx b/shared/static/wasm/sx/hs-compiler.sx index fb0171ad..f00d6fef 100644 --- a/shared/static/wasm/sx/hs-compiler.sx +++ b/shared/static/wasm/sx/hs-compiler.sx @@ -348,11 +348,30 @@ (fn (ast) (let - ((event-name (nth ast 1))) - (if - (and (> (len ast) 2) (= (nth ast 2) :from)) - (list (quote hs-wait-for) (hs-to-sx (nth ast 3)) event-name) - (list (quote hs-wait-for) (quote me) event-name))))) + ((event-name (nth ast 1)) + (has-from (and (> (len ast) 2) (= (nth ast 2) :from))) + (has-from-or + (and + (> (len ast) 4) + (= (nth ast 2) :from) + (= (nth ast 4) :or))) + (has-or (and (> (len ast) 2) (= (nth ast 2) :or)))) + (cond + (has-from-or + (list + (quote hs-wait-for-or) + (hs-to-sx (nth ast 3)) + event-name + (nth ast 5))) + (has-from + (list (quote hs-wait-for) (hs-to-sx (nth ast 3)) event-name)) + (has-or + (list + (quote hs-wait-for-or) + (quote me) + event-name + (nth ast 3))) + (true (list (quote hs-wait-for) (quote me) event-name)))))) (define emit-transition (fn @@ -666,6 +685,16 @@ (let ((head (first ast))) (cond + ((= head (quote __bind-from-detail__)) + (let + ((name-str (nth ast 1))) + (list + (quote define) + (make-symbol name-str) + (list + (quote host-get) + (list (quote host-get) (quote it) "detail") + name-str)))) ((= head (quote sender)) (list (quote hs-sender) (quote event))) ((= head (quote null-literal)) nil) @@ -1500,47 +1529,50 @@ (hs-to-sx (nth ast 2))))) ((= head (quote do)) (let - ((compiled (map hs-to-sx (rest ast)))) - (if - (and - (> (len compiled) 1) - (some + ((expanded (reduce (fn (acc c) (if (and (list? c) (> (len c) 0) (= (first c) (quote wait-for)) (contains? c :destructure)) (let ((dest-names (let ((lst c)) (define scan-dest (fn (i) (cond ((>= i (- (len lst) 1)) (list)) ((= (nth lst i) :destructure) (nth lst (+ i 1))) (true (scan-dest (+ i 2)))))) (scan-dest 2))) (stripped (let ((lst c)) (define strip-dest (fn (i) (cond ((>= i (len lst)) (list)) ((and (< i (- (len lst) 1)) (= (nth lst i) :destructure)) (strip-dest (+ i 2))) (true (cons (nth lst i) (strip-dest (+ i 1))))))) (strip-dest 0)))) (append (append acc (list stripped)) (map (fn (n) (list (quote __bind-from-detail__) n)) dest-names))) (append acc (list c)))) (list) (rest ast)))) + (let + ((compiled (map hs-to-sx expanded))) + (if + (and + (> (len compiled) 1) + (some + (fn + (c) + (and + (list? c) + (or + (= (first c) (quote hs-fetch)) + (= (first c) (quote hs-wait)) + (= (first c) (quote hs-wait-for)) + (= (first c) (quote hs-wait-for-or)) + (= (first c) (quote hs-query-first)) + (= (first c) (quote hs-query-all)) + (= (first c) (quote perform))))) + compiled)) + (reduce (fn - (c) - (and - (list? c) - (or - (= (first c) (quote hs-fetch)) - (= (first c) (quote hs-wait)) - (= (first c) (quote hs-wait-for)) - (= (first c) (quote hs-query-first)) - (= (first c) (quote hs-query-all)) - (= (first c) (quote perform))))) - compiled)) - (reduce - (fn - (body cmd) - (if - (and - (list? cmd) - (= (first cmd) (quote hs-fetch))) - (list - (quote let) - (list (list (quote it) cmd)) + (body cmd) + (if + (and + (list? cmd) + (= (first cmd) (quote hs-fetch))) (list - (quote begin) + (quote let) + (list (list (quote it) cmd)) (list - (quote set!) - (quote the-result) - (quote it)) - body)) - (list - (quote let) - (list (list (quote it) cmd)) - body))) - (nth compiled (- (len compiled) 1)) - (rest (reverse compiled))) - (cons (quote do) compiled)))) + (quote begin) + (list + (quote set!) + (quote the-result) + (quote it)) + body)) + (list + (quote let) + (list (list (quote it) cmd)) + body))) + (nth compiled (- (len compiled) 1)) + (rest (reverse compiled))) + (cons (quote do) compiled))))) ((= head (quote wait)) (list (quote hs-wait) (nth ast 1))) ((= head (quote wait-for)) (emit-wait-for ast)) ((= head (quote log)) diff --git a/shared/static/wasm/sx/hs-parser.sx b/shared/static/wasm/sx/hs-parser.sx index 92556fd9..30523f26 100644 --- a/shared/static/wasm/sx/hs-parser.sx +++ b/shared/static/wasm/sx/hs-parser.sx @@ -1386,21 +1386,17 @@ ((event-name (tp-val))) (adv!) (let - ((source (if (match-kw "from") (parse-expr) nil))) + ((destructure (if (= (tp-type) "paren-open") (let ((_ (adv!))) (define collect-dnames (fn (acc) (cond ((or (= (tp-type) "paren-close") (at-end?)) (do (if (= (tp-type) "paren-close") (adv!) nil) acc)) ((= (tp-type) "comma") (do (adv!) (collect-dnames acc))) (true (let ((name (tp-val))) (adv!) (collect-dnames (append acc (list name)))))))) (collect-dnames (list))) nil))) (let - ((timeout-dur (if (match-kw "or") (if (= (tp-type) "number") (let ((tok (adv!))) (let ((raw (get tok "value")) (suffix (if (and (= (tp-type) "ident") (or (= (tp-val) "ms") (= (tp-val) "s"))) (get (adv!) "value") ""))) (parse-dur (str raw suffix)))) nil) nil))) - (cond - ((and source timeout-dur) - (list - (quote wait-for) - event-name - :from source - :or timeout-dur)) - (source - (list (quote wait-for) event-name :from source)) - (timeout-dur - (list (quote wait-for) event-name :or timeout-dur)) - (true (list (quote wait-for) event-name))))))) + ((source (if (match-kw "from") (parse-expr) nil))) + (let + ((timeout-dur (if (match-kw "or") (if (= (tp-type) "number") (let ((tok (adv!))) (let ((raw (get tok "value")) (suffix (if (and (= (tp-type) "ident") (or (= (tp-val) "ms") (= (tp-val) "s"))) (get (adv!) "value") ""))) (parse-dur (str raw suffix)))) nil) nil))) + (let + ((base (cond ((and source timeout-dur) (list (quote wait-for) event-name :from source :or timeout-dur)) (source (list (quote wait-for) event-name :from source)) (timeout-dur (list (quote wait-for) event-name :or timeout-dur)) (true (list (quote wait-for) event-name))))) + (if + destructure + (append base (list :destructure destructure)) + base))))))) ((= (tp-type) "number") (let ((tok (adv!))) @@ -2476,6 +2472,14 @@ (let ((acc2 (append acc (list cmd)))) (cond + ((match-kw "unless") + (let + ((cnd (parse-expr))) + (cl-collect + (append + acc + (list + (list (quote if) (list (quote no) cnd) cmd)))))) ((match-kw "then") (cl-collect (append acc2 (list (quote __then__))))) ((and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val))) diff --git a/shared/static/wasm/sx/hs-runtime.sx b/shared/static/wasm/sx/hs-runtime.sx index 2576b3f9..eb7103c6 100644 --- a/shared/static/wasm/sx/hs-runtime.sx +++ b/shared/static/wasm/sx/hs-runtime.sx @@ -48,11 +48,17 @@ (define hs-wait (fn (ms) (perform (list (quote io-sleep) ms)))) ;; Wait for CSS transitions/animations to settle on an element. -(define - hs-wait-for - (fn - (target event-name) - (perform (list (quote io-wait-event) target event-name)))) +(begin + (define + hs-wait-for + (fn + (target event-name) + (perform (list (quote io-wait-event) target event-name)))) + (define + hs-wait-for-or + (fn + (target event-name timeout-ms) + (perform (list (quote io-wait-event) target event-name timeout-ms))))) ;; ── Class manipulation ────────────────────────────────────────── diff --git a/spec/tests/test-hyperscript-behavioral.sx b/spec/tests/test-hyperscript-behavioral.sx index 23324d3b..d830aae7 100644 --- a/spec/tests/test-hyperscript-behavioral.sx +++ b/spec/tests/test-hyperscript-behavioral.sx @@ -13004,7 +13004,7 @@ end") (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (dom-dispatch _el-div "foo" nil) + (dom-dispatch _el-div "foo" {:bar "bar"}) (assert= (dom-text-content _el-div) "bar") )) (deftest "can wait on event" @@ -13070,7 +13070,7 @@ end") (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (dom-dispatch _el-div "foo" nil) + (dom-dispatch _el-div "foo" "hyperscript is hyper cool") (assert= (dom-text-content _el-div) "hyperscript is hyper cool") )) ) diff --git a/tests/hs-run-filtered.js b/tests/hs-run-filtered.js index cf9d3433..12485c67 100755 --- a/tests/hs-run-filtered.js +++ b/tests/hs-run-filtered.js @@ -341,7 +341,23 @@ globalThis._driveAsync=function driveAsync(r,d){d=d||0;if(d>500||!r||!r.suspende else if(opName==='io-parse-json'){const resp=items&&items[1];try{doResume(JSON.parse(typeof resp==='string'?resp:resp&&resp._json?resp._json:'{}'));}catch(e){doResume(null);}} else if(opName==='io-parse-html'){const frag=new El('fragment');frag.nodeType=11;doResume(frag);} else if(opName==='io-settle')doResume(null); - else if(opName==='io-wait-event')doResume(null); + else if(opName==='io-wait-event'){ + const target=items&&items[1]; + const evName=typeof items[2]==='string'?items[2]:''; + const timeout=items&&items.length>3?items[3]:undefined; + if(typeof timeout==='number'){ + // `wait for EV or Nms` — timeout wins immediately in the mock (tests use 0ms) + doResume(null); + } else if(target && target instanceof El && evName){ + const handler=function(ev){ + target.removeEventListener(evName,handler); + doResume(ev); + }; + target.addEventListener(evName,handler); + } else { + doResume(null); + } + } else if(opName==='io-transition')doResume(null); }; diff --git a/tests/playwright/generate-sx-tests.py b/tests/playwright/generate-sx-tests.py index fcf0fe47..7e0ef0d1 100644 --- a/tests/playwright/generate-sx-tests.py +++ b/tests/playwright/generate-sx-tests.py @@ -783,6 +783,25 @@ def _window_setup_ops(assign_body): return out +def _extract_detail_expr(opts_src): + """Extract `detail: ...` from an event options block like `, { detail: X }`. + Returns an SX expression string, defaulting to `nil`.""" + if not opts_src: + return 'nil' + # Plain string detail + dm = re.search(r'detail:\s*"([^"]*)"', opts_src) + if dm: + return f'"{dm.group(1)}"' + # Simple object detail: { k: "v", k2: "v2", ... } (string values only) + dm = re.search(r'detail:\s*\{([^{}]*)\}', opts_src) + if dm: + pairs = re.findall(r'(\w+):\s*"([^"]*)"', dm.group(1)) + if pairs: + items = ' '.join(f':{k} "{v}"' for k, v in pairs) + return '{' + items + '}' + return 'nil' + + def parse_dev_body(body, elements, var_names): """Parse Playwright test body into ordered SX ops. @@ -950,13 +969,15 @@ def parse_dev_body(body, elements, var_names): m = re.match( r"evaluate\(\s*\(\)\s*=>\s*document\.querySelector\(\s*(['\"])([^'\"]+)\1\s*\)" r"\.dispatchEvent\(\s*new\s+(?:Custom)?Event\(\s*(['\"])([^'\"]+)\3" - r"(?:\s*,\s*[^)]*)?\s*\)\s*\)\s*\)\s*$", + r"(\s*,\s*\{.*\})?\s*\)\s*\)\s*\)\s*$", stmt_na, re.DOTALL, ) if m and seen_html: sel = re.sub(r'^#work-area\s+', '', m.group(2)) target = selector_to_sx(sel, elements, var_names) - ops.append(f'(dom-dispatch {target} "{m.group(4)}" nil)') + opts = m.group(5) or '' + detail_expr = _extract_detail_expr(opts) + ops.append(f'(dom-dispatch {target} "{m.group(4)}" {detail_expr})') continue # evaluate(() => { const e = new Event(NAME, {...}); document.querySelector(SEL).dispatchEvent(e); }) @@ -964,15 +985,17 @@ def parse_dev_body(body, elements, var_names): m = re.match( r"evaluate\(\s*\(\)\s*=>\s*\{\s*" r"const\s+(\w+)\s*=\s*new\s+(?:Custom)?Event\(\s*(['\"])([^'\"]+)\2" - r"(?:\s*,\s*\{[^}]*\})?\s*\)\s*;\s*" - r"document\.querySelector\(\s*(['\"])([^'\"]+)\4\s*\)" + r"(\s*,\s*\{[^}]*\})?\s*\)\s*;\s*" + r"document\.querySelector\(\s*(['\"])([^'\"]+)\5\s*\)" r"\.dispatchEvent\(\s*\1\s*\)\s*;?\s*\}\s*\)\s*$", stmt_na, re.DOTALL, ) if m and seen_html: - sel = re.sub(r'^#work-area\s+', '', m.group(5)) + sel = re.sub(r'^#work-area\s+', '', m.group(6)) target = selector_to_sx(sel, elements, var_names) - ops.append(f'(dom-dispatch {target} "{m.group(3)}" nil)') + opts = m.group(4) or '' + detail_expr = _extract_detail_expr(opts) + ops.append(f'(dom-dispatch {target} "{m.group(3)}" {detail_expr})') continue # evaluate(() => document.getElementById(ID).METHOD()) — generic