From 7ecdd59335c2ad4fe1038f73806431336defd01f Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 23 Apr 2026 17:22:25 +0000 Subject: [PATCH] HS trigger: compound event names + detail, event-refs via host-get MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - parse-trigger-cmd: use parse-compound-event-name so 'trigger foo:bar' and 'trigger foo.bar' preserve the full event name. Also parse an optional detail dict '(x:42)' like parse-send-cmd. - compiler: 3-arg (trigger NAME DETAIL TGT) emits dom-dispatch with the detail dict. 2-arg (trigger NAME TGT) unchanged. - emit-on event-ref bindings now use (host-get event 'detail') → the event carries detail as a JS object, so the SX 'get' primitive returned nil and tests checking 'on foo(x) … x' saw empty values. Net: trigger 2→6 (100%). --- lib/hyperscript/compiler.sx | 21 +++++++++++++++------ lib/hyperscript/parser.sx | 11 ++++++++--- shared/static/wasm/sx/hs-compiler.sx | 21 +++++++++++++++------ shared/static/wasm/sx/hs-parser.sx | 11 ++++++++--- 4 files changed, 46 insertions(+), 18 deletions(-) diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index fa3d3dab..80fbbf20 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -162,7 +162,7 @@ (let ((raw-compiled (hs-to-sx stripped-body))) (let - ((compiled-body (if (> (len event-refs) 0) (let ((bindings (map (fn (r) (let ((name (nth r 1))) (list (make-symbol name) (list (quote get) (list (quote get) (quote event) "detail") name)))) event-refs))) (list (quote let) bindings raw-compiled)) raw-compiled))) + ((compiled-body (if (> (len event-refs) 0) (let ((bindings (map (fn (r) (let ((name (nth r 1))) (list (make-symbol name) (list (quote host-get) (list (quote host-get) (quote event) "detail") name)))) event-refs))) (list (quote let) bindings raw-compiled)) raw-compiled))) (let ((wrapped-body (if catch-info (let ((var (make-symbol (nth catch-info 0))) (catch-body (hs-to-sx (nth catch-info 1)))) (if finally-info (list (quote do) (list (quote guard) (list var (list true catch-body)) compiled-body) (hs-to-sx finally-info)) (list (quote guard) (list var (list true catch-body)) compiled-body))) (if finally-info (list (quote do) compiled-body (hs-to-sx finally-info)) compiled-body))) (handler @@ -1468,11 +1468,20 @@ (list (quote console-log) (hs-to-sx (nth ast 1)))) ((= head (quote send)) (emit-send ast)) ((= head (quote trigger)) - (list - (quote dom-dispatch) - (hs-to-sx (nth ast 2)) - (nth ast 1) - nil)) + (let + ((name (nth ast 1)) + (has-detail + (and + (= (len ast) 4) + (list? (nth ast 2)) + (= (first (nth ast 2)) (quote dict)))) + (tgt (if (= (len ast) 4) (nth ast 3) (nth ast 2))) + (detail (if (= (len ast) 4) (nth ast 2) nil))) + (list + (quote dom-dispatch) + (hs-to-sx tgt) + name + (if has-detail (hs-to-sx detail) nil)))) ((= head (quote hide)) (let ((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt)))) diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index 73c09450..91a6cdf7 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -1438,10 +1438,15 @@ (fn () (let - ((name (get (adv!) "value"))) + ((name (parse-compound-event-name))) (let - ((tgt (parse-tgt-kw "on" (list (quote me))))) - (list (quote trigger) name tgt))))) + ((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil))) + (let + ((tgt (parse-tgt-kw "on" (list (quote me))))) + (if + dtl + (list (quote trigger) name dtl tgt) + (list (quote trigger) name tgt))))))) (define parse-log-cmd (fn () (list (quote log) (parse-expr)))) (define parse-inc-cmd diff --git a/shared/static/wasm/sx/hs-compiler.sx b/shared/static/wasm/sx/hs-compiler.sx index fa3d3dab..80fbbf20 100644 --- a/shared/static/wasm/sx/hs-compiler.sx +++ b/shared/static/wasm/sx/hs-compiler.sx @@ -162,7 +162,7 @@ (let ((raw-compiled (hs-to-sx stripped-body))) (let - ((compiled-body (if (> (len event-refs) 0) (let ((bindings (map (fn (r) (let ((name (nth r 1))) (list (make-symbol name) (list (quote get) (list (quote get) (quote event) "detail") name)))) event-refs))) (list (quote let) bindings raw-compiled)) raw-compiled))) + ((compiled-body (if (> (len event-refs) 0) (let ((bindings (map (fn (r) (let ((name (nth r 1))) (list (make-symbol name) (list (quote host-get) (list (quote host-get) (quote event) "detail") name)))) event-refs))) (list (quote let) bindings raw-compiled)) raw-compiled))) (let ((wrapped-body (if catch-info (let ((var (make-symbol (nth catch-info 0))) (catch-body (hs-to-sx (nth catch-info 1)))) (if finally-info (list (quote do) (list (quote guard) (list var (list true catch-body)) compiled-body) (hs-to-sx finally-info)) (list (quote guard) (list var (list true catch-body)) compiled-body))) (if finally-info (list (quote do) compiled-body (hs-to-sx finally-info)) compiled-body))) (handler @@ -1468,11 +1468,20 @@ (list (quote console-log) (hs-to-sx (nth ast 1)))) ((= head (quote send)) (emit-send ast)) ((= head (quote trigger)) - (list - (quote dom-dispatch) - (hs-to-sx (nth ast 2)) - (nth ast 1) - nil)) + (let + ((name (nth ast 1)) + (has-detail + (and + (= (len ast) 4) + (list? (nth ast 2)) + (= (first (nth ast 2)) (quote dict)))) + (tgt (if (= (len ast) 4) (nth ast 3) (nth ast 2))) + (detail (if (= (len ast) 4) (nth ast 2) nil))) + (list + (quote dom-dispatch) + (hs-to-sx tgt) + name + (if has-detail (hs-to-sx detail) nil)))) ((= head (quote hide)) (let ((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt)))) diff --git a/shared/static/wasm/sx/hs-parser.sx b/shared/static/wasm/sx/hs-parser.sx index 73c09450..91a6cdf7 100644 --- a/shared/static/wasm/sx/hs-parser.sx +++ b/shared/static/wasm/sx/hs-parser.sx @@ -1438,10 +1438,15 @@ (fn () (let - ((name (get (adv!) "value"))) + ((name (parse-compound-event-name))) (let - ((tgt (parse-tgt-kw "on" (list (quote me))))) - (list (quote trigger) name tgt))))) + ((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil))) + (let + ((tgt (parse-tgt-kw "on" (list (quote me))))) + (if + dtl + (list (quote trigger) name dtl tgt) + (list (quote trigger) name tgt))))))) (define parse-log-cmd (fn () (list (quote log) (parse-expr)))) (define parse-inc-cmd