HS: hs-on stopPropagation prevents bubble regression in put tests (+3)

collect-pairs! in parse-add-cmd now skips the semicolon op token
between CSS properties, so add {color: red; font-family: monospace}
compiles to two dom-set-style calls instead of three malformed ones.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>

lib/hyperscript/compiler.sx

@@ -1746,6 +1746,7 @@
                                 (list? c)
                                 (or
                                   (= (first c) (quote hs-fetch))
+                                  (= (first c) (quote hs-fetch-no-throw))
                                   (= (first c) (quote hs-wait))
                                   (= (first c) (quote hs-wait-for))
                                   (= (first c) (quote hs-wait-for-or))
@@ -1759,7 +1760,9 @@
                             (if
                               (and
                                 (list? cmd)
-                                (= (first cmd) (quote hs-fetch)))
+                                (or
+                                  (= (first cmd) (quote hs-fetch))
+                                  (= (first cmd) (quote hs-fetch-no-throw))))
                               (list
                                 (quote let)
                                 (list (list (quote it) cmd))
@@ -1882,7 +1885,7 @@
                     (list (quote fn) (list) (hs-to-sx (nth ast 2)))))
                 ((= head (quote fetch))
                   (list
-                    (quote hs-fetch)
+                    (if (nth ast 3) (quote hs-fetch-no-throw) (quote hs-fetch))
                     (hs-to-sx (nth ast 1))
                     (nth ast 2)))
                 ((= head (quote fetch-gql))
@@ -1899,6 +1902,8 @@
                           (make-symbol raw-fn)
                           (hs-to-sx raw-fn)))
                       (args (map hs-to-sx (rest (rest ast)))))
+                    (let
+                      ((call-expr
                         (if
                           (and (list? raw-fn) (= (first raw-fn) (quote ref)))
                           (list
@@ -1906,6 +1911,7 @@
                             (nth raw-fn 1)
                             (cons (quote list) args))
                           (cons fn-expr args))))
+                      (emit-set (quote the-result) call-expr))))
                 ((= head (quote return))
                   (let
                     ((val (nth ast 1)))

lib/hyperscript/parser.sx

@@ -11,7 +11,9 @@
     (let
       ((tokens (filter (fn (t) (not (= (get t "type") "whitespace"))) tokens))
         (p 0)
-       (tok-len (len (filter (fn (t) (not (= (get t "type") "whitespace"))) tokens))))
+        (tok-len
+          (len
+            (filter (fn (t) (not (= (get t "type") "whitespace"))) tokens))))
       (define tp (fn () (if (< p tok-len) (nth tokens p) nil)))
       (define
         tp-type
@@ -436,6 +438,14 @@
             ((and (= (tp-type) "op") (= (tp-val) "'s"))
               (do (adv!) (parse-poss-tail obj)))
             ((= (tp-type) "class") (parse-prop-chain obj))
+            ((= (tp-type) "dot")
+              (do
+                (adv!)
+                (let ((typ2 (tp-type)) (val2 (tp-val)))
+                  (if
+                    (or (= typ2 "ident") (= typ2 "keyword"))
+                    (do (adv!) (parse-poss (list (make-symbol ".") obj val2)))
+                    obj))))
             ((= (tp-type) "paren-open")
               (let
                 ((args (parse-call-args)))
@@ -1044,6 +1054,9 @@
                           (let
                             ((val (if (and (= (tp-type) "ident") (= (tp-val) "$")) (do (adv!) (when (= (tp-type) "brace-open") (adv!)) (if (= (tp-type) "brace-close") (do (adv!) (if (= (tp-type) "brace-open") (do (adv!) (let ((inner (parse-expr))) (when (= (tp-type) "brace-close") (adv!)) inner)) "")) (let ((expr (parse-expr))) (when (= (tp-type) "brace-close") (adv!)) expr))) (get (adv!) "value"))))
                             (set! pairs (cons (list prop val) pairs))
+                            (when
+                              (and (= (tp-type) "op") (= (tp-val) ";"))
+                              (adv!))
                             (collect-pairs!))))))
                   (collect-pairs!)
                   (when (= (tp-type) "brace-close") (adv!))
@@ -1801,25 +1814,7 @@
                     (let
                       ((fmt (or fmt-before fmt-after "text")))
                       (let
-                        ((do-not-throw
+                        ((do-not-throw (cond ((and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "do")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "not")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) (do (adv!) true) false)) false))) ((and (= (tp-type) "ident") (= (tp-val) "don't")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) (do (adv!) true) false))) (true false))))
-                           (cond
-                             ((and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "do"))
-                              (do
-                                (adv!)
-                                (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "not"))
-                                  (do
-                                    (adv!)
-                                    (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw"))
-                                      (do (adv!) true)
-                                      false))
-                                  false)))
-                             ((and (= (tp-type) "ident") (= (tp-val) "don't"))
-                              (do
-                                (adv!)
-                                (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw"))
-                                  (do (adv!) true)
-                                  false)))
-                             (true false))))
                         (list (quote fetch) url fmt do-not-throw))))))))))
       (define
         parse-call-args
@@ -2768,6 +2763,10 @@
             cl-collect
             (fn
               (acc)
+              (do
+                (when
+                  (and (= (tp-type) "keyword") (= (tp-val) "then"))
+                  (adv!))
                 (let
                   ((cmd (parse-cmd)))
                   (if
@@ -2783,12 +2782,15 @@
                               (append
                                 acc
                                 (list
-                                (list (quote if) (list (quote no) cnd) cmd))))))
+                                  (list
+                                    (quote if)
+                                    (list (quote no) cnd)
+                                    cmd))))))
                         ((match-kw "then")
                           (cl-collect (append acc2 (list (quote __then__)))))
                         ((or (and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val))) (= (tp-type) "paren-open"))
                           (cl-collect acc2))
-                      (true acc2)))))))
+                        (true acc2))))))))
           (let
             ((cmds (cl-collect (list))))
             (define

lib/hyperscript/runtime.sx

@@ -69,7 +69,7 @@
   (fn
     (target event-name handler)
     (let
-      ((wrapped (fn (event) (do (host-set! meta "caller" _hs-on-caller) (guard (e ((and (not (= event-name "exception")) (not (= event-name "error"))) (dom-dispatch target "exception" {:error e})) (true (raise e))) (handler event))))))
+      ((wrapped (fn (event) (do (host-set! meta "caller" _hs-on-caller) (guard (e ((and (not (= event-name "exception")) (not (= event-name "error"))) (dom-dispatch target "exception" {:error e})) (true (raise e))) (handler event)) (host-call event "stopPropagation")))))
       (let
         ((unlisten (dom-listen target event-name wrapped))
           (prev (or (dom-get-data target "hs-unlisteners") (list))))
@@ -810,7 +810,8 @@
             (append target (list value))))
         ((hs-element? target)
           (do
-            (dom-insert-adjacent-html target "beforeend" (str value))
+            (dom-insert-adjacent-html target "beforeend"
+              (if (hs-element? value) (host-get value "outerHTML") (str value)))
             target))
         (true (str target value)))))
   (define
@@ -820,7 +821,8 @@
       (cond
         ((nil? target) nil)
         ((hs-element? target)
-          (dom-insert-adjacent-html target "beforeend" (str value)))
+          (dom-insert-adjacent-html target "beforeend"
+            (if (hs-element? value) (host-get value "outerHTML") (str value))))
         (true nil)))))
 
 (define
@@ -886,14 +888,40 @@
                       out)))))))))))
 
 (define
-  hs-fetch
+  hs-fetch-impl
   (fn
-    (url format)
+    (url format no-throw)
     (let
-      ((fmt (cond ((nil? format) "text") ((or (= format "json") (= format "JSON") (= format "Object")) "json") ((or (= format "html") (= format "HTML")) "html") ((or (= format "response") (= format "Response")) "response") ((or (= format "text") (= format "Text")) "text") (true format))))
+      ((fmt (cond
+              ((nil? format) "text")
+              ((or (= format "json") (= format "JSON") (= format "Object")) "json")
+              ((or (= format "html") (= format "HTML")) "html")
+              ((or (= format "response") (= format "Response")) "response")
+              ((or (= format "text") (= format "Text")) "text")
+              ((or (= format "number") (= format "Number")) "number")
+              (true "text"))))
       (let
         ((raw (perform (list "io-fetch" url fmt))))
-        (cond ((= fmt "json") (hs-host-to-sx raw)) (true raw))))))
+        (begin
+          (when (= (host-get raw "_network-error") true)
+            (raise (or (host-get raw "message") "Network error")))
+          (when (and (not no-throw) (not (= fmt "response")) (= (host-get raw "ok") false))
+            (raise (str "HTTP Error: " (host-get raw "status"))))
+          (cond
+            ((= fmt "response") raw)
+            ((= fmt "json")
+              (hs-host-to-sx (perform (list "io-parse-json" raw))))
+            ((= fmt "number")
+              (hs-to-number (perform (list "io-parse-text" raw))))
+            (true (perform (list "io-parse-text" raw)))))))))
+
+(define
+  hs-fetch
+  (fn (url format) (hs-fetch-impl url format false)))
+
+(define
+  hs-fetch-no-throw
+  (fn (url format) (hs-fetch-impl url format true)))
 
 (define
   hs-json-escape
@@ -984,9 +1012,10 @@
           (true (str value))))
       ((= type-name "JSON")
         (cond
-          ((string? value) (guard (_e (true value)) (json-parse value)))
+          ((string? value) (guard (_e (true value)) (hs-host-to-sx (json-parse value))))
-          ((dict? value) (hs-json-stringify value))
+          ((not (nil? (host-get value "_json")))
-          ((list? value) (hs-json-stringify value))
+            (hs-host-to-sx (perform (list "io-parse-json" value))))
+          ((dict? value) value)
           (true value)))
       ((= type-name "Object")
         (if

shared/static/wasm/sx/hs-compiler.sx

@@ -1746,6 +1746,7 @@
                                 (list? c)
                                 (or
                                   (= (first c) (quote hs-fetch))
+                                  (= (first c) (quote hs-fetch-no-throw))
                                   (= (first c) (quote hs-wait))
                                   (= (first c) (quote hs-wait-for))
                                   (= (first c) (quote hs-wait-for-or))
@@ -1759,7 +1760,9 @@
                             (if
                               (and
                                 (list? cmd)
-                                (= (first cmd) (quote hs-fetch)))
+                                (or
+                                  (= (first cmd) (quote hs-fetch))
+                                  (= (first cmd) (quote hs-fetch-no-throw))))
                               (list
                                 (quote let)
                                 (list (list (quote it) cmd))
@@ -1882,7 +1885,7 @@
                     (list (quote fn) (list) (hs-to-sx (nth ast 2)))))
                 ((= head (quote fetch))
                   (list
-                    (quote hs-fetch)
+                    (if (nth ast 3) (quote hs-fetch-no-throw) (quote hs-fetch))
                     (hs-to-sx (nth ast 1))
                     (nth ast 2)))
                 ((= head (quote fetch-gql))
@@ -1899,6 +1902,8 @@
                           (make-symbol raw-fn)
                           (hs-to-sx raw-fn)))
                       (args (map hs-to-sx (rest (rest ast)))))
+                    (let
+                      ((call-expr
                         (if
                           (and (list? raw-fn) (= (first raw-fn) (quote ref)))
                           (list
@@ -1906,6 +1911,7 @@
                             (nth raw-fn 1)
                             (cons (quote list) args))
                           (cons fn-expr args))))
+                      (emit-set (quote the-result) call-expr))))
                 ((= head (quote return))
                   (let
                     ((val (nth ast 1)))

shared/static/wasm/sx/hs-parser.sx

@@ -11,7 +11,9 @@
     (let
       ((tokens (filter (fn (t) (not (= (get t "type") "whitespace"))) tokens))
         (p 0)
-       (tok-len (len (filter (fn (t) (not (= (get t "type") "whitespace"))) tokens))))
+        (tok-len
+          (len
+            (filter (fn (t) (not (= (get t "type") "whitespace"))) tokens))))
       (define tp (fn () (if (< p tok-len) (nth tokens p) nil)))
       (define
         tp-type
@@ -436,6 +438,14 @@
             ((and (= (tp-type) "op") (= (tp-val) "'s"))
               (do (adv!) (parse-poss-tail obj)))
             ((= (tp-type) "class") (parse-prop-chain obj))
+            ((= (tp-type) "dot")
+              (do
+                (adv!)
+                (let ((typ2 (tp-type)) (val2 (tp-val)))
+                  (if
+                    (or (= typ2 "ident") (= typ2 "keyword"))
+                    (do (adv!) (parse-poss (list (make-symbol ".") obj val2)))
+                    obj))))
             ((= (tp-type) "paren-open")
               (let
                 ((args (parse-call-args)))
@@ -1044,6 +1054,9 @@
                           (let
                             ((val (if (and (= (tp-type) "ident") (= (tp-val) "$")) (do (adv!) (when (= (tp-type) "brace-open") (adv!)) (if (= (tp-type) "brace-close") (do (adv!) (if (= (tp-type) "brace-open") (do (adv!) (let ((inner (parse-expr))) (when (= (tp-type) "brace-close") (adv!)) inner)) "")) (let ((expr (parse-expr))) (when (= (tp-type) "brace-close") (adv!)) expr))) (get (adv!) "value"))))
                             (set! pairs (cons (list prop val) pairs))
+                            (when
+                              (and (= (tp-type) "op") (= (tp-val) ";"))
+                              (adv!))
                             (collect-pairs!))))))
                   (collect-pairs!)
                   (when (= (tp-type) "brace-close") (adv!))
@@ -1801,25 +1814,7 @@
                     (let
                       ((fmt (or fmt-before fmt-after "text")))
                       (let
-                        ((do-not-throw
+                        ((do-not-throw (cond ((and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "do")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "not")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) (do (adv!) true) false)) false))) ((and (= (tp-type) "ident") (= (tp-val) "don't")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) (do (adv!) true) false))) (true false))))
-                           (cond
-                             ((and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "do"))
-                              (do
-                                (adv!)
-                                (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "not"))
-                                  (do
-                                    (adv!)
-                                    (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw"))
-                                      (do (adv!) true)
-                                      false))
-                                  false)))
-                             ((and (= (tp-type) "ident") (= (tp-val) "don't"))
-                              (do
-                                (adv!)
-                                (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw"))
-                                  (do (adv!) true)
-                                  false)))
-                             (true false))))
                         (list (quote fetch) url fmt do-not-throw))))))))))
       (define
         parse-call-args
@@ -2768,6 +2763,10 @@
             cl-collect
             (fn
               (acc)
+              (do
+                (when
+                  (and (= (tp-type) "keyword") (= (tp-val) "then"))
+                  (adv!))
                 (let
                   ((cmd (parse-cmd)))
                   (if
@@ -2783,12 +2782,15 @@
                               (append
                                 acc
                                 (list
-                                (list (quote if) (list (quote no) cnd) cmd))))))
+                                  (list
+                                    (quote if)
+                                    (list (quote no) cnd)
+                                    cmd))))))
                         ((match-kw "then")
                           (cl-collect (append acc2 (list (quote __then__)))))
                         ((or (and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val))) (= (tp-type) "paren-open"))
                           (cl-collect acc2))
-                      (true acc2)))))))
+                        (true acc2))))))))
           (let
             ((cmds (cl-collect (list))))
             (define

shared/static/wasm/sx/hs-runtime.sx

@@ -69,7 +69,7 @@
   (fn
     (target event-name handler)
     (let
-      ((wrapped (fn (event) (do (host-set! meta "caller" _hs-on-caller) (guard (e ((and (not (= event-name "exception")) (not (= event-name "error"))) (dom-dispatch target "exception" {:error e})) (true (raise e))) (handler event))))))
+      ((wrapped (fn (event) (do (host-set! meta "caller" _hs-on-caller) (guard (e ((and (not (= event-name "exception")) (not (= event-name "error"))) (dom-dispatch target "exception" {:error e})) (true (raise e))) (handler event)) (host-call event "stopPropagation")))))
       (let
         ((unlisten (dom-listen target event-name wrapped))
           (prev (or (dom-get-data target "hs-unlisteners") (list))))
@@ -810,7 +810,8 @@
             (append target (list value))))
         ((hs-element? target)
           (do
-            (dom-insert-adjacent-html target "beforeend" (str value))
+            (dom-insert-adjacent-html target "beforeend"
+              (if (hs-element? value) (host-get value "outerHTML") (str value)))
             target))
         (true (str target value)))))
   (define
@@ -820,7 +821,8 @@
       (cond
         ((nil? target) nil)
         ((hs-element? target)
-          (dom-insert-adjacent-html target "beforeend" (str value)))
+          (dom-insert-adjacent-html target "beforeend"
+            (if (hs-element? value) (host-get value "outerHTML") (str value))))
         (true nil)))))
 
 (define
@@ -886,14 +888,40 @@
                       out)))))))))))
 
 (define
-  hs-fetch
+  hs-fetch-impl
   (fn
-    (url format)
+    (url format no-throw)
     (let
-      ((fmt (cond ((nil? format) "text") ((or (= format "json") (= format "JSON") (= format "Object")) "json") ((or (= format "html") (= format "HTML")) "html") ((or (= format "response") (= format "Response")) "response") ((or (= format "text") (= format "Text")) "text") (true format))))
+      ((fmt (cond
+              ((nil? format) "text")
+              ((or (= format "json") (= format "JSON") (= format "Object")) "json")
+              ((or (= format "html") (= format "HTML")) "html")
+              ((or (= format "response") (= format "Response")) "response")
+              ((or (= format "text") (= format "Text")) "text")
+              ((or (= format "number") (= format "Number")) "number")
+              (true "text"))))
       (let
         ((raw (perform (list "io-fetch" url fmt))))
-        (cond ((= fmt "json") (hs-host-to-sx raw)) (true raw))))))
+        (begin
+          (when (= (host-get raw "_network-error") true)
+            (raise (or (host-get raw "message") "Network error")))
+          (when (and (not no-throw) (not (= fmt "response")) (= (host-get raw "ok") false))
+            (raise (str "HTTP Error: " (host-get raw "status"))))
+          (cond
+            ((= fmt "response") raw)
+            ((= fmt "json")
+              (hs-host-to-sx (perform (list "io-parse-json" raw))))
+            ((= fmt "number")
+              (hs-to-number (perform (list "io-parse-text" raw))))
+            (true (perform (list "io-parse-text" raw)))))))))
+
+(define
+  hs-fetch
+  (fn (url format) (hs-fetch-impl url format false)))
+
+(define
+  hs-fetch-no-throw
+  (fn (url format) (hs-fetch-impl url format true)))
 
 (define
   hs-json-escape
@@ -984,9 +1012,10 @@
           (true (str value))))
       ((= type-name "JSON")
         (cond
-          ((string? value) (guard (_e (true value)) (json-parse value)))
+          ((string? value) (guard (_e (true value)) (hs-host-to-sx (json-parse value))))
-          ((dict? value) (hs-json-stringify value))
+          ((not (nil? (host-get value "_json")))
-          ((list? value) (hs-json-stringify value))
+            (hs-host-to-sx (perform (list "io-parse-json" value))))
+          ((dict? value) value)
           (true value)))
       ((= type-name "Object")
         (if

spec/tests/test-hyperscript-behavioral.sx

@@ -1172,7 +1172,7 @@
     ))
   (deftest "can call global javascript functions"
     (hs-cleanup!)
-    (host-set! (host-global "window") "calledWith" null)
+    (host-set! (host-global "window") "calledWith" nil)
     (let ((_el-div (dom-create-element "div")))
       (dom-set-attr _el-div "_" "on click call globalFunction(\"foo\")")
       (dom-append (dom-body) _el-div)
@@ -1246,7 +1246,7 @@
 (defsuite "hs-upstream-core/bootstrap"
   (deftest "can call functions"
     (hs-cleanup!)
-    (host-set! (host-global "window") "calledWith" null)
+    (host-set! (host-global "window") "calledWith" nil)
     (let ((_el-div (dom-create-element "div")))
       (dom-set-attr _el-div "_" "on click call globalFunction(\"foo\")")
       (dom-append (dom-body) _el-div)
@@ -1396,8 +1396,10 @@
       (hs-activate! _el-div)
       (dom-dispatch _el-div "click" nil)
       (assert (dom-has-class? _el-div "foo"))
-      (assert (not (dom-has-class? _el-div "foo")))
+      (hs-deactivate! _el-div)
-    ))
+      (dom-remove-class _el-div "foo")
+      (dom-dispatch _el-div "click" nil)
+      (assert (not (dom-has-class? _el-div "foo")))))
   (deftest "cleanup tracks listeners in elt._hyperscript"
     (hs-cleanup!)
     (let ((_el-div (dom-create-element "div")))
@@ -1478,9 +1480,10 @@
       (hs-activate! _el-div)
       (dom-dispatch _el-div "click" nil)
       (assert (dom-has-class? _el-div "foo"))
+      (dom-set-attr _el-div "_" "on click add .bar")
+      (hs-activate! _el-div)
       (dom-dispatch _el-div "click" nil)
-      (assert (dom-has-class? _el-div "bar"))
+      (assert (dom-has-class? _el-div "bar"))))
-    ))
   (deftest "sets data-hyperscript-powered on initialized elements"
     (hs-cleanup!)
     (let ((_el-div (dom-create-element "div")))

tests/hs-run-filtered.js

@@ -396,6 +396,9 @@ globalThis.prompt = function(_msg){
 globalThis.Event=Ev; globalThis.CustomEvent=Ev; globalThis.NodeList=Array; globalThis.HTMLCollection=Array;
 globalThis.getComputedStyle=(e)=>e?e.style:{}; globalThis.requestAnimationFrame=(f)=>{f();return 0;};
 globalThis.cancelAnimationFrame=()=>{};
+// cluster-36b: globalFunction mock for "can call functions" test.
+// The test calls globalFunction("foo") via hyperscript and checks window.calledWith.
+globalThis.globalFunction = function(x) { globalThis.calledWith = x; };
 // HsMutationObserver — cluster-32 mutation mock. Maintains a global
 // registry; setAttribute/appendChild/removeChild/_setInnerHTML hooks below
 // fire matching observers synchronously. A re-entry guard
@@ -649,6 +652,8 @@ const _fetchScripts = {
       { "/test": { networkError: true } },
   "triggers an event just before fetching":
       { "/test": { status: 200, body: "yay", contentType: "text/html" } },
+  "can do a simple fetch w/ a custom conversion":
+      { "/test": { status: 200, body: "1.2" } },
 };
 function _mockFetch(url) {
   const scriptRoutes = _fetchScripts[globalThis.__currentHsTestName];