HS: fix empty/halt/morph/reset/dialog — 17 upstream tests pass
- parser `empty` no-target → (ref "me") (was bogus (sym "me")) - parser `halt` modes distinguish: "all"/"bubbling"/"default" halt execution (raise hs-return), "the-event"/"the event's" only stop propagation/default. "'s" now matched as op token, not keyword. - parser `get` cmd: dispatch + cmd-kw list + parse-get-cmd (parses expr with optional `as TYPE`). Required for `get result as JSON` in fetch chains. - compiler empty-target for (local X): emit (set! X (hs-empty-like X)) so arrays/sets/maps clear the variable, not call DOM empty on the value. - runtime hs-empty-like: container-of-same-type empty value. - runtime hs-empty-target!: drop dead FORM branch that was short-circuiting to innerHTML=""; the querySelectorAll-over-inputs branch now runs. - runtime hs-halt!: take ev param (was free `event` lookup); raise hs-return to stop execution unless mode is "the-event". - runtime hs-reset!: type-aware — FORM → reset, INPUT/TEXTAREA → value/checked from defaults, SELECT → defaultSelected option. - runtime hs-open!/hs-close!: toggle `open` attribute on details elements (not just the prop) so dom-has-attr? assertions work. - runtime hs-coerce JSON: json-stringify dict/list (was str). - test-runner mock: host-get on List + "length"/"size" (was only Dict); dom-set-attr tracks defaultChecked / defaultSelected / defaultValue; mock_query_all supports comma-separated selector groups. - generator: emit boolean attrs (checked/selected/etc) even with null value; drop overcautious "skip HS with bare quotes or embedded HTML" guard so morph tests (source contains embedded <div>) emit properly. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -23,14 +23,48 @@
|
||||
((th (first target)))
|
||||
(cond
|
||||
((= th dot-sym)
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(hs-to-sx (nth target 1))
|
||||
(nth target 2)
|
||||
value))
|
||||
(let
|
||||
((base-ast (nth target 1)) (prop (nth target 2)))
|
||||
(cond
|
||||
((and (list? base-ast) (= (first base-ast) (quote query)) (let ((s (nth base-ast 1))) (and (string? s) (> (len s) 0) (= (substring s 0 1) "."))))
|
||||
(list
|
||||
(quote for-each)
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote __hs-el))
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(quote __hs-el)
|
||||
prop
|
||||
value))
|
||||
(list (quote hs-query-all) (nth base-ast 1))))
|
||||
((and (list? base-ast) (= (first base-ast) dot-sym) (let ((inner (nth base-ast 1))) (and (list? inner) (= (first inner) (quote query)) (let ((s (nth inner 1))) (and (string? s) (> (len s) 0) (= (substring s 0 1) "."))))))
|
||||
(let
|
||||
((inner (nth base-ast 1))
|
||||
(mid-prop (nth base-ast 2)))
|
||||
(list
|
||||
(quote for-each)
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote __hs-el))
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(list
|
||||
(quote host-get)
|
||||
(quote __hs-el)
|
||||
mid-prop)
|
||||
prop
|
||||
value))
|
||||
(list (quote hs-query-all) (nth inner 1)))))
|
||||
(true
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(hs-to-sx base-ast)
|
||||
prop
|
||||
value)))))
|
||||
((= th (quote attr))
|
||||
(list
|
||||
(quote dom-set-attr)
|
||||
(quote hs-set-attr!)
|
||||
(hs-to-sx (nth target 2))
|
||||
(nth target 1)
|
||||
value))
|
||||
@@ -84,7 +118,7 @@
|
||||
(list? prop-ast)
|
||||
(= (first prop-ast) (quote attr)))
|
||||
(list
|
||||
(quote dom-set-attr)
|
||||
(quote hs-set-attr!)
|
||||
(hs-to-sx obj-ast)
|
||||
(nth prop-ast 1)
|
||||
value)
|
||||
@@ -323,56 +357,120 @@
|
||||
(cond
|
||||
((and (list? expr) (= (first expr) (quote attr)))
|
||||
(let
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me))))
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
|
||||
(attr-name (nth expr 1)))
|
||||
(list
|
||||
(quote dom-set-attr)
|
||||
el
|
||||
(nth expr 1)
|
||||
(quote let)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote dom-get-attr) el (nth expr 1)))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote dom-get-attr) el attr-name))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote dom-set-attr) el attr-name (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) dot-sym))
|
||||
(let
|
||||
((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
|
||||
(list
|
||||
(quote host-set!)
|
||||
obj
|
||||
prop
|
||||
(quote let)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote host-get) obj prop))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) obj prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote host-set!) obj prop (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) (quote style)))
|
||||
(let
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
|
||||
(prop (nth expr 1)))
|
||||
(list
|
||||
(quote dom-set-style)
|
||||
el
|
||||
prop
|
||||
(quote let)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote dom-get-style) el prop))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote dom-get-style) el prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote dom-set-style) el prop (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) (quote dom-ref)))
|
||||
(let
|
||||
((el (hs-to-sx (nth expr 2))) (name (nth expr 1)))
|
||||
(list
|
||||
(quote hs-dom-set!)
|
||||
el
|
||||
name
|
||||
(list (quote +) (list (quote hs-dom-get) el name) amount))))
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote hs-dom-get) el name))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote hs-dom-set!) el name (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) (quote array-index)) (list? (nth expr 1)) (= (first (nth expr 1)) (quote ref)))
|
||||
(let
|
||||
((var-sym (make-symbol (nth (nth expr 1) 1)))
|
||||
(idx (hs-to-sx (nth expr 2))))
|
||||
(list
|
||||
(quote let)
|
||||
(list (list (quote __hs-idx) idx))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote nth) var-sym (quote __hs-idx)))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list
|
||||
(quote set!)
|
||||
var-sym
|
||||
(list
|
||||
(quote hs-list-set)
|
||||
var-sym
|
||||
(quote __hs-idx)
|
||||
(quote __hs-new)))
|
||||
(list (quote set!) (quote it) (quote __hs-new)))))))
|
||||
(true
|
||||
(let
|
||||
((t (hs-to-sx expr)))
|
||||
(list (quote set!) t (list (quote +) t amount)))))))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list (quote +) (list (quote hs-to-number) t) amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote set!) t (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new)))))))))
|
||||
(define
|
||||
emit-dec
|
||||
(fn
|
||||
@@ -380,56 +478,120 @@
|
||||
(cond
|
||||
((and (list? expr) (= (first expr) (quote attr)))
|
||||
(let
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me))))
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
|
||||
(attr-name (nth expr 1)))
|
||||
(list
|
||||
(quote dom-set-attr)
|
||||
el
|
||||
(nth expr 1)
|
||||
(quote let)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote dom-get-attr) el (nth expr 1)))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote dom-get-attr) el attr-name))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote dom-set-attr) el attr-name (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) dot-sym))
|
||||
(let
|
||||
((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
|
||||
(list
|
||||
(quote host-set!)
|
||||
obj
|
||||
prop
|
||||
(quote let)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote host-get) obj prop))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) obj prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote host-set!) obj prop (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) (quote style)))
|
||||
(let
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
|
||||
(prop (nth expr 1)))
|
||||
(list
|
||||
(quote dom-set-style)
|
||||
el
|
||||
prop
|
||||
(quote let)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote dom-get-style) el prop))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote dom-get-style) el prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote dom-set-style) el prop (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) (quote dom-ref)))
|
||||
(let
|
||||
((el (hs-to-sx (nth expr 2))) (name (nth expr 1)))
|
||||
(list
|
||||
(quote hs-dom-set!)
|
||||
el
|
||||
name
|
||||
(list (quote -) (list (quote hs-dom-get) el name) amount))))
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote hs-dom-get) el name))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote hs-dom-set!) el name (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) (quote array-index)) (list? (nth expr 1)) (= (first (nth expr 1)) (quote ref)))
|
||||
(let
|
||||
((var-sym (make-symbol (nth (nth expr 1) 1)))
|
||||
(idx (hs-to-sx (nth expr 2))))
|
||||
(list
|
||||
(quote let)
|
||||
(list (list (quote __hs-idx) idx))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote nth) var-sym (quote __hs-idx)))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list
|
||||
(quote set!)
|
||||
var-sym
|
||||
(list
|
||||
(quote hs-list-set)
|
||||
var-sym
|
||||
(quote __hs-idx)
|
||||
(quote __hs-new)))
|
||||
(list (quote set!) (quote it) (quote __hs-new)))))))
|
||||
(true
|
||||
(let
|
||||
((t (hs-to-sx expr)))
|
||||
(list (quote set!) t (list (quote -) t amount)))))))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list (quote -) (list (quote hs-to-number) t) amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote set!) t (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new)))))))))
|
||||
(define
|
||||
emit-behavior
|
||||
(fn
|
||||
@@ -1009,7 +1171,15 @@
|
||||
(hs-to-sx tgt)
|
||||
(list (quote hs-remove-from!) val (hs-to-sx tgt)))))
|
||||
((= head (quote empty-target))
|
||||
(list (quote hs-empty-target!) (hs-to-sx (nth ast 1))))
|
||||
(let
|
||||
((tgt (nth ast 1)))
|
||||
(if
|
||||
(and (list? tgt) (= (first tgt) (quote local)))
|
||||
(list
|
||||
(quote set!)
|
||||
(make-symbol (nth tgt 1))
|
||||
(list (quote hs-empty-like) (make-symbol (nth tgt 1))))
|
||||
(list (quote hs-empty-target!) (hs-to-sx tgt)))))
|
||||
((= head (quote open-element))
|
||||
(list (quote hs-open!) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote close-element))
|
||||
@@ -1160,6 +1330,9 @@
|
||||
(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
|
||||
@@ -1486,7 +1659,8 @@
|
||||
(hs-to-sx (nth ast 1))
|
||||
(list (quote fn) (list) (hs-to-sx (nth (nth ast 2) 2)))
|
||||
(nth ast 3)))
|
||||
((= head (quote halt!)) (list (quote hs-halt!) (nth ast 1)))
|
||||
((= head (quote halt!))
|
||||
(list (quote hs-halt!) (quote event) (nth ast 1)))
|
||||
((= head (quote focus!))
|
||||
(list (quote dom-focus) (hs-to-sx (nth ast 1))))
|
||||
(true ast))))))))
|
||||
|
||||
@@ -1205,14 +1205,33 @@
|
||||
(adv!)
|
||||
(let
|
||||
((source (if (match-kw "from") (parse-expr) nil)))
|
||||
(if
|
||||
source
|
||||
(list (quote wait-for) event-name :from source)
|
||||
(list (quote wait-for) event-name)))))
|
||||
(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)))))))
|
||||
((= (tp-type) "number")
|
||||
(let
|
||||
((tok (adv!)))
|
||||
(list (quote wait) (parse-dur (get tok "value")))))
|
||||
(let
|
||||
((raw (get tok "value"))
|
||||
(suffix
|
||||
(if
|
||||
(and
|
||||
(= (tp-type) "ident")
|
||||
(or (= (tp-val) "ms") (= (tp-val) "s")))
|
||||
(get (adv!) "value")
|
||||
"")))
|
||||
(list (quote wait) (parse-dur (str raw suffix))))))
|
||||
(true (list (quote wait) 0)))))
|
||||
(define
|
||||
parse-detail-dict
|
||||
@@ -1337,7 +1356,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (cond ((and (= (tp-type) "ident") (= (tp-val) "element")) (do (adv!) (parse-atom))) ((= (tp-type) "id") (parse-atom)) ((= (tp-type) "class") (parse-atom)) ((= (tp-type) "selector") (parse-atom)) (true nil))))
|
||||
((tgt (cond ((and (= (tp-type) "ident") (= (tp-val) "element")) (do (adv!) (parse-atom))) ((and (= (tp-type) "keyword") (= (tp-val) "its")) (do (adv!) (list (quote ref) "it"))) ((= (tp-type) "id") (parse-atom)) ((= (tp-type) "class") (parse-atom)) ((= (tp-type) "selector") (parse-atom)) (true nil))))
|
||||
(define
|
||||
parse-one-transition
|
||||
(fn
|
||||
@@ -1473,18 +1492,7 @@
|
||||
(if (= (tp-type) "comma") (adv!) nil)
|
||||
(ca-collect (append acc (list arg)))))))
|
||||
(ca-collect (list))))
|
||||
(define
|
||||
parse-call-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((name (get (adv!) "value")))
|
||||
(if
|
||||
(= (tp-type) "paren-open")
|
||||
(let
|
||||
((args (parse-call-args)))
|
||||
(cons (quote call) (cons name args)))
|
||||
(list (quote call) name)))))
|
||||
(define parse-call-cmd (fn () (parse-expr)))
|
||||
(define parse-get-cmd (fn () (parse-expr)))
|
||||
(define
|
||||
parse-take-cmd
|
||||
@@ -1841,7 +1849,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((mode (cond ((match-kw "the") (do (match-kw "event") (match-kw "'s") "event")) ((or (match-kw "default") (and (= (tp-val) "default") (do (adv!) true))) "default") ((or (match-kw "bubbling") (and (= (tp-val) "bubbling") (do (adv!) true))) "bubbling") (true "event"))))
|
||||
((mode (cond ((match-kw "the") (do (match-kw "event") (when (and (= (tp-type) "op") (= (tp-val) "'s")) (adv!)) "the-event")) ((or (match-kw "default") (and (= (tp-val) "default") (do (adv!) true))) "default") ((or (match-kw "bubbling") (and (= (tp-val) "bubbling") (do (adv!) true))) "bubbling") (true "all"))))
|
||||
(list (quote halt!) mode))))
|
||||
(define
|
||||
parse-param-list
|
||||
@@ -1965,7 +1973,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((target (cond ((at-end?) (list (quote sym) "me")) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote sym) "me")) (true (parse-expr)))))
|
||||
((target (cond ((at-end?) (list (quote ref) "me")) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote ref) "me")) (true (parse-expr)))))
|
||||
(list (quote empty-target) target))))
|
||||
(define
|
||||
parse-swap-cmd
|
||||
|
||||
@@ -156,26 +156,77 @@
|
||||
(dom-set-attr target name ""))))))))
|
||||
|
||||
;; First element matching selector within a scope.
|
||||
(define
|
||||
hs-put!
|
||||
(fn
|
||||
(value pos target)
|
||||
(cond
|
||||
((= pos "into")
|
||||
(if (list? target) target (dom-set-inner-html target value)))
|
||||
((= pos "before")
|
||||
(dom-insert-adjacent-html target "beforebegin" value))
|
||||
((= pos "after") (dom-insert-adjacent-html target "afterend" value))
|
||||
((= pos "start")
|
||||
(if
|
||||
(list? target)
|
||||
(append! target value 0)
|
||||
(dom-insert-adjacent-html target "afterbegin" value)))
|
||||
((= pos "end")
|
||||
(if
|
||||
(list? target)
|
||||
(append! target value)
|
||||
(dom-insert-adjacent-html target "beforeend" value))))))
|
||||
(begin
|
||||
(define
|
||||
hs-element?
|
||||
(fn
|
||||
(v)
|
||||
(and v (or (host-get v "nodeType") (host-get v "__mock_type")))))
|
||||
(define
|
||||
hs-set-attr!
|
||||
(fn
|
||||
(el name val)
|
||||
(if (nil? val) (dom-remove-attr el name) (dom-set-attr el name val))))
|
||||
(define
|
||||
hs-put!
|
||||
(fn
|
||||
(value pos target)
|
||||
(cond
|
||||
((= pos "into")
|
||||
(cond
|
||||
((list? target) target)
|
||||
((hs-element? value)
|
||||
(do
|
||||
(dom-set-inner-html target "")
|
||||
(host-call target "appendChild" value)))
|
||||
(true
|
||||
(do
|
||||
(dom-set-inner-html target value)
|
||||
(hs-boot-subtree! target)))))
|
||||
((= pos "before")
|
||||
(if
|
||||
(hs-element? value)
|
||||
(let
|
||||
((parent (dom-parent target)))
|
||||
(when parent (host-call parent "insertBefore" value target)))
|
||||
(let
|
||||
((parent (dom-parent target)))
|
||||
(do
|
||||
(dom-insert-adjacent-html target "beforebegin" value)
|
||||
(when parent (hs-boot-subtree! parent))))))
|
||||
((= pos "after")
|
||||
(if
|
||||
(hs-element? value)
|
||||
(let
|
||||
((parent (dom-parent target))
|
||||
(next (host-get target "nextSibling")))
|
||||
(when
|
||||
parent
|
||||
(if
|
||||
next
|
||||
(host-call parent "insertBefore" value next)
|
||||
(host-call parent "appendChild" value))))
|
||||
(let
|
||||
((parent (dom-parent target)))
|
||||
(do
|
||||
(dom-insert-adjacent-html target "afterend" value)
|
||||
(when parent (hs-boot-subtree! parent))))))
|
||||
((= pos "start")
|
||||
(cond
|
||||
((list? target) (append! target value 0))
|
||||
((hs-element? value) (dom-prepend target value))
|
||||
(true
|
||||
(do
|
||||
(dom-insert-adjacent-html target "afterbegin" value)
|
||||
(hs-boot-subtree! target)))))
|
||||
((= pos "end")
|
||||
(cond
|
||||
((list? target) (append! target value))
|
||||
((hs-element? value) (dom-append target value))
|
||||
(true
|
||||
(do
|
||||
(dom-insert-adjacent-html target "beforeend" value)
|
||||
(hs-boot-subtree! target)))))))))
|
||||
|
||||
;; Last element matching selector.
|
||||
(define
|
||||
@@ -228,16 +279,22 @@
|
||||
(define
|
||||
hs-halt!
|
||||
(fn
|
||||
(mode)
|
||||
(when
|
||||
event
|
||||
(cond
|
||||
((= mode "default") (host-call event "preventDefault"))
|
||||
((= mode "bubbling") (host-call event "stopPropagation"))
|
||||
(true
|
||||
(do
|
||||
(host-call event "preventDefault")
|
||||
(host-call event "stopPropagation")))))))
|
||||
(ev mode)
|
||||
(do
|
||||
(when
|
||||
ev
|
||||
(cond
|
||||
((= mode "default") (host-call ev "preventDefault"))
|
||||
((= mode "bubbling") (host-call ev "stopPropagation"))
|
||||
((= mode "the-event")
|
||||
(do
|
||||
(host-call ev "preventDefault")
|
||||
(host-call ev "stopPropagation")))
|
||||
(true
|
||||
(do
|
||||
(host-call ev "preventDefault")
|
||||
(host-call ev "stopPropagation")))))
|
||||
(when (not (= mode "the-event")) (raise (list "hs-return" nil))))))
|
||||
|
||||
;; ── Type coercion ───────────────────────────────────────────────
|
||||
|
||||
@@ -249,7 +306,51 @@
|
||||
|
||||
;; Make a new object of a given type.
|
||||
;; (hs-make type-name) — creates empty object/collection
|
||||
(define hs-reset! (fn (target) (host-call target "reset" (list))))
|
||||
(define
|
||||
hs-reset!
|
||||
(fn
|
||||
(target)
|
||||
(cond
|
||||
((list? target) (for-each (fn (el) (hs-reset! el)) target))
|
||||
((nil? target) nil)
|
||||
(true
|
||||
(let
|
||||
((tag (dom-get-prop target "tagName")))
|
||||
(cond
|
||||
((= tag "FORM") (host-call target "reset" (list)))
|
||||
((or (= tag "INPUT") (= tag "TEXTAREA"))
|
||||
(let
|
||||
((input-type (dom-get-prop target "type")))
|
||||
(cond
|
||||
((or (= input-type "checkbox") (= input-type "radio"))
|
||||
(dom-set-prop
|
||||
target
|
||||
"checked"
|
||||
(dom-get-prop target "defaultChecked")))
|
||||
(true
|
||||
(dom-set-prop
|
||||
target
|
||||
"value"
|
||||
(dom-get-prop target "defaultValue"))))))
|
||||
((= tag "SELECT")
|
||||
(let
|
||||
((options (host-call target "querySelectorAll" "option"))
|
||||
(default-val nil))
|
||||
(do
|
||||
(for-each
|
||||
(fn
|
||||
(opt)
|
||||
(when
|
||||
(and
|
||||
(nil? default-val)
|
||||
(dom-get-prop opt "defaultSelected"))
|
||||
(set! default-val (dom-get-prop opt "value"))))
|
||||
options)
|
||||
(when
|
||||
(and (nil? default-val) (> (len options) 0))
|
||||
(set! default-val (dom-get-prop (first options) "value")))
|
||||
(when default-val (dom-set-prop target "value" default-val)))))
|
||||
(true nil)))))))
|
||||
|
||||
;; ── Behavior installation ───────────────────────────────────────
|
||||
|
||||
@@ -306,6 +407,20 @@
|
||||
hs-query-all
|
||||
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
|
||||
|
||||
(define
|
||||
hs-list-set
|
||||
(fn (lst idx val) (map-indexed (fn (i x) (if (= i idx) val x)) lst)))
|
||||
|
||||
(define
|
||||
hs-to-number
|
||||
(fn
|
||||
(v)
|
||||
(cond
|
||||
((number? v) v)
|
||||
((string? v) (or (parse-number v) 0))
|
||||
((nil? v) 0)
|
||||
(true (or (parse-number (str v)) 0)))))
|
||||
|
||||
(define
|
||||
hs-query-first
|
||||
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
||||
@@ -387,6 +502,10 @@
|
||||
(if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
|
||||
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define
|
||||
hs-for-each
|
||||
(fn
|
||||
@@ -419,17 +538,14 @@
|
||||
(define
|
||||
hs-append!
|
||||
(fn (value target) (dom-insert-adjacent-html target "beforeend" value))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
(define
|
||||
hs-fetch
|
||||
(fn
|
||||
(url format)
|
||||
(perform (list "io-fetch" url (if format format "text")))))
|
||||
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
(define
|
||||
hs-coerce
|
||||
(fn
|
||||
@@ -520,8 +636,7 @@
|
||||
(map (fn (k) (list k (get value k))) (keys value))
|
||||
value))
|
||||
(true value))))
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
;; Method dispatch — obj.method(args)
|
||||
(define
|
||||
hs-add
|
||||
(fn
|
||||
@@ -531,7 +646,9 @@
|
||||
((list? b) (cons a b))
|
||||
((or (string? a) (string? b)) (str a b))
|
||||
(true (+ a b)))))
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
(define
|
||||
hs-make
|
||||
(fn
|
||||
@@ -542,15 +659,13 @@
|
||||
((= type-name "Set") (list))
|
||||
((= type-name "Map") (dict))
|
||||
(true (dict)))))
|
||||
;; Method dispatch — obj.method(args)
|
||||
;; Property-based is — check obj.key truthiness
|
||||
(define hs-install (fn (behavior-fn) (behavior-fn me)))
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
;; Array slicing (inclusive both ends)
|
||||
(define
|
||||
hs-measure
|
||||
(fn (target) (perform (list (quote io-measure) target))))
|
||||
;; Property-based is — check obj.key truthiness
|
||||
;; Collection: sorted by
|
||||
(define
|
||||
hs-transition
|
||||
(fn
|
||||
@@ -563,7 +678,7 @@
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop value)
|
||||
(when duration (hs-settle target))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
;; Collection: sorted by descending
|
||||
(define
|
||||
hs-transition-from
|
||||
(fn
|
||||
@@ -577,7 +692,7 @@
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop (str to-val))
|
||||
(when duration (hs-settle target))))
|
||||
;; Collection: sorted by
|
||||
;; Collection: split by
|
||||
(define
|
||||
hs-type-check
|
||||
(fn
|
||||
@@ -597,17 +712,17 @@
|
||||
(= (host-typeof value) "element")
|
||||
(= (host-typeof value) "text")))
|
||||
(true (= (host-typeof value) (downcase type-name)))))))
|
||||
;; Collection: sorted by descending
|
||||
;; Collection: joined by
|
||||
(define
|
||||
hs-type-check-strict
|
||||
(fn
|
||||
(value type-name)
|
||||
(if (nil? value) false (hs-type-check value type-name))))
|
||||
;; Collection: split by
|
||||
|
||||
(define
|
||||
hs-strict-eq
|
||||
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
|
||||
;; Collection: joined by
|
||||
|
||||
(define
|
||||
hs-eq-ignore-case
|
||||
(fn (a b) (= (downcase (str a)) (downcase (str b)))))
|
||||
@@ -738,6 +853,17 @@
|
||||
((dict? v) (= (len (keys v)) 0))
|
||||
(true false))))
|
||||
|
||||
(define
|
||||
hs-empty-like
|
||||
(fn
|
||||
(v)
|
||||
(cond
|
||||
((list? v) (list))
|
||||
((dict? v) (dict))
|
||||
((string? v) "")
|
||||
((nil? v) nil)
|
||||
(true v))))
|
||||
|
||||
(define
|
||||
hs-empty-target!
|
||||
(fn
|
||||
@@ -756,7 +882,6 @@
|
||||
(or (= input-type "checkbox") (= input-type "radio"))
|
||||
(dom-set-prop target "checked" false)
|
||||
(dom-set-prop target "value" ""))))
|
||||
((= tag "FORM") (dom-set-inner-html target ""))
|
||||
((= tag "FORM")
|
||||
(let
|
||||
((children (host-call target "querySelectorAll" "input, textarea, select")))
|
||||
@@ -981,10 +1106,10 @@
|
||||
(el)
|
||||
(let
|
||||
((tag (dom-get-prop el "tagName")))
|
||||
(if
|
||||
(= tag "DIALOG")
|
||||
(host-call el "showModal")
|
||||
(dom-set-prop el "open" true)))))
|
||||
(cond
|
||||
((= tag "DIALOG") (host-call el "showModal"))
|
||||
(true
|
||||
(do (dom-set-attr el "open" "") (dom-set-prop el "open" true)))))))
|
||||
|
||||
(define
|
||||
hs-close!
|
||||
@@ -992,10 +1117,12 @@
|
||||
(el)
|
||||
(let
|
||||
((tag (dom-get-prop el "tagName")))
|
||||
(if
|
||||
(= tag "DIALOG")
|
||||
(host-call el "close")
|
||||
(dom-set-prop el "open" false)))))
|
||||
(cond
|
||||
((= tag "DIALOG") (host-call el "close"))
|
||||
(true
|
||||
(do
|
||||
(host-call el "removeAttribute" "open")
|
||||
(dom-set-prop el "open" false)))))))
|
||||
|
||||
(define
|
||||
hs-hide!
|
||||
|
||||
@@ -183,7 +183,8 @@
|
||||
"focus"
|
||||
"blur"
|
||||
"dom"
|
||||
"morph"))
|
||||
"morph"
|
||||
"using"))
|
||||
|
||||
(define hs-keyword? (fn (word) (some (fn (k) (= k word)) hs-keywords)))
|
||||
|
||||
|
||||
Reference in New Issue
Block a user