HS trigger: compound event names + detail, event-refs via host-get
- 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%).
This commit is contained in:
@@ -162,7 +162,7 @@
|
|||||||
(let
|
(let
|
||||||
((raw-compiled (hs-to-sx stripped-body)))
|
((raw-compiled (hs-to-sx stripped-body)))
|
||||||
(let
|
(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
|
(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)))
|
((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
|
(handler
|
||||||
@@ -1468,11 +1468,20 @@
|
|||||||
(list (quote console-log) (hs-to-sx (nth ast 1))))
|
(list (quote console-log) (hs-to-sx (nth ast 1))))
|
||||||
((= head (quote send)) (emit-send ast))
|
((= head (quote send)) (emit-send ast))
|
||||||
((= head (quote trigger))
|
((= head (quote trigger))
|
||||||
(list
|
(let
|
||||||
(quote dom-dispatch)
|
((name (nth ast 1))
|
||||||
(hs-to-sx (nth ast 2))
|
(has-detail
|
||||||
(nth ast 1)
|
(and
|
||||||
nil))
|
(= (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))
|
((= head (quote hide))
|
||||||
(let
|
(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))))
|
((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))))
|
||||||
|
|||||||
@@ -1438,10 +1438,15 @@
|
|||||||
(fn
|
(fn
|
||||||
()
|
()
|
||||||
(let
|
(let
|
||||||
((name (get (adv!) "value")))
|
((name (parse-compound-event-name)))
|
||||||
(let
|
(let
|
||||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil)))
|
||||||
(list (quote trigger) name tgt)))))
|
(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-log-cmd (fn () (list (quote log) (parse-expr))))
|
||||||
(define
|
(define
|
||||||
parse-inc-cmd
|
parse-inc-cmd
|
||||||
|
|||||||
@@ -162,7 +162,7 @@
|
|||||||
(let
|
(let
|
||||||
((raw-compiled (hs-to-sx stripped-body)))
|
((raw-compiled (hs-to-sx stripped-body)))
|
||||||
(let
|
(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
|
(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)))
|
((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
|
(handler
|
||||||
@@ -1468,11 +1468,20 @@
|
|||||||
(list (quote console-log) (hs-to-sx (nth ast 1))))
|
(list (quote console-log) (hs-to-sx (nth ast 1))))
|
||||||
((= head (quote send)) (emit-send ast))
|
((= head (quote send)) (emit-send ast))
|
||||||
((= head (quote trigger))
|
((= head (quote trigger))
|
||||||
(list
|
(let
|
||||||
(quote dom-dispatch)
|
((name (nth ast 1))
|
||||||
(hs-to-sx (nth ast 2))
|
(has-detail
|
||||||
(nth ast 1)
|
(and
|
||||||
nil))
|
(= (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))
|
((= head (quote hide))
|
||||||
(let
|
(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))))
|
((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))))
|
||||||
|
|||||||
@@ -1438,10 +1438,15 @@
|
|||||||
(fn
|
(fn
|
||||||
()
|
()
|
||||||
(let
|
(let
|
||||||
((name (get (adv!) "value")))
|
((name (parse-compound-event-name)))
|
||||||
(let
|
(let
|
||||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil)))
|
||||||
(list (quote trigger) name tgt)))))
|
(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-log-cmd (fn () (list (quote log) (parse-expr))))
|
||||||
(define
|
(define
|
||||||
parse-inc-cmd
|
parse-inc-cmd
|
||||||
|
|||||||
Reference in New Issue
Block a user