HS: extend parser/runtime + new node test runner; ignore test-results/
- Parser: `--` line comments, `|` op, `result` → `the-result`, query-scoped `<sel> in <expr>`, `is a/an <type>` predicate, multi-`as` chaining with `|`, `match`/`precede` keyword aliases, `[attr]` add/toggle, between attr forms - Runtime: per-element listener registry + hs-deactivate!, attr toggle variants, set-inner-html boots subtree, hs-append polymorphic on string/list/element, default? / array-set! / query-all-in / list-set via take+drop, hs-script idempotence guard - Integration: skip reserved (me/it/event/you/yourself) when collecting vars - Tokenizer: emit `--` comments and `|` op - Test framework + conformance runner updates; new tests/hs-run-filtered.js (single-process Node runner using OCaml VM step-limit to bound infinite loops); generate-sx-conformance-dev.py improvements - mcp_tree.ml + run_tests.ml: harness extensions - .gitignore: top-level test-results/ (Playwright artifacts) Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -77,7 +77,11 @@
|
||||
((= th (quote ref))
|
||||
(list (quote set!) (make-symbol (nth target 1)) value))
|
||||
((= th (quote local))
|
||||
(list (quote define) (make-symbol (nth target 1)) value))
|
||||
(list
|
||||
(quote hs-scoped-set!)
|
||||
(quote me)
|
||||
(nth target 1)
|
||||
value))
|
||||
((= th (quote dom-ref))
|
||||
(list
|
||||
(quote hs-dom-set!)
|
||||
@@ -85,18 +89,18 @@
|
||||
(nth target 1)
|
||||
value))
|
||||
((= th (quote me))
|
||||
(list (quote dom-set-inner-html) (quote me) value))
|
||||
(list (quote hs-set-inner-html!) (quote me) value))
|
||||
((= th (quote it)) (list (quote set!) (quote it) value))
|
||||
((= th (quote query))
|
||||
(list (quote dom-set-inner-html) (hs-to-sx target) value))
|
||||
(list (quote hs-set-inner-html!) (hs-to-sx target) value))
|
||||
((= th (quote array-index))
|
||||
(list
|
||||
(quote host-set!)
|
||||
(quote hs-array-set!)
|
||||
(hs-to-sx (nth target 1))
|
||||
(hs-to-sx (nth target 2))
|
||||
value))
|
||||
((or (= th (quote next)) (= th (quote previous)) (= th (quote closest)))
|
||||
(list (quote dom-set-inner-html) (hs-to-sx target) value))
|
||||
(list (quote hs-set-inner-html!) (hs-to-sx target) value))
|
||||
((= th (quote of))
|
||||
(let
|
||||
((prop-ast (nth target 1)) (obj-ast (nth target 2)))
|
||||
@@ -162,10 +166,19 @@
|
||||
(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
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote event))
|
||||
wrapped-body)))
|
||||
(let
|
||||
((uses-the-result? (fn (expr) (cond ((= expr (quote the-result)) true) ((list? expr) (some (fn (x) (uses-the-result? x)) expr)) (true false)))))
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote event))
|
||||
(if
|
||||
(uses-the-result? wrapped-body)
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list (quote the-result) nil))
|
||||
wrapped-body)
|
||||
wrapped-body)))))
|
||||
(if
|
||||
every?
|
||||
(list
|
||||
@@ -443,9 +456,7 @@
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote nth) var-sym (quote __hs-idx)))
|
||||
(list (quote nth) var-sym (quote __hs-idx))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
@@ -463,10 +474,7 @@
|
||||
((t (hs-to-sx expr)))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list (quote +) (list (quote hs-to-number) t) amount)))
|
||||
(list (list (quote __hs-new) (list (quote +) t amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote set!) t (quote __hs-new))
|
||||
@@ -564,9 +572,7 @@
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote nth) var-sym (quote __hs-idx)))
|
||||
(list (quote nth) var-sym (quote __hs-idx))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
@@ -584,10 +590,7 @@
|
||||
((t (hs-to-sx expr)))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list (quote -) (list (quote hs-to-number) t) amount)))
|
||||
(list (list (quote __hs-new) (list (quote -) t amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote set!) t (quote __hs-new))
|
||||
@@ -754,35 +757,53 @@
|
||||
(hs-to-sx (nth ast 3))))
|
||||
((= head (quote pick-first))
|
||||
(list
|
||||
(quote hs-pick-first)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
(quote set!)
|
||||
(quote it)
|
||||
(list
|
||||
(quote hs-pick-first)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2)))))
|
||||
((= head (quote pick-last))
|
||||
(list
|
||||
(quote hs-pick-last)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
(quote set!)
|
||||
(quote it)
|
||||
(list
|
||||
(quote hs-pick-last)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2)))))
|
||||
((= head (quote pick-random))
|
||||
(list
|
||||
(quote hs-pick-random)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(if (nil? (nth ast 2)) nil (hs-to-sx (nth ast 2)))))
|
||||
(quote set!)
|
||||
(quote it)
|
||||
(list
|
||||
(quote hs-pick-random)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(if (nil? (nth ast 2)) nil (hs-to-sx (nth ast 2))))))
|
||||
((= head (quote pick-items))
|
||||
(list
|
||||
(quote hs-pick-items)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))
|
||||
(hs-to-sx (nth ast 3))))
|
||||
(quote set!)
|
||||
(quote it)
|
||||
(list
|
||||
(quote hs-pick-items)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))
|
||||
(hs-to-sx (nth ast 3)))))
|
||||
((= head (quote pick-match))
|
||||
(list
|
||||
(quote regex-match)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
(quote set!)
|
||||
(quote it)
|
||||
(list
|
||||
(quote regex-match)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2)))))
|
||||
((= head (quote pick-matches))
|
||||
(list
|
||||
(quote regex-find-all)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
(quote set!)
|
||||
(quote it)
|
||||
(list
|
||||
(quote regex-find-all)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2)))))
|
||||
((= head (quote prop-is))
|
||||
(list
|
||||
(quote hs-prop-is)
|
||||
@@ -870,6 +891,11 @@
|
||||
((= head (quote ref)) (make-symbol (nth ast 1)))
|
||||
((= head (quote query))
|
||||
(list (quote hs-query-first) (nth ast 1)))
|
||||
((= head (quote query-scoped))
|
||||
(list
|
||||
(quote hs-query-all-in)
|
||||
(nth ast 1)
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote attr))
|
||||
(list
|
||||
(quote dom-get-attr)
|
||||
@@ -890,7 +916,8 @@
|
||||
(quote dom-has-class?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(nth ast 2)))
|
||||
((= head (quote local)) (make-symbol (nth ast 1)))
|
||||
((= head (quote local))
|
||||
(list (quote hs-scoped-get) (quote me) (nth ast 1)))
|
||||
((= head (quote array))
|
||||
(cons (quote list) (map hs-to-sx (rest ast))))
|
||||
((= head (quote not))
|
||||
@@ -1163,6 +1190,14 @@
|
||||
(quote set!)
|
||||
(hs-to-sx tgt)
|
||||
(list (quote hs-add-to!) val (hs-to-sx tgt)))))
|
||||
((= head (quote add-attr))
|
||||
(let
|
||||
((tgt (nth ast 3)))
|
||||
(list
|
||||
(quote hs-set-attr!)
|
||||
(hs-to-sx tgt)
|
||||
(nth ast 1)
|
||||
(hs-to-sx (nth ast 2)))))
|
||||
((= head (quote remove-value))
|
||||
(let
|
||||
((val (hs-to-sx (nth ast 1))) (tgt (nth ast 2)))
|
||||
@@ -1296,6 +1331,20 @@
|
||||
(nth ast 1)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(hs-to-sx (nth ast 3))))
|
||||
((= head (quote toggle-attr-val))
|
||||
(list
|
||||
(quote hs-toggle-attr-val!)
|
||||
(hs-to-sx (nth ast 3))
|
||||
(nth ast 1)
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote toggle-attr-diff))
|
||||
(list
|
||||
(quote hs-toggle-attr-diff!)
|
||||
(hs-to-sx (nth ast 5))
|
||||
(nth ast 1)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(nth ast 3)
|
||||
(hs-to-sx (nth ast 4))))
|
||||
((= head (quote set!))
|
||||
(emit-set (nth ast 1) (hs-to-sx (nth ast 2))))
|
||||
((= head (quote put!))
|
||||
@@ -1358,14 +1407,49 @@
|
||||
nil))
|
||||
((= head (quote hide))
|
||||
(let
|
||||
((tgt (hs-to-sx (nth ast 1)))
|
||||
(strategy (if (> (len ast) 2) (nth ast 2) "display")))
|
||||
(list (quote hs-hide!) tgt strategy)))
|
||||
((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))))
|
||||
(strategy (if (> (len ast) 2) (nth ast 2) "display"))
|
||||
(when-cond (if (> (len ast) 3) (nth ast 3) nil)))
|
||||
(if
|
||||
(nil? when-cond)
|
||||
(list (quote hs-hide!) tgt strategy)
|
||||
(list
|
||||
(quote hs-hide-when!)
|
||||
tgt
|
||||
strategy
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote it))
|
||||
(hs-to-sx when-cond))))))
|
||||
((= head (quote show))
|
||||
(let
|
||||
((tgt (hs-to-sx (nth ast 1)))
|
||||
(strategy (if (> (len ast) 2) (nth ast 2) "display")))
|
||||
(list (quote hs-show!) tgt strategy)))
|
||||
((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))))
|
||||
(strategy (if (> (len ast) 2) (nth ast 2) "display"))
|
||||
(when-cond (if (> (len ast) 3) (nth ast 3) nil)))
|
||||
(if
|
||||
(nil? when-cond)
|
||||
(list (quote hs-show!) tgt strategy)
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-show-r)
|
||||
(list
|
||||
(quote hs-show-when!)
|
||||
tgt
|
||||
strategy
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote it))
|
||||
(hs-to-sx when-cond)))))
|
||||
(list
|
||||
(quote begin)
|
||||
(list
|
||||
(quote set!)
|
||||
(quote the-result)
|
||||
(quote __hs-show-r))
|
||||
(list (quote set!) (quote it) (quote __hs-show-r))
|
||||
(quote __hs-show-r))))))
|
||||
((= head (quote transition)) (emit-transition ast))
|
||||
((= head (quote transition-from))
|
||||
(let
|
||||
@@ -1424,6 +1508,14 @@
|
||||
(list (quote hs-settle) (quote me)))
|
||||
((= head (quote go))
|
||||
(list (quote hs-navigate!) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote __get-cmd))
|
||||
(let
|
||||
((val (hs-to-sx (nth ast 1))))
|
||||
(list
|
||||
(quote begin)
|
||||
(list (quote set!) (quote the-result) val)
|
||||
(list (quote set!) (quote it) val)
|
||||
val)))
|
||||
((= head (quote append!))
|
||||
(let
|
||||
((tgt (hs-to-sx (nth ast 2)))
|
||||
@@ -1648,11 +1740,13 @@
|
||||
(list (quote hs-reset!) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote default!))
|
||||
(let
|
||||
((t (hs-to-sx (nth ast 1))) (v (hs-to-sx (nth ast 2))))
|
||||
((tgt-ast (nth ast 1))
|
||||
(read (hs-to-sx (nth ast 1)))
|
||||
(v (hs-to-sx (nth ast 2))))
|
||||
(list
|
||||
(quote when)
|
||||
(list (quote nil?) t)
|
||||
(list (quote set!) t v))))
|
||||
(list (quote hs-default?) read)
|
||||
(emit-set tgt-ast v))))
|
||||
((= head (quote hs-is))
|
||||
(list
|
||||
(quote hs-is)
|
||||
|
||||
@@ -16,6 +16,14 @@
|
||||
(fn
|
||||
(sx)
|
||||
(define vars (list))
|
||||
(define
|
||||
reserved
|
||||
(list
|
||||
(quote me)
|
||||
(quote it)
|
||||
(quote event)
|
||||
(quote you)
|
||||
(quote yourself)))
|
||||
(define
|
||||
walk
|
||||
(fn
|
||||
@@ -30,7 +38,9 @@
|
||||
(let
|
||||
((name (nth node 1)))
|
||||
(when
|
||||
(not (some (fn (v) (= v name)) vars))
|
||||
(and
|
||||
(not (some (fn (v) (= v name)) vars))
|
||||
(not (some (fn (v) (= v name)) reserved)))
|
||||
(set! vars (cons name vars)))))
|
||||
(for-each walk node))))
|
||||
(walk sx)
|
||||
@@ -67,9 +77,10 @@
|
||||
(fn
|
||||
(el)
|
||||
(let
|
||||
((src (dom-get-attr el "_")))
|
||||
((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script")))
|
||||
(when
|
||||
(and src (not (dom-get-data el "hs-active")))
|
||||
(and src (not (= src prev)))
|
||||
(dom-set-data el "hs-script" src)
|
||||
(dom-set-data el "hs-active" true)
|
||||
(let ((handler (hs-handler src))) (handler el))))))
|
||||
|
||||
@@ -77,6 +88,21 @@
|
||||
;; Called once at page load. Finds all elements with _ attribute,
|
||||
;; compiles their hyperscript, and activates them.
|
||||
|
||||
(define
|
||||
hs-deactivate!
|
||||
(fn
|
||||
(el)
|
||||
(let
|
||||
((unlisteners (or (dom-get-data el "hs-unlisteners") (list))))
|
||||
(for-each (fn (u) (when u (u))) unlisteners)
|
||||
(dom-set-data el "hs-unlisteners" (list))
|
||||
(dom-set-data el "hs-active" false)
|
||||
(dom-set-data el "hs-script" nil))))
|
||||
|
||||
;; ── Boot subtree: for dynamic content ───────────────────────────
|
||||
;; Called after HTMX swaps or dynamic DOM insertion.
|
||||
;; Only activates elements within the given root.
|
||||
|
||||
(define
|
||||
hs-boot!
|
||||
(fn
|
||||
@@ -85,10 +111,6 @@
|
||||
((elements (dom-query-all (host-get (host-global "document") "body") "[_]")))
|
||||
(for-each (fn (el) (hs-activate! el)) elements))))
|
||||
|
||||
;; ── Boot subtree: for dynamic content ───────────────────────────
|
||||
;; Called after HTMX swaps or dynamic DOM insertion.
|
||||
;; Only activates elements within the given root.
|
||||
|
||||
(define
|
||||
hs-boot-subtree!
|
||||
(fn
|
||||
|
||||
@@ -95,6 +95,13 @@
|
||||
(do (adv!) (list kind (str "." val) (list (quote me)))))
|
||||
((= typ "id")
|
||||
(do (adv!) (list kind (str "#" val) (list (quote me)))))
|
||||
((= typ "attr")
|
||||
(do
|
||||
(adv!)
|
||||
(list
|
||||
(quote attr)
|
||||
val
|
||||
(list kind (str "[" val "]") (list (quote me))))))
|
||||
(true (list kind "*" (list (quote me))))))))
|
||||
(define
|
||||
parse-pos-kw
|
||||
@@ -146,8 +153,10 @@
|
||||
(do (adv!) (list (quote me))))
|
||||
((and (= typ "keyword") (= val "I"))
|
||||
(do (adv!) (list (quote me))))
|
||||
((and (= typ "keyword") (or (= val "it") (= val "result")))
|
||||
((and (= typ "keyword") (= val "it"))
|
||||
(do (adv!) (list (quote it))))
|
||||
((and (= typ "keyword") (= val "result"))
|
||||
(do (adv!) (quote the-result)))
|
||||
((and (= typ "keyword") (= val "event"))
|
||||
(do (adv!) (list (quote event))))
|
||||
((and (= typ "keyword") (= val "target"))
|
||||
@@ -174,7 +183,18 @@
|
||||
(do (adv!) (parse-pos-kw (quote last))))
|
||||
((= typ "id")
|
||||
(do (adv!) (list (quote query) (str "#" val))))
|
||||
((= typ "selector") (do (adv!) (list (quote query) val)))
|
||||
((= typ "selector")
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "in"))
|
||||
(do
|
||||
(adv!)
|
||||
(list
|
||||
(quote query-scoped)
|
||||
val
|
||||
(parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
||||
(list (quote query) val))))
|
||||
((= typ "attr")
|
||||
(do (adv!) (list (quote attr) val (list (quote me)))))
|
||||
((= typ "style")
|
||||
@@ -426,7 +446,7 @@
|
||||
(list (quote type-check) left type-name)))))))
|
||||
(true
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
((right (parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
||||
(if
|
||||
(match-kw "ignoring")
|
||||
(do
|
||||
@@ -530,6 +550,14 @@
|
||||
(quote and)
|
||||
(list (quote >=) left lo)
|
||||
(list (quote <=) left hi))))))
|
||||
((or (and (or (= (tp-val) "a") (= (tp-val) "an")) (do (adv!) true)))
|
||||
(let
|
||||
((type-name (tp-val)))
|
||||
(do
|
||||
(adv!)
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote type-check) left type-name)))))
|
||||
(true
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
@@ -546,6 +574,10 @@
|
||||
(quote and)
|
||||
(list (quote >=) left lo)
|
||||
(list (quote <=) left hi)))))
|
||||
((or (and (or (= (tp-val) "a") (= (tp-val) "an")) (do (adv!) true)))
|
||||
(let
|
||||
((type-name (tp-val)))
|
||||
(do (adv!) (list (quote type-check) left type-name))))
|
||||
(true
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
@@ -576,7 +608,7 @@
|
||||
(match-kw "case")
|
||||
(list (quote ends-with-ic?) left rhs))
|
||||
(list (quote ends-with?) left rhs)))))
|
||||
((and (= typ "keyword") (= val "matches"))
|
||||
((and (= typ "keyword") (or (= val "matches") (= val "match")))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
@@ -618,7 +650,22 @@
|
||||
(quote as)
|
||||
left
|
||||
(str type-name ":" param)))))
|
||||
(list (quote as) left type-name))))))
|
||||
(let
|
||||
loop
|
||||
((result (list (quote as) left type-name)))
|
||||
(if
|
||||
(and (= (tp-type) "op") (= (tp-val) "|"))
|
||||
(do
|
||||
(adv!)
|
||||
(when
|
||||
(or (= (tp-val) "a") (= (tp-val) "an"))
|
||||
(adv!))
|
||||
(let
|
||||
((next-type (tp-val)))
|
||||
(do
|
||||
(adv!)
|
||||
(loop (list (quote as) result next-type)))))
|
||||
result)))))))
|
||||
((and (= typ "colon"))
|
||||
(do
|
||||
(adv!)
|
||||
@@ -693,7 +740,7 @@
|
||||
(list (quote strict-eq) left (parse-expr))))
|
||||
((and (= typ "keyword") (or (= val "contain") (= val "include") (= val "includes")))
|
||||
(do (adv!) (list (quote contains?) left (parse-expr))))
|
||||
((and (= typ "keyword") (= val "precedes"))
|
||||
((and (= typ "keyword") (or (= val "precedes") (= val "precede")))
|
||||
(do (adv!) (list (quote precedes?) left (parse-atom))))
|
||||
((and (= typ "keyword") (= val "follows"))
|
||||
(do (adv!) (list (quote follows?) left (parse-atom))))
|
||||
@@ -772,7 +819,7 @@
|
||||
(= (tp-val) "starts")
|
||||
(= (tp-val) "ends")
|
||||
(= (tp-val) "contains")
|
||||
(= (tp-val) "matches")
|
||||
(or (= (tp-val) "matches") (= (tp-val) "match"))
|
||||
(= (tp-val) "is")
|
||||
(= (tp-val) "does")
|
||||
(= (tp-val) "in")
|
||||
@@ -892,6 +939,18 @@
|
||||
(let
|
||||
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
|
||||
(list (quote set-styles) (reverse pairs) tgt)))))
|
||||
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((attr-name (get (adv!) "value")))
|
||||
(when (and (= (tp-type) "op") (= (tp-val) "=")) (adv!))
|
||||
(let
|
||||
((attr-val (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "to" (list (quote me)))))
|
||||
(list (quote add-attr) attr-name attr-val tgt))))))
|
||||
(true
|
||||
(let
|
||||
((value (parse-expr)))
|
||||
@@ -978,20 +1037,58 @@
|
||||
()
|
||||
(cond
|
||||
((match-kw "between")
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((cls1 (do (let ((v (tp-val))) (adv!) v))))
|
||||
(expect-kw! "and")
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((cls2 (do (let ((v (tp-val))) (adv!) v))))
|
||||
(cond
|
||||
((= (tp-type) "class")
|
||||
(let
|
||||
((cls1 (do (let ((v (tp-val))) (adv!) v))))
|
||||
(expect-kw! "and")
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote toggle-between) cls1 cls2 tgt)))
|
||||
nil))
|
||||
nil))
|
||||
((cls2 (do (let ((v (tp-val))) (adv!) v))))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote toggle-between) cls1 cls2 tgt)))
|
||||
nil)))
|
||||
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((n1 (get (adv!) "value")))
|
||||
(when
|
||||
(and (= (tp-type) "op") (= (tp-val) "="))
|
||||
(adv!))
|
||||
(let
|
||||
((v1 (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(expect-kw! "and")
|
||||
(when (= (tp-type) "bracket-open") (adv!))
|
||||
(let
|
||||
((n2 (get (adv!) "value")))
|
||||
(when
|
||||
(and (= (tp-type) "op") (= (tp-val) "="))
|
||||
(adv!))
|
||||
(let
|
||||
((v2 (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(if
|
||||
(= n1 n2)
|
||||
(list
|
||||
(quote toggle-attr-between)
|
||||
n1
|
||||
v1
|
||||
v2
|
||||
tgt)
|
||||
(list
|
||||
(quote toggle-attr-diff)
|
||||
n1
|
||||
v1
|
||||
n2
|
||||
v2
|
||||
tgt)))))))))
|
||||
(true nil)))
|
||||
((= (tp-type) "class")
|
||||
(let
|
||||
((cls (do (let ((v (tp-val))) (adv!) v))))
|
||||
@@ -1012,38 +1109,67 @@
|
||||
(match-kw "between")
|
||||
(let
|
||||
((val1 (parse-atom)))
|
||||
(expect-kw! "and")
|
||||
(let
|
||||
((val2 (parse-atom)))
|
||||
(do
|
||||
(when (= (tp-type) "comma") (adv!))
|
||||
(if
|
||||
(match-kw "and")
|
||||
(let
|
||||
((val3 (parse-atom)))
|
||||
(if
|
||||
(match-kw "and")
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "and"))
|
||||
(adv!)
|
||||
nil)
|
||||
(let
|
||||
((val2 (parse-atom)))
|
||||
(if
|
||||
(or
|
||||
(= (tp-type) "comma")
|
||||
(and
|
||||
(= (tp-type) "keyword")
|
||||
(= (tp-val) "and")))
|
||||
(do
|
||||
(when (= (tp-type) "comma") (adv!))
|
||||
(if
|
||||
(and
|
||||
(= (tp-type) "keyword")
|
||||
(= (tp-val) "and"))
|
||||
(adv!)
|
||||
nil)
|
||||
(let
|
||||
((val4 (parse-atom)))
|
||||
(list
|
||||
(quote toggle-style-cycle)
|
||||
prop
|
||||
tgt
|
||||
val1
|
||||
val2
|
||||
val3
|
||||
val4))
|
||||
(list
|
||||
(quote toggle-style-cycle)
|
||||
prop
|
||||
tgt
|
||||
val1
|
||||
val2
|
||||
val3)))
|
||||
(list
|
||||
(quote toggle-style-between)
|
||||
prop
|
||||
val1
|
||||
val2
|
||||
tgt))))
|
||||
((val3 (parse-atom)))
|
||||
(if
|
||||
(or
|
||||
(= (tp-type) "comma")
|
||||
(and
|
||||
(= (tp-type) "keyword")
|
||||
(= (tp-val) "and")))
|
||||
(do
|
||||
(when (= (tp-type) "comma") (adv!))
|
||||
(if
|
||||
(and
|
||||
(= (tp-type) "keyword")
|
||||
(= (tp-val) "and"))
|
||||
(adv!)
|
||||
nil)
|
||||
(let
|
||||
((val4 (parse-atom)))
|
||||
(list
|
||||
(quote toggle-style-cycle)
|
||||
prop
|
||||
tgt
|
||||
val1
|
||||
val2
|
||||
val3
|
||||
val4)))
|
||||
(list
|
||||
(quote toggle-style-cycle)
|
||||
prop
|
||||
tgt
|
||||
val1
|
||||
val2
|
||||
val3))))
|
||||
(list
|
||||
(quote toggle-style-between)
|
||||
prop
|
||||
val1
|
||||
val2
|
||||
tgt)))))
|
||||
(list (quote toggle-style) prop tgt)))))
|
||||
((= (tp-type) "attr")
|
||||
(let
|
||||
@@ -1064,6 +1190,18 @@
|
||||
val2
|
||||
tgt)))
|
||||
(list (quote toggle-attr) attr-name tgt)))))
|
||||
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((attr-name (get (adv!) "value")))
|
||||
(when (and (= (tp-type) "op") (= (tp-val) "=")) (adv!))
|
||||
(let
|
||||
((attr-val (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote toggle-attr-val) attr-name attr-val tgt))))))
|
||||
((and (= (tp-type) "keyword") (= (tp-val) "my"))
|
||||
(do
|
||||
(adv!)
|
||||
@@ -1338,19 +1476,23 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
|
||||
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
|
||||
(let
|
||||
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (adv!) s)) "display")))
|
||||
(list (quote hide) tgt strategy)))))
|
||||
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
|
||||
(let
|
||||
((when-cond (if (and (= (tp-type) "keyword") (= (tp-val) "when")) (do (adv!) (parse-expr)) nil)))
|
||||
(list (quote hide) tgt strategy when-cond))))))
|
||||
(define
|
||||
parse-show-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
|
||||
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
|
||||
(let
|
||||
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (adv!) s)) "display")))
|
||||
(list (quote show) tgt strategy)))))
|
||||
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
|
||||
(let
|
||||
((when-cond (if (and (= (tp-type) "keyword") (= (tp-val) "when")) (do (adv!) (parse-expr)) nil)))
|
||||
(list (quote show) tgt strategy when-cond))))))
|
||||
(define
|
||||
parse-transition-cmd
|
||||
(fn
|
||||
@@ -1493,7 +1635,7 @@
|
||||
(ca-collect (append acc (list arg)))))))
|
||||
(ca-collect (list))))
|
||||
(define parse-call-cmd (fn () (parse-expr)))
|
||||
(define parse-get-cmd (fn () (parse-expr)))
|
||||
(define parse-get-cmd (fn () (list (quote __get-cmd) (parse-expr))))
|
||||
(define
|
||||
parse-take-cmd
|
||||
(fn
|
||||
@@ -1501,12 +1643,34 @@
|
||||
(cond
|
||||
((= (tp-type) "class")
|
||||
(let
|
||||
((cls (do (let ((v (tp-val))) (adv!) v))))
|
||||
((classes (list)))
|
||||
(let
|
||||
((from-sel (if (match-kw "from") (parse-expr) nil)))
|
||||
((collect (fn () (when (= (tp-type) "class") (let ((v (tp-val))) (adv!) (set! classes (append classes (list v))) (collect))))))
|
||||
(collect)
|
||||
(let
|
||||
((for-tgt (if (match-kw "for") (parse-expr) nil)))
|
||||
(list (quote take!) "class" cls from-sel for-tgt)))))
|
||||
((from-sel (if (match-kw "from") (parse-expr) nil)))
|
||||
(let
|
||||
((for-tgt (if (match-kw "for") (parse-expr) nil)))
|
||||
(if
|
||||
(= (len classes) 1)
|
||||
(list
|
||||
(quote take!)
|
||||
"class"
|
||||
(first classes)
|
||||
from-sel
|
||||
for-tgt)
|
||||
(cons
|
||||
(quote do)
|
||||
(map
|
||||
(fn
|
||||
(cls)
|
||||
(list
|
||||
(quote take!)
|
||||
"class"
|
||||
cls
|
||||
from-sel
|
||||
for-tgt))
|
||||
classes))))))))
|
||||
((= (tp-type) "attr")
|
||||
(let
|
||||
((attr-name (get (adv!) "value")))
|
||||
@@ -1540,7 +1704,9 @@
|
||||
(let
|
||||
((n (parse-atom)))
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(if
|
||||
(not (or (match-kw "of") (match-kw "from")))
|
||||
(error (str "Expected 'of' or 'from' at position " p)))
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-first) coll n))))))
|
||||
@@ -1550,7 +1716,9 @@
|
||||
(let
|
||||
((n (parse-atom)))
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(if
|
||||
(not (or (match-kw "of") (match-kw "from")))
|
||||
(error (str "Expected 'of' or 'from' at position " p)))
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-last) coll n))))))
|
||||
@@ -1558,14 +1726,17 @@
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(match-kw "of")
|
||||
(or (match-kw "of") (match-kw "from"))
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-random) coll nil))
|
||||
(let
|
||||
((n (parse-atom)))
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(if
|
||||
(not (or (match-kw "of") (match-kw "from")))
|
||||
(error
|
||||
(str "Expected 'of' or 'from' at position " p)))
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-random) coll n)))))))
|
||||
@@ -1579,7 +1750,10 @@
|
||||
(let
|
||||
((end-expr (parse-atom)))
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(if
|
||||
(not (or (match-kw "of") (match-kw "from")))
|
||||
(error
|
||||
(str "Expected 'of' or 'from' at position " p)))
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-items) coll start-expr end-expr))))))))
|
||||
@@ -1588,7 +1762,7 @@
|
||||
(adv!)
|
||||
(expect-kw! "of")
|
||||
(let
|
||||
((regex (parse-expr)))
|
||||
((regex (parse-atom)))
|
||||
(do
|
||||
(cond
|
||||
((match-kw "of") nil)
|
||||
@@ -1606,7 +1780,7 @@
|
||||
(adv!)
|
||||
(expect-kw! "of")
|
||||
(let
|
||||
((regex (parse-expr)))
|
||||
((regex (parse-atom)))
|
||||
(do
|
||||
(cond
|
||||
((match-kw "of") nil)
|
||||
@@ -1619,10 +1793,26 @@
|
||||
(let
|
||||
((haystack (parse-expr)))
|
||||
(list (quote pick-matches) regex haystack))))))
|
||||
((and (= typ "ident") (= val "item"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((n (parse-expr)))
|
||||
(do
|
||||
(if
|
||||
(not (or (match-kw "of") (match-kw "from")))
|
||||
(error (str "Expected 'of' or 'from' at position " p)))
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list
|
||||
(quote pick-items)
|
||||
coll
|
||||
n
|
||||
(list (quote +) n 1)))))))
|
||||
(true
|
||||
(error
|
||||
(str
|
||||
"Expected first/last/random/items/match/matches after 'pick' at "
|
||||
"Expected first/last/random/item/items/match/matches after 'pick' at "
|
||||
p)))))))
|
||||
(define
|
||||
parse-go-cmd
|
||||
@@ -1697,7 +1887,7 @@
|
||||
(match-kw "of")
|
||||
(list (make-symbol ".") (parse-expr) val)
|
||||
(cond
|
||||
((= val "result") (list (quote it)))
|
||||
((= val "result") (quote the-result))
|
||||
((= val "first") (parse-pos-kw (quote first)))
|
||||
((= val "last") (parse-pos-kw (quote last)))
|
||||
((= val "closest") (parse-trav (quote closest)))
|
||||
|
||||
@@ -22,7 +22,13 @@
|
||||
;; Stock hyperscript queues by default; "every" disables queuing.
|
||||
(define
|
||||
hs-on
|
||||
(fn (target event-name handler) (dom-listen target event-name handler)))
|
||||
(fn
|
||||
(target event-name handler)
|
||||
(let
|
||||
((unlisten (dom-listen target event-name handler))
|
||||
(prev (or (dom-get-data target "hs-unlisteners") (list))))
|
||||
(dom-set-data target "hs-unlisteners" (append prev (list unlisten)))
|
||||
unlisten)))
|
||||
|
||||
;; Run an initializer function immediately.
|
||||
;; (hs-init thunk) — called at element boot time
|
||||
@@ -88,7 +94,7 @@
|
||||
((or (= prop "display") (= prop "opacity"))
|
||||
(if
|
||||
(or (= cur "none") (= cur "0"))
|
||||
(dom-set-style target prop (if (= prop "opacity") "1" ""))
|
||||
(dom-set-style target prop (if (= prop "opacity") "1" "block"))
|
||||
(dom-set-style target prop (if (= prop "display") "none" "0"))))
|
||||
(true
|
||||
(if
|
||||
@@ -167,6 +173,45 @@
|
||||
(fn
|
||||
(el name val)
|
||||
(if (nil? val) (dom-remove-attr el name) (dom-set-attr el name val))))
|
||||
(define
|
||||
hs-toggle-attr!
|
||||
(fn
|
||||
(el name)
|
||||
(if
|
||||
(dom-has-attr? el name)
|
||||
(dom-remove-attr el name)
|
||||
(dom-set-attr el name ""))))
|
||||
(define
|
||||
hs-toggle-attr-val!
|
||||
(fn
|
||||
(el name val)
|
||||
(if
|
||||
(= (dom-get-attr el name) val)
|
||||
(dom-remove-attr el name)
|
||||
(dom-set-attr el name val))))
|
||||
(define
|
||||
hs-toggle-attr-between!
|
||||
(fn
|
||||
(el name val1 val2)
|
||||
(if
|
||||
(= (dom-get-attr el name) val1)
|
||||
(dom-set-attr el name val2)
|
||||
(dom-set-attr el name val1))))
|
||||
(define
|
||||
hs-toggle-attr-diff!
|
||||
(fn
|
||||
(el n1 v1 n2 v2)
|
||||
(if
|
||||
(dom-has-attr? el n1)
|
||||
(do (dom-remove-attr el n1) (dom-set-attr el n2 v2))
|
||||
(do
|
||||
(when (dom-has-attr? el n2) (dom-remove-attr el n2))
|
||||
(dom-set-attr el n1 v1)))))
|
||||
(define
|
||||
hs-set-inner-html!
|
||||
(fn
|
||||
(target value)
|
||||
(do (dom-set-inner-html target value) (hs-boot-subtree! target))))
|
||||
(define
|
||||
hs-put!
|
||||
(fn
|
||||
@@ -407,19 +452,24 @@
|
||||
hs-query-all
|
||||
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
|
||||
|
||||
(define
|
||||
hs-query-all-in
|
||||
(fn
|
||||
(sel target)
|
||||
(if
|
||||
(nil? target)
|
||||
(hs-query-all sel)
|
||||
(host-call target "querySelectorAll" sel))))
|
||||
|
||||
(define
|
||||
hs-list-set
|
||||
(fn (lst idx val) (map-indexed (fn (i x) (if (= i idx) val x)) lst)))
|
||||
(fn
|
||||
(lst idx val)
|
||||
(append (take lst idx) (cons val (drop lst (+ idx 1))))))
|
||||
|
||||
(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)))))
|
||||
(fn (v) (if (number? v) v (or (parse-number (str v)) 0))))
|
||||
|
||||
(define
|
||||
hs-query-first
|
||||
@@ -490,6 +540,10 @@
|
||||
((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
|
||||
(true (hs-repeat-while cond-fn thunk)))))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define
|
||||
hs-repeat-until
|
||||
(fn
|
||||
@@ -502,10 +556,6 @@
|
||||
(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
|
||||
@@ -525,27 +575,38 @@
|
||||
((= signal "hs-continue") (do-loop (rest remaining)))
|
||||
(true (do-loop (rest remaining))))))))
|
||||
(do-loop items))))
|
||||
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
(begin
|
||||
(define
|
||||
hs-append
|
||||
(fn
|
||||
(target value)
|
||||
(cond
|
||||
((nil? target) value)
|
||||
((string? target) (str target value))
|
||||
((list? target) (append target (list value)))
|
||||
((hs-element? target)
|
||||
(do
|
||||
(dom-insert-adjacent-html target "beforeend" (str value))
|
||||
target))
|
||||
(true (str target value)))))
|
||||
(define
|
||||
hs-append!
|
||||
(fn (value target) (dom-insert-adjacent-html target "beforeend" value))))
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
(fn
|
||||
(value target)
|
||||
(cond
|
||||
((nil? target) nil)
|
||||
((hs-element? target)
|
||||
(dom-insert-adjacent-html target "beforeend" (str value)))
|
||||
(true nil)))))
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
(define
|
||||
hs-fetch
|
||||
(fn
|
||||
(url format)
|
||||
(perform (list "io-fetch" url (if format format "text")))))
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
;; Method dispatch — obj.method(args)
|
||||
(define
|
||||
hs-coerce
|
||||
(fn
|
||||
@@ -636,7 +697,24 @@
|
||||
(map (fn (k) (list k (get value k))) (keys value))
|
||||
value))
|
||||
(true value))))
|
||||
;; Method dispatch — obj.method(args)
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
(define
|
||||
hs-default?
|
||||
(fn
|
||||
(v)
|
||||
(cond
|
||||
((nil? v) true)
|
||||
((and (string? v) (= v "")) true)
|
||||
(true false))))
|
||||
;; Property-based is — check obj.key truthiness
|
||||
(define
|
||||
hs-array-set!
|
||||
(fn
|
||||
(arr i v)
|
||||
(if (list? arr) (do (set-nth! arr i v) v) (host-set! arr i v))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
(define
|
||||
hs-add
|
||||
(fn
|
||||
@@ -646,9 +724,7 @@
|
||||
((list? b) (cons a b))
|
||||
((or (string? a) (string? b)) (str a b))
|
||||
(true (+ a b)))))
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
;; Collection: sorted by
|
||||
(define
|
||||
hs-make
|
||||
(fn
|
||||
@@ -659,13 +735,13 @@
|
||||
((= type-name "Set") (list))
|
||||
((= type-name "Map") (dict))
|
||||
(true (dict)))))
|
||||
;; Property-based is — check obj.key truthiness
|
||||
;; Collection: sorted by descending
|
||||
(define hs-install (fn (behavior-fn) (behavior-fn me)))
|
||||
;; Array slicing (inclusive both ends)
|
||||
;; Collection: split by
|
||||
(define
|
||||
hs-measure
|
||||
(fn (target) (perform (list (quote io-measure) target))))
|
||||
;; Collection: sorted by
|
||||
;; Collection: joined by
|
||||
(define
|
||||
hs-transition
|
||||
(fn
|
||||
@@ -678,7 +754,7 @@
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop value)
|
||||
(when duration (hs-settle target))))
|
||||
;; Collection: sorted by descending
|
||||
|
||||
(define
|
||||
hs-transition-from
|
||||
(fn
|
||||
@@ -692,7 +768,7 @@
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop (str to-val))
|
||||
(when duration (hs-settle target))))
|
||||
;; Collection: split by
|
||||
|
||||
(define
|
||||
hs-type-check
|
||||
(fn
|
||||
@@ -712,7 +788,7 @@
|
||||
(= (host-typeof value) "element")
|
||||
(= (host-typeof value) "text")))
|
||||
(true (= (host-typeof value) (downcase type-name)))))))
|
||||
;; Collection: joined by
|
||||
|
||||
(define
|
||||
hs-type-check-strict
|
||||
(fn
|
||||
@@ -745,11 +821,26 @@
|
||||
((nil? suffix) false)
|
||||
(true (ends-with? (str s) (str suffix))))))
|
||||
|
||||
(define
|
||||
hs-scoped-set!
|
||||
(fn (el name val) (dom-set-data el (str "hs-local-" name) val)))
|
||||
|
||||
(define
|
||||
hs-scoped-get
|
||||
(fn (el name) (dom-get-data el (str "hs-local-" name))))
|
||||
|
||||
(define
|
||||
hs-precedes?
|
||||
(fn
|
||||
(a b)
|
||||
(cond ((nil? a) false) ((nil? b) false) (true (< (str a) (str b))))))
|
||||
(cond
|
||||
((nil? a) false)
|
||||
((nil? b) false)
|
||||
((and (dict? a) (dict? b))
|
||||
(let
|
||||
((pos (host-call a "compareDocumentPosition" b)))
|
||||
(if (number? pos) (not (= 0 (mod (/ pos 4) 2))) false)))
|
||||
(true (< (str a) (str b))))))
|
||||
|
||||
(define
|
||||
hs-follows?
|
||||
@@ -840,7 +931,18 @@
|
||||
(= obj (nth r 1))
|
||||
(= obj nil)))))))
|
||||
|
||||
(define precedes? (fn (a b) (< (str a) (str b))))
|
||||
(define
|
||||
precedes?
|
||||
(fn
|
||||
(a b)
|
||||
(cond
|
||||
((nil? a) false)
|
||||
((nil? b) false)
|
||||
((and (dict? a) (dict? b))
|
||||
(let
|
||||
((pos (host-call a "compareDocumentPosition" b)))
|
||||
(if (number? pos) (not (= 0 (mod (/ pos 4) 2))) false)))
|
||||
(true (< (str a) (str b))))))
|
||||
|
||||
(define
|
||||
hs-empty?
|
||||
@@ -1124,33 +1226,109 @@
|
||||
(host-call el "removeAttribute" "open")
|
||||
(dom-set-prop el "open" false)))))))
|
||||
|
||||
(define
|
||||
hs-hide!
|
||||
(fn
|
||||
(el strategy)
|
||||
(let
|
||||
((tag (dom-get-prop el "tagName")))
|
||||
(cond
|
||||
((= tag "DIALOG")
|
||||
(when (dom-has-attr? el "open") (host-call el "close")))
|
||||
((= tag "DETAILS") (dom-set-prop el "open" false))
|
||||
((= strategy "opacity") (dom-set-style el "opacity" "0"))
|
||||
((= strategy "visibility") (dom-set-style el "visibility" "hidden"))
|
||||
(true (dom-set-style el "display" "none"))))))
|
||||
(begin
|
||||
(define
|
||||
hs-hide-one!
|
||||
(fn
|
||||
(el strategy)
|
||||
(let
|
||||
((parts (split strategy ":")) (tag (dom-get-prop el "tagName")))
|
||||
(let
|
||||
((prop (first parts))
|
||||
(val (if (> (len parts) 1) (nth parts 1) nil)))
|
||||
(cond
|
||||
((= tag "DIALOG")
|
||||
(when (dom-has-attr? el "open") (host-call el "close")))
|
||||
((= tag "DETAILS") (dom-set-prop el "open" false))
|
||||
((= prop "opacity")
|
||||
(dom-set-style el "opacity" (if val val "0")))
|
||||
((= prop "visibility")
|
||||
(dom-set-style el "visibility" (if val val "hidden")))
|
||||
((= prop "hidden") (dom-set-attr el "hidden" ""))
|
||||
((= prop "twDisplay") (dom-add-class el "hidden"))
|
||||
((= prop "twVisibility") (dom-add-class el "invisible"))
|
||||
((= prop "twOpacity") (dom-add-class el "opacity-0"))
|
||||
(true (dom-set-style el "display" (if val val "none"))))))))
|
||||
(define
|
||||
hs-hide!
|
||||
(fn
|
||||
(target strategy)
|
||||
(if
|
||||
(list? target)
|
||||
(do (for-each (fn (el) (hs-hide-one! el strategy)) target) target)
|
||||
(do (hs-hide-one! target strategy) target)))))
|
||||
|
||||
(begin
|
||||
(define
|
||||
hs-show-one!
|
||||
(fn
|
||||
(el strategy)
|
||||
(let
|
||||
((parts (split strategy ":")) (tag (dom-get-prop el "tagName")))
|
||||
(let
|
||||
((prop (first parts))
|
||||
(val (if (> (len parts) 1) (nth parts 1) nil)))
|
||||
(cond
|
||||
((= tag "DIALOG")
|
||||
(when
|
||||
(not (dom-has-attr? el "open"))
|
||||
(host-call el "showModal")))
|
||||
((= tag "DETAILS") (dom-set-prop el "open" true))
|
||||
((= prop "opacity")
|
||||
(dom-set-style el "opacity" (if val val "1")))
|
||||
((= prop "visibility")
|
||||
(dom-set-style el "visibility" (if val val "visible")))
|
||||
((= prop "hidden") (dom-remove-attr el "hidden"))
|
||||
((= prop "twDisplay") (dom-remove-class el "hidden"))
|
||||
((= prop "twVisibility") (dom-remove-class el "invisible"))
|
||||
((= prop "twOpacity") (dom-remove-class el "opacity-0"))
|
||||
(true (dom-set-style el "display" (if val val "block"))))))))
|
||||
(define
|
||||
hs-show!
|
||||
(fn
|
||||
(target strategy)
|
||||
(if
|
||||
(list? target)
|
||||
(do (for-each (fn (el) (hs-show-one! el strategy)) target) target)
|
||||
(do (hs-show-one! target strategy) target)))))
|
||||
|
||||
(define
|
||||
hs-show!
|
||||
hs-show-when!
|
||||
(fn
|
||||
(el strategy)
|
||||
(target strategy pred)
|
||||
(let
|
||||
((tag (dom-get-prop el "tagName")))
|
||||
(cond
|
||||
((= tag "DIALOG")
|
||||
(when (not (dom-has-attr? el "open")) (host-call el "showModal")))
|
||||
((= tag "DETAILS") (dom-set-prop el "open" true))
|
||||
((= strategy "opacity") (dom-set-style el "opacity" "1"))
|
||||
((= strategy "visibility") (dom-set-style el "visibility" "visible"))
|
||||
(true (dom-set-style el "display" ""))))))
|
||||
((items (if (list? target) target (list target))))
|
||||
(let
|
||||
((matched (list)))
|
||||
(do
|
||||
(for-each
|
||||
(fn
|
||||
(el)
|
||||
(if
|
||||
(pred el)
|
||||
(do (hs-show-one! el strategy) (append! matched el))
|
||||
(hs-hide-one! el strategy)))
|
||||
items)
|
||||
matched)))))
|
||||
|
||||
(define
|
||||
hs-hide-when!
|
||||
(fn
|
||||
(target strategy pred)
|
||||
(let
|
||||
((items (if (list? target) target (list target))))
|
||||
(let
|
||||
((matched (list)))
|
||||
(do
|
||||
(for-each
|
||||
(fn
|
||||
(el)
|
||||
(if
|
||||
(pred el)
|
||||
(do (hs-hide-one! el strategy) (append! matched el))
|
||||
(hs-show-one! el strategy)))
|
||||
items)
|
||||
matched)))))
|
||||
|
||||
(define hs-first (fn (lst) (first lst)))
|
||||
|
||||
@@ -1390,7 +1568,7 @@
|
||||
false
|
||||
(let
|
||||
((store (host-get el "__hs_vars")))
|
||||
(if (nil? store) false (has-key? store name))))))
|
||||
(if (nil? store) false (host-call store "hasOwnProperty" name))))))
|
||||
|
||||
(define
|
||||
hs-dom-get-var-raw
|
||||
@@ -1409,7 +1587,7 @@
|
||||
(do
|
||||
(when
|
||||
(nil? (host-get el "__hs_vars"))
|
||||
(host-set! el "__hs_vars" (dict)))
|
||||
(host-set! el "__hs_vars" (host-new "Object")))
|
||||
(host-set! (host-get el "__hs_vars") name val)
|
||||
(when changed (hs-dom-fire-watchers! el name val))))))
|
||||
|
||||
|
||||
@@ -436,6 +436,8 @@
|
||||
(let
|
||||
((ch (hs-cur)) (start pos))
|
||||
(cond
|
||||
(and (= ch "-") (< (+ pos 1) src-len) (= (hs-peek 1) "-"))
|
||||
(do (hs-advance! 2) (skip-comment!) (scan!))
|
||||
(and (= ch "/") (< (+ pos 1) src-len) (= (hs-peek 1) "/"))
|
||||
(do (hs-advance! 2) (skip-comment!) (scan!))
|
||||
(and
|
||||
@@ -613,6 +615,8 @@
|
||||
(do (hs-emit! "op" "\\" start) (hs-advance! 1) (scan!))
|
||||
(= ch ":")
|
||||
(do (hs-emit! "colon" ":" start) (hs-advance! 1) (scan!))
|
||||
(= ch "|")
|
||||
(do (hs-emit! "op" "|" start) (hs-advance! 1) (scan!))
|
||||
:else (do (hs-advance! 1) (scan!)))))))
|
||||
(scan!)
|
||||
(hs-emit! "eof" nil pos)
|
||||
|
||||
Reference in New Issue
Block a user