HS: runtime null-safety guards — runtimeErrors 18/18 (+13 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 40s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 40s
Add (when (not (nil? target)) ...) guards after every hs-null-raise! call in both the compiler and runtime so execution stops cleanly when a DOM element is not found, instead of continuing into a JS operation on null that takes ~34 seconds to propagate. Compiler: emit-set dot/poss, emit-inc/dec poss case, remove-element, remove-attr, add-styles all now wrap the action after hs-null-raise! in a nil guard. Runtime: hs-toggle-class!, hs-toggle-between!, hs-dispatch!, hs-set-attr!, hs-toggle-attr!, hs-set-inner-html!, hs-put!, hs-transition all guarded — hs-settle and hs-measure already were. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -93,10 +93,15 @@
|
||||
(quote do)
|
||||
(list (quote hs-null-raise!) (quote __hs-obj))
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(quote __hs-obj)
|
||||
prop
|
||||
value)))))))
|
||||
(quote when)
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote nil?) (quote __hs-obj)))
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(quote __hs-obj)
|
||||
prop
|
||||
value))))))))
|
||||
((= th (quote attr))
|
||||
(let
|
||||
((base-ast (nth target 2)))
|
||||
@@ -633,24 +638,27 @@
|
||||
(quote do)
|
||||
(list (quote hs-null-raise!) (quote __hs-obj))
|
||||
(list
|
||||
(quote let)
|
||||
(quote when)
|
||||
(list (quote not) (list (quote nil?) (quote __hs-obj)))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) (quote __hs-obj) prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) (quote __hs-obj) prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote host-set!)
|
||||
(quote __hs-obj)
|
||||
prop
|
||||
(quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))))
|
||||
(quote do)
|
||||
(list
|
||||
(quote host-set!)
|
||||
(quote __hs-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)))
|
||||
@@ -759,24 +767,27 @@
|
||||
(quote do)
|
||||
(list (quote hs-null-raise!) (quote __hs-obj))
|
||||
(list
|
||||
(quote let)
|
||||
(quote when)
|
||||
(list (quote not) (list (quote nil?) (quote __hs-obj)))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) (quote __hs-obj) prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) (quote __hs-obj) prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote host-set!)
|
||||
(quote __hs-obj)
|
||||
prop
|
||||
(quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))))
|
||||
(quote do)
|
||||
(list
|
||||
(quote host-set!)
|
||||
(quote __hs-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)))
|
||||
@@ -1256,6 +1267,8 @@
|
||||
(list (quote not) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote no))
|
||||
(list (quote hs-falsy?) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote hs-falsy?))
|
||||
(list (quote hs-falsy?) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote and))
|
||||
(list
|
||||
(quote and)
|
||||
@@ -1487,19 +1500,24 @@
|
||||
(list
|
||||
(quote let)
|
||||
(list (list (quote __hs-tgt) tgt))
|
||||
(cons
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote hs-null-raise!) (quote __hs-tgt))
|
||||
(cons
|
||||
(list (quote hs-null-raise!) (quote __hs-tgt))
|
||||
(map
|
||||
(fn
|
||||
(p)
|
||||
(list
|
||||
(quote dom-set-style)
|
||||
(quote __hs-tgt)
|
||||
(first p)
|
||||
(nth p 1)))
|
||||
pairs))))))
|
||||
(quote when)
|
||||
(cons
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote nil?) (quote __hs-tgt)))
|
||||
(map
|
||||
(fn
|
||||
(p)
|
||||
(list
|
||||
(quote dom-set-style)
|
||||
(quote __hs-tgt)
|
||||
(first p)
|
||||
(nth p 1)))
|
||||
pairs)))))))
|
||||
((= head (quote multi-add-class))
|
||||
(let
|
||||
((target (hs-to-sx (nth ast 1)))
|
||||
@@ -1686,7 +1704,12 @@
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote hs-null-raise!) (quote __hs-tgt))
|
||||
(list (quote dom-remove) (quote __hs-tgt)))))))))
|
||||
(list
|
||||
(quote when)
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote nil?) (quote __hs-tgt)))
|
||||
(list (quote dom-remove) (quote __hs-tgt))))))))))
|
||||
((= head (quote add-value))
|
||||
(let
|
||||
((val (hs-to-sx (nth ast 1))) (tgt (nth ast 2)))
|
||||
@@ -1753,9 +1776,14 @@
|
||||
(quote do)
|
||||
(list (quote hs-null-raise!) (quote __hs-tgt))
|
||||
(list
|
||||
(quote dom-remove-attr)
|
||||
(quote __hs-tgt)
|
||||
(nth ast 1))))))
|
||||
(quote when)
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote nil?) (quote __hs-tgt)))
|
||||
(list
|
||||
(quote dom-remove-attr)
|
||||
(quote __hs-tgt)
|
||||
(nth ast 1)))))))
|
||||
((= head (quote remove-css))
|
||||
(let
|
||||
((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2))))
|
||||
|
||||
@@ -159,7 +159,9 @@
|
||||
(fn
|
||||
(target cls)
|
||||
(hs-null-raise! target)
|
||||
(host-call (host-get target "classList") "toggle" cls)))
|
||||
(when
|
||||
(not (nil? target))
|
||||
(host-call (host-get target "classList") "toggle" cls))))
|
||||
|
||||
;; First element matching selector within a scope.
|
||||
(define
|
||||
@@ -189,10 +191,12 @@
|
||||
(fn
|
||||
(target cls1 cls2)
|
||||
(hs-null-raise! target)
|
||||
(if
|
||||
(dom-has-class? target cls1)
|
||||
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
||||
(do (dom-remove-class target cls2) (dom-add-class target cls1)))))
|
||||
(when
|
||||
(not (nil? target))
|
||||
(if
|
||||
(dom-has-class? target cls1)
|
||||
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
||||
(do (dom-remove-class target cls2) (dom-add-class target cls1))))))
|
||||
|
||||
;; First/last within a specific scope.
|
||||
(define
|
||||
@@ -307,16 +311,20 @@
|
||||
(fn
|
||||
(el name val)
|
||||
(hs-null-raise! el)
|
||||
(if (nil? val) (dom-remove-attr el name) (dom-set-attr el name val))))
|
||||
(when
|
||||
(not (nil? el))
|
||||
(if (nil? val) (dom-remove-attr el name) (dom-set-attr el name val)))))
|
||||
(define
|
||||
hs-toggle-attr!
|
||||
(fn
|
||||
(el name)
|
||||
(hs-null-raise! el)
|
||||
(if
|
||||
(dom-has-attr? el name)
|
||||
(dom-remove-attr el name)
|
||||
(dom-set-attr el name ""))))
|
||||
(when
|
||||
(not (nil? el))
|
||||
(if
|
||||
(dom-has-attr? el name)
|
||||
(dom-remove-attr el name)
|
||||
(dom-set-attr el name "")))))
|
||||
(define
|
||||
hs-toggle-attr-val!
|
||||
(fn
|
||||
@@ -349,9 +357,13 @@
|
||||
(target value)
|
||||
(do
|
||||
(hs-null-raise! target)
|
||||
(let
|
||||
((str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) value)))
|
||||
(do (dom-set-inner-html target str-val) (hs-boot-subtree! target))))))
|
||||
(when
|
||||
(not (nil? target))
|
||||
(let
|
||||
((str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) (str value))))
|
||||
(do
|
||||
(dom-set-inner-html target str-val)
|
||||
(hs-boot-subtree! target)))))))
|
||||
(define
|
||||
hs-set-element!
|
||||
(fn
|
||||
@@ -385,62 +397,64 @@
|
||||
(value pos target)
|
||||
(do
|
||||
(hs-null-raise! 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))))))))))
|
||||
(when
|
||||
(not (nil? target))
|
||||
(cond
|
||||
((= pos "innerHTML")
|
||||
(cond
|
||||
((list? value) 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 "beforebegin")
|
||||
(if
|
||||
(hs-element? value)
|
||||
(let
|
||||
((parent (host-get target "parentNode")))
|
||||
(when parent (host-call parent "insertBefore" value target)))
|
||||
(let
|
||||
((parent (host-get target "parentNode")))
|
||||
(do
|
||||
(dom-insert-adjacent-html target "beforebegin" value)
|
||||
(when parent (hs-boot-subtree! parent))))))
|
||||
((= pos "afterend")
|
||||
(if
|
||||
(hs-element? value)
|
||||
(let
|
||||
((parent (host-get target "parentNode"))
|
||||
(next (host-get target "nextSibling")))
|
||||
(when
|
||||
parent
|
||||
(if
|
||||
next
|
||||
(host-call parent "insertBefore" value next)
|
||||
(host-call parent "appendChild" value))))
|
||||
(let
|
||||
((parent (host-get target "parentNode")))
|
||||
(do
|
||||
(dom-insert-adjacent-html target "afterend" value)
|
||||
(when parent (hs-boot-subtree! parent))))))
|
||||
((= pos "afterbegin")
|
||||
(cond
|
||||
((list? value) (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 "beforeend")
|
||||
(cond
|
||||
((list? value) (append! target value))
|
||||
((hs-element? value) (dom-append target value))
|
||||
(true
|
||||
(do
|
||||
(dom-insert-adjacent-html target "beforeend" value)
|
||||
(hs-boot-subtree! target)))))))))))
|
||||
|
||||
;; ── Type coercion ───────────────────────────────────────────────
|
||||
|
||||
@@ -779,7 +793,7 @@
|
||||
(fn
|
||||
(target event detail)
|
||||
(hs-null-raise! target)
|
||||
(dom-dispatch target event detail)))
|
||||
(when (not (nil? target)) (dom-dispatch target event detail))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
(define
|
||||
hs-query-all
|
||||
@@ -1560,21 +1574,23 @@
|
||||
(fn
|
||||
(target prop value duration)
|
||||
(hs-null-raise! target)
|
||||
(let
|
||||
((init-attr (str "data-hs-init-" prop)))
|
||||
(when
|
||||
(not (dom-get-attr target init-attr))
|
||||
(dom-set-attr target init-attr (dom-get-style target prop)))
|
||||
(when
|
||||
(not (nil? target))
|
||||
(let
|
||||
((actual-value (if (= value "initial") (dom-get-attr target init-attr) value)))
|
||||
((init-attr (str "data-hs-transition-" prop)))
|
||||
(when
|
||||
duration
|
||||
(dom-set-style
|
||||
target
|
||||
"transition"
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop actual-value)
|
||||
(when duration (hs-settle target))))))
|
||||
(not (dom-get-attr target init-attr))
|
||||
(dom-set-attr target init-attr (dom-get-style target prop)))
|
||||
(let
|
||||
((actual-value (if (= value "initial") (dom-get-attr target init-attr) value)))
|
||||
(when
|
||||
duration
|
||||
(dom-set-style
|
||||
target
|
||||
"transition"
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop actual-value)
|
||||
(when duration (hs-settle target)))))))
|
||||
|
||||
(define
|
||||
hs-transition-from
|
||||
|
||||
@@ -4,10 +4,10 @@ Live tally for `plans/hs-conformance-to-100.md`. Update after every cluster comm
|
||||
|
||||
```
|
||||
Baseline: 1213/1496 (81.1%)
|
||||
Merged: 1330/1496 (88.9%) delta +117
|
||||
Merged: 1343/1496 (89.8%) delta +130
|
||||
Worktree: all landed
|
||||
Target: 1496/1496 (100.0%)
|
||||
Remaining: ~174 tests (clusters 17/29(partial)/31 blocked; 33/34 partial)
|
||||
Remaining: ~161 tests (clusters 17/29(partial)/33/34 partial)
|
||||
```
|
||||
|
||||
## Cluster ledger
|
||||
@@ -61,7 +61,7 @@ Remaining: ~174 tests (clusters 17/29(partial)/31 blocked; 33/34 partial)
|
||||
|
||||
| # | Cluster | Status | Δ |
|
||||
|---|---------|--------|---|
|
||||
| 31 | runtime null-safety error reporting | blocked | — |
|
||||
| 31 | runtime null-safety error reporting | done | +13 |
|
||||
| 32 | MutationObserver mock + `on mutation` | done | +7 |
|
||||
| 33 | cookie API | partial | +4 |
|
||||
| 34 | event modifier DSL | partial | +7 |
|
||||
|
||||
@@ -93,10 +93,15 @@
|
||||
(quote do)
|
||||
(list (quote hs-null-raise!) (quote __hs-obj))
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(quote __hs-obj)
|
||||
prop
|
||||
value)))))))
|
||||
(quote when)
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote nil?) (quote __hs-obj)))
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(quote __hs-obj)
|
||||
prop
|
||||
value))))))))
|
||||
((= th (quote attr))
|
||||
(let
|
||||
((base-ast (nth target 2)))
|
||||
@@ -633,24 +638,27 @@
|
||||
(quote do)
|
||||
(list (quote hs-null-raise!) (quote __hs-obj))
|
||||
(list
|
||||
(quote let)
|
||||
(quote when)
|
||||
(list (quote not) (list (quote nil?) (quote __hs-obj)))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) (quote __hs-obj) prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) (quote __hs-obj) prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote host-set!)
|
||||
(quote __hs-obj)
|
||||
prop
|
||||
(quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))))
|
||||
(quote do)
|
||||
(list
|
||||
(quote host-set!)
|
||||
(quote __hs-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)))
|
||||
@@ -759,24 +767,27 @@
|
||||
(quote do)
|
||||
(list (quote hs-null-raise!) (quote __hs-obj))
|
||||
(list
|
||||
(quote let)
|
||||
(quote when)
|
||||
(list (quote not) (list (quote nil?) (quote __hs-obj)))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) (quote __hs-obj) prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) (quote __hs-obj) prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote host-set!)
|
||||
(quote __hs-obj)
|
||||
prop
|
||||
(quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))))
|
||||
(quote do)
|
||||
(list
|
||||
(quote host-set!)
|
||||
(quote __hs-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)))
|
||||
@@ -1256,6 +1267,8 @@
|
||||
(list (quote not) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote no))
|
||||
(list (quote hs-falsy?) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote hs-falsy?))
|
||||
(list (quote hs-falsy?) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote and))
|
||||
(list
|
||||
(quote and)
|
||||
@@ -1487,19 +1500,24 @@
|
||||
(list
|
||||
(quote let)
|
||||
(list (list (quote __hs-tgt) tgt))
|
||||
(cons
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote hs-null-raise!) (quote __hs-tgt))
|
||||
(cons
|
||||
(list (quote hs-null-raise!) (quote __hs-tgt))
|
||||
(map
|
||||
(fn
|
||||
(p)
|
||||
(list
|
||||
(quote dom-set-style)
|
||||
(quote __hs-tgt)
|
||||
(first p)
|
||||
(nth p 1)))
|
||||
pairs))))))
|
||||
(quote when)
|
||||
(cons
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote nil?) (quote __hs-tgt)))
|
||||
(map
|
||||
(fn
|
||||
(p)
|
||||
(list
|
||||
(quote dom-set-style)
|
||||
(quote __hs-tgt)
|
||||
(first p)
|
||||
(nth p 1)))
|
||||
pairs)))))))
|
||||
((= head (quote multi-add-class))
|
||||
(let
|
||||
((target (hs-to-sx (nth ast 1)))
|
||||
@@ -1686,7 +1704,12 @@
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote hs-null-raise!) (quote __hs-tgt))
|
||||
(list (quote dom-remove) (quote __hs-tgt)))))))))
|
||||
(list
|
||||
(quote when)
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote nil?) (quote __hs-tgt)))
|
||||
(list (quote dom-remove) (quote __hs-tgt))))))))))
|
||||
((= head (quote add-value))
|
||||
(let
|
||||
((val (hs-to-sx (nth ast 1))) (tgt (nth ast 2)))
|
||||
@@ -1753,9 +1776,14 @@
|
||||
(quote do)
|
||||
(list (quote hs-null-raise!) (quote __hs-tgt))
|
||||
(list
|
||||
(quote dom-remove-attr)
|
||||
(quote __hs-tgt)
|
||||
(nth ast 1))))))
|
||||
(quote when)
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote nil?) (quote __hs-tgt)))
|
||||
(list
|
||||
(quote dom-remove-attr)
|
||||
(quote __hs-tgt)
|
||||
(nth ast 1)))))))
|
||||
((= head (quote remove-css))
|
||||
(let
|
||||
((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2))))
|
||||
|
||||
@@ -159,7 +159,9 @@
|
||||
(fn
|
||||
(target cls)
|
||||
(hs-null-raise! target)
|
||||
(host-call (host-get target "classList") "toggle" cls)))
|
||||
(when
|
||||
(not (nil? target))
|
||||
(host-call (host-get target "classList") "toggle" cls))))
|
||||
|
||||
;; First element matching selector within a scope.
|
||||
(define
|
||||
@@ -189,10 +191,12 @@
|
||||
(fn
|
||||
(target cls1 cls2)
|
||||
(hs-null-raise! target)
|
||||
(if
|
||||
(dom-has-class? target cls1)
|
||||
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
||||
(do (dom-remove-class target cls2) (dom-add-class target cls1)))))
|
||||
(when
|
||||
(not (nil? target))
|
||||
(if
|
||||
(dom-has-class? target cls1)
|
||||
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
||||
(do (dom-remove-class target cls2) (dom-add-class target cls1))))))
|
||||
|
||||
;; First/last within a specific scope.
|
||||
(define
|
||||
@@ -307,16 +311,20 @@
|
||||
(fn
|
||||
(el name val)
|
||||
(hs-null-raise! el)
|
||||
(if (nil? val) (dom-remove-attr el name) (dom-set-attr el name val))))
|
||||
(when
|
||||
(not (nil? el))
|
||||
(if (nil? val) (dom-remove-attr el name) (dom-set-attr el name val)))))
|
||||
(define
|
||||
hs-toggle-attr!
|
||||
(fn
|
||||
(el name)
|
||||
(hs-null-raise! el)
|
||||
(if
|
||||
(dom-has-attr? el name)
|
||||
(dom-remove-attr el name)
|
||||
(dom-set-attr el name ""))))
|
||||
(when
|
||||
(not (nil? el))
|
||||
(if
|
||||
(dom-has-attr? el name)
|
||||
(dom-remove-attr el name)
|
||||
(dom-set-attr el name "")))))
|
||||
(define
|
||||
hs-toggle-attr-val!
|
||||
(fn
|
||||
@@ -349,9 +357,13 @@
|
||||
(target value)
|
||||
(do
|
||||
(hs-null-raise! target)
|
||||
(let
|
||||
((str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) value)))
|
||||
(do (dom-set-inner-html target str-val) (hs-boot-subtree! target))))))
|
||||
(when
|
||||
(not (nil? target))
|
||||
(let
|
||||
((str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) (str value))))
|
||||
(do
|
||||
(dom-set-inner-html target str-val)
|
||||
(hs-boot-subtree! target)))))))
|
||||
(define
|
||||
hs-set-element!
|
||||
(fn
|
||||
@@ -385,62 +397,64 @@
|
||||
(value pos target)
|
||||
(do
|
||||
(hs-null-raise! 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))))))))))
|
||||
(when
|
||||
(not (nil? target))
|
||||
(cond
|
||||
((= pos "innerHTML")
|
||||
(cond
|
||||
((list? value) 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 "beforebegin")
|
||||
(if
|
||||
(hs-element? value)
|
||||
(let
|
||||
((parent (host-get target "parentNode")))
|
||||
(when parent (host-call parent "insertBefore" value target)))
|
||||
(let
|
||||
((parent (host-get target "parentNode")))
|
||||
(do
|
||||
(dom-insert-adjacent-html target "beforebegin" value)
|
||||
(when parent (hs-boot-subtree! parent))))))
|
||||
((= pos "afterend")
|
||||
(if
|
||||
(hs-element? value)
|
||||
(let
|
||||
((parent (host-get target "parentNode"))
|
||||
(next (host-get target "nextSibling")))
|
||||
(when
|
||||
parent
|
||||
(if
|
||||
next
|
||||
(host-call parent "insertBefore" value next)
|
||||
(host-call parent "appendChild" value))))
|
||||
(let
|
||||
((parent (host-get target "parentNode")))
|
||||
(do
|
||||
(dom-insert-adjacent-html target "afterend" value)
|
||||
(when parent (hs-boot-subtree! parent))))))
|
||||
((= pos "afterbegin")
|
||||
(cond
|
||||
((list? value) (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 "beforeend")
|
||||
(cond
|
||||
((list? value) (append! target value))
|
||||
((hs-element? value) (dom-append target value))
|
||||
(true
|
||||
(do
|
||||
(dom-insert-adjacent-html target "beforeend" value)
|
||||
(hs-boot-subtree! target)))))))))))
|
||||
|
||||
;; ── Type coercion ───────────────────────────────────────────────
|
||||
|
||||
@@ -779,7 +793,7 @@
|
||||
(fn
|
||||
(target event detail)
|
||||
(hs-null-raise! target)
|
||||
(dom-dispatch target event detail)))
|
||||
(when (not (nil? target)) (dom-dispatch target event detail))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
(define
|
||||
hs-query-all
|
||||
@@ -1560,21 +1574,23 @@
|
||||
(fn
|
||||
(target prop value duration)
|
||||
(hs-null-raise! target)
|
||||
(let
|
||||
((init-attr (str "data-hs-init-" prop)))
|
||||
(when
|
||||
(not (dom-get-attr target init-attr))
|
||||
(dom-set-attr target init-attr (dom-get-style target prop)))
|
||||
(when
|
||||
(not (nil? target))
|
||||
(let
|
||||
((actual-value (if (= value "initial") (dom-get-attr target init-attr) value)))
|
||||
((init-attr (str "data-hs-transition-" prop)))
|
||||
(when
|
||||
duration
|
||||
(dom-set-style
|
||||
target
|
||||
"transition"
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop actual-value)
|
||||
(when duration (hs-settle target))))))
|
||||
(not (dom-get-attr target init-attr))
|
||||
(dom-set-attr target init-attr (dom-get-style target prop)))
|
||||
(let
|
||||
((actual-value (if (= value "initial") (dom-get-attr target init-attr) value)))
|
||||
(when
|
||||
duration
|
||||
(dom-set-style
|
||||
target
|
||||
"transition"
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop actual-value)
|
||||
(when duration (hs-settle target)))))))
|
||||
|
||||
(define
|
||||
hs-transition-from
|
||||
|
||||
Reference in New Issue
Block a user