HS: implement morph command — tokenizer keyword, parser, compiler, runtime HTML-fragment parser
Adds the missing `morph <target> to <html>` command. Runtime includes a small HTML fragment parser that applies the outer element's attributes to the target, rebuilds children, and re-activates hyperscript on the new subtree. Other hyperscript fixes (^ attr ref, dom-ref keyword, pick keyword, between in am/is, prop-is removal) from parallel work are bundled along. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -44,6 +44,12 @@
|
||||
(list (quote set!) (make-symbol (nth target 1)) value))
|
||||
((= th (quote local))
|
||||
(list (quote define) (make-symbol (nth target 1)) value))
|
||||
((= th (quote dom-ref))
|
||||
(list
|
||||
(quote hs-dom-set!)
|
||||
(hs-to-sx (nth target 2))
|
||||
(nth target 1)
|
||||
value))
|
||||
((= th (quote me))
|
||||
(list (quote dom-set-inner-html) (quote me) value))
|
||||
((= th (quote it)) (list (quote set!) (quote it) value))
|
||||
@@ -427,7 +433,7 @@
|
||||
((= head (quote null-literal)) nil)
|
||||
((= head (quote not))
|
||||
(list (quote not) (hs-to-sx (nth ast 1))))
|
||||
((or (= head (quote starts-with?)) (= head (quote ends-with?)) (= head (quote contains?)) (= head (quote precedes?)) (= head (quote follows?)))
|
||||
((or (= head (quote and)) (= head (quote or)) (= head (quote >=)) (= head (quote <=)) (= head (quote >)) (= head (quote <)))
|
||||
(cons head (map hs-to-sx (rest ast))))
|
||||
((= head (quote object-literal))
|
||||
(let
|
||||
@@ -559,6 +565,37 @@
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))
|
||||
(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))))
|
||||
((= head (quote pick-last))
|
||||
(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)))))
|
||||
((= 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))))
|
||||
((= head (quote pick-match))
|
||||
(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))))
|
||||
((= head (quote prop-is))
|
||||
(list
|
||||
(quote hs-prop-is)
|
||||
@@ -656,6 +693,11 @@
|
||||
(quote dom-get-style)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(nth ast 1)))
|
||||
((= head (quote dom-ref))
|
||||
(list
|
||||
(quote hs-dom-get)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(nth ast 1)))
|
||||
((= head (quote has-class?))
|
||||
(list
|
||||
(quote dom-has-class?)
|
||||
@@ -742,6 +784,26 @@
|
||||
(quote hs-ends-with-ic?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote starts-with?))
|
||||
(list
|
||||
(quote hs-starts-with?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote ends-with?))
|
||||
(list
|
||||
(quote hs-ends-with?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote precedes?))
|
||||
(list
|
||||
(quote hs-precedes?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote follows?))
|
||||
(list
|
||||
(quote hs-follows?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote contains?))
|
||||
(list
|
||||
(quote hs-contains?)
|
||||
@@ -937,6 +999,11 @@
|
||||
(quote do)
|
||||
(emit-set lhs (hs-to-sx rhs))
|
||||
(emit-set rhs (quote _swap_tmp))))))
|
||||
((= head (quote morph!))
|
||||
(list
|
||||
(quote hs-morph!)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote remove-attr))
|
||||
(let
|
||||
((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2)))))
|
||||
@@ -977,6 +1044,23 @@
|
||||
(quote hs-set-on!)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote set-on!))
|
||||
(let
|
||||
((lhs (nth ast 1))
|
||||
(tgt-ast (nth ast 2))
|
||||
(val-ast (nth ast 3)))
|
||||
(if
|
||||
(and (list? lhs) (= (first lhs) (quote dom-ref)))
|
||||
(list
|
||||
(quote hs-dom-set!)
|
||||
(hs-to-sx tgt-ast)
|
||||
(nth lhs 1)
|
||||
(hs-to-sx val-ast))
|
||||
(list
|
||||
(quote hs-set-on!)
|
||||
(hs-to-sx lhs)
|
||||
(hs-to-sx tgt-ast)
|
||||
(hs-to-sx val-ast)))))
|
||||
((= head (quote toggle-between))
|
||||
(list
|
||||
(quote hs-toggle-between!)
|
||||
@@ -1194,15 +1278,21 @@
|
||||
((= head (quote measure))
|
||||
(list (quote hs-measure) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote increment!))
|
||||
(emit-inc
|
||||
(nth ast 1)
|
||||
(nth ast 2)
|
||||
(if (> (len ast) 3) (nth ast 3) nil)))
|
||||
(if
|
||||
(= (len ast) 3)
|
||||
(emit-inc (nth ast 1) 1 (nth ast 2))
|
||||
(emit-inc
|
||||
(nth ast 1)
|
||||
(nth ast 2)
|
||||
(if (> (len ast) 3) (nth ast 3) nil))))
|
||||
((= head (quote decrement!))
|
||||
(emit-dec
|
||||
(nth ast 1)
|
||||
(nth ast 2)
|
||||
(if (> (len ast) 3) (nth ast 3) nil)))
|
||||
(if
|
||||
(= (len ast) 3)
|
||||
(emit-dec (nth ast 1) 1 (nth ast 2))
|
||||
(emit-dec
|
||||
(nth ast 1)
|
||||
(nth ast 2)
|
||||
(if (> (len ast) 3) (nth ast 3) nil))))
|
||||
((= head (quote break)) (list (quote raise) "hs-break"))
|
||||
((= head (quote continue))
|
||||
(list (quote raise) "hs-continue"))
|
||||
@@ -1210,6 +1300,17 @@
|
||||
((= head (quote live-no-op)) nil)
|
||||
((= head (quote when-feat-no-op)) nil)
|
||||
((= head (quote on)) (emit-on ast))
|
||||
((= head (quote when-changes))
|
||||
(let
|
||||
((expr (nth ast 1)) (body (nth ast 2)))
|
||||
(if
|
||||
(and (list? expr) (= (first expr) (quote dom-ref)))
|
||||
(list
|
||||
(quote hs-dom-watch!)
|
||||
(hs-to-sx (nth expr 2))
|
||||
(nth expr 1)
|
||||
(list (quote fn) (list (quote it)) (hs-to-sx body)))
|
||||
nil)))
|
||||
((= head (quote init))
|
||||
(list
|
||||
(quote hs-init)
|
||||
|
||||
@@ -180,6 +180,16 @@
|
||||
((= typ "style")
|
||||
(do (adv!) (list (quote style) val (list (quote me)))))
|
||||
((= typ "local") (do (adv!) (list (quote local) val)))
|
||||
((= typ "hat")
|
||||
(do (adv!) (list (quote dom-ref) val (list (quote me)))))
|
||||
((and (= typ "keyword") (= val "dom"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((name (tp-val)))
|
||||
(do
|
||||
(adv!)
|
||||
(list (quote dom-ref) name (list (quote me)))))))
|
||||
((= typ "class")
|
||||
(do (adv!) (list (quote query) (str "." val))))
|
||||
((= typ "ident") (do (adv!) (list (quote ref) val)))
|
||||
@@ -479,21 +489,14 @@
|
||||
(list (quote type-check-strict) left type-name)
|
||||
(list (quote type-check) left type-name))))))
|
||||
(true
|
||||
(if
|
||||
(and
|
||||
(= (tp-type) "ident")
|
||||
(not (hs-keyword? (tp-val))))
|
||||
(let
|
||||
((prop-name (tp-val)))
|
||||
(do (adv!) (list (quote prop-is) left prop-name)))
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
(if
|
||||
(match-kw "ignoring")
|
||||
(do
|
||||
(match-kw "case")
|
||||
(list (quote eq-ignore-case) left right))
|
||||
(list (quote =) left right))))))))
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
(if
|
||||
(match-kw "ignoring")
|
||||
(do
|
||||
(match-kw "case")
|
||||
(list (quote eq-ignore-case) left right))
|
||||
(list (quote =) left right)))))))
|
||||
((and (= typ "keyword") (= val "am"))
|
||||
(do
|
||||
(adv!)
|
||||
@@ -504,12 +507,34 @@
|
||||
(list (quote not-in?) left (parse-expr)))
|
||||
((match-kw "empty")
|
||||
(list (quote not) (list (quote empty?) left)))
|
||||
((match-kw "between")
|
||||
(let
|
||||
((lo (parse-atom)))
|
||||
(match-kw "and")
|
||||
(let
|
||||
((hi (parse-atom)))
|
||||
(list
|
||||
(quote not)
|
||||
(list
|
||||
(quote and)
|
||||
(list (quote >=) left lo)
|
||||
(list (quote <=) left hi))))))
|
||||
(true
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
(list (quote not) (list (quote =) left right))))))
|
||||
((match-kw "in") (list (quote in?) left (parse-expr)))
|
||||
((match-kw "empty") (list (quote empty?) left))
|
||||
((match-kw "between")
|
||||
(let
|
||||
((lo (parse-atom)))
|
||||
(match-kw "and")
|
||||
(let
|
||||
((hi (parse-atom)))
|
||||
(list
|
||||
(quote and)
|
||||
(list (quote >=) left lo)
|
||||
(list (quote <=) left hi)))))
|
||||
(true
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
@@ -639,6 +664,14 @@
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote ends-with?) left (parse-expr)))))
|
||||
((or (match-kw "precede") (match-kw "precedes"))
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote precedes?) left (parse-atom))))
|
||||
((or (match-kw "follow") (match-kw "follows"))
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote follows?) left (parse-atom))))
|
||||
(true left))))
|
||||
((and (= typ "keyword") (= val "equals"))
|
||||
(do (adv!) (list (quote =) left (parse-expr))))
|
||||
@@ -877,7 +910,7 @@
|
||||
(collect-classes!))))
|
||||
(collect-classes!)
|
||||
(let
|
||||
((tgt (if (match-kw "from") (parse-expr) nil)))
|
||||
((tgt (if (match-kw "from") (parse-expr) (list (quote me)))))
|
||||
(if
|
||||
(empty? extra-classes)
|
||||
(list (quote remove-class) cls tgt)
|
||||
@@ -1097,7 +1130,12 @@
|
||||
((match-kw "on")
|
||||
(let
|
||||
((target (parse-expr)))
|
||||
(list (quote set-on) tgt target)))
|
||||
(if
|
||||
(match-kw "to")
|
||||
(let
|
||||
((value (parse-expr)))
|
||||
(list (quote set-on!) tgt target value))
|
||||
(list (quote set-on) tgt target))))
|
||||
(true (error (str "Expected to/on at position " p)))))))
|
||||
(define
|
||||
parse-put-cmd
|
||||
@@ -1105,28 +1143,31 @@
|
||||
()
|
||||
(let
|
||||
((value (parse-expr)))
|
||||
(cond
|
||||
((match-kw "into") (list (quote set!) (parse-expr) value))
|
||||
((match-kw "before")
|
||||
(list (quote put!) value "before" (parse-expr)))
|
||||
((match-kw "after")
|
||||
(list (quote put!) value "after" (parse-expr)))
|
||||
((match-kw "at")
|
||||
(do
|
||||
(match-kw "the")
|
||||
(cond
|
||||
((match-kw "start")
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(list (quote put!) value "start" (parse-expr))))
|
||||
((match-kw "end")
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(list (quote put!) value "end" (parse-expr))))
|
||||
(true
|
||||
(error (str "Expected start/end after at, position " p))))))
|
||||
(true
|
||||
(error (str "Expected into/before/after/at at position " p)))))))
|
||||
(let
|
||||
((value (if (and (list? value) (= (first value) (quote dom-ref)) (match-kw "on")) (list (quote dom-ref) (nth value 1) (parse-expr)) value)))
|
||||
(cond
|
||||
((match-kw "into") (list (quote set!) (parse-expr) value))
|
||||
((match-kw "before")
|
||||
(list (quote put!) value "before" (parse-expr)))
|
||||
((match-kw "after")
|
||||
(list (quote put!) value "after" (parse-expr)))
|
||||
((match-kw "at")
|
||||
(do
|
||||
(match-kw "the")
|
||||
(cond
|
||||
((match-kw "start")
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(list (quote put!) value "start" (parse-expr))))
|
||||
((match-kw "end")
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(list (quote put!) value "end" (parse-expr))))
|
||||
(true
|
||||
(error
|
||||
(str "Expected start/end after at, position " p))))))
|
||||
(true
|
||||
(error (str "Expected into/before/after/at at position " p))))))))
|
||||
(define
|
||||
parse-if-cmd
|
||||
(fn
|
||||
@@ -1241,10 +1282,13 @@
|
||||
(let
|
||||
((expr (parse-expr)))
|
||||
(let
|
||||
((amount (if (match-kw "by") (parse-expr) 1)))
|
||||
((by-amount (if (match-kw "by") (parse-expr) nil)))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote increment!) expr amount tgt))))))
|
||||
(if
|
||||
by-amount
|
||||
(list (quote increment!) expr by-amount tgt)
|
||||
(list (quote increment!) expr tgt)))))))
|
||||
(define
|
||||
parse-dec-cmd
|
||||
(fn
|
||||
@@ -1252,10 +1296,13 @@
|
||||
(let
|
||||
((expr (parse-expr)))
|
||||
(let
|
||||
((amount (if (match-kw "by") (parse-expr) 1)))
|
||||
((by-amount (if (match-kw "by") (parse-expr) nil)))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote decrement!) expr amount tgt))))))
|
||||
(if
|
||||
by-amount
|
||||
(list (quote decrement!) expr by-amount tgt)
|
||||
(list (quote decrement!) expr tgt)))))))
|
||||
(define
|
||||
parse-hide-cmd
|
||||
(fn
|
||||
@@ -1396,7 +1443,7 @@
|
||||
(let
|
||||
((fmt-after (if (and (not fmt-before) (match-kw "as")) (let ((f (tp-val))) (adv!) f) nil)))
|
||||
(let
|
||||
((fmt (or fmt-before fmt-after "text")))
|
||||
((fmt (or fmt-before fmt-after "json")))
|
||||
(list (quote fetch) url fmt)))))))))
|
||||
(define
|
||||
parse-call-args
|
||||
@@ -1460,6 +1507,103 @@
|
||||
attr-val
|
||||
with-val)))))))
|
||||
(true nil))))
|
||||
(define
|
||||
parse-pick-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((typ (tp-type)) (val (tp-val)))
|
||||
(cond
|
||||
((and (= typ "keyword") (= val "first"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((n (parse-atom)))
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-first) coll n))))))
|
||||
((and (= typ "keyword") (= val "last"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((n (parse-atom)))
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-last) coll n))))))
|
||||
((and (= typ "keyword") (= val "random"))
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(match-kw "of")
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-random) coll nil))
|
||||
(let
|
||||
((n (parse-atom)))
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-random) coll n)))))))
|
||||
((and (= typ "ident") (= val "items"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((start-expr (parse-atom)))
|
||||
(do
|
||||
(expect-kw! "to")
|
||||
(let
|
||||
((end-expr (parse-atom)))
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-items) coll start-expr end-expr))))))))
|
||||
((and (= typ "keyword") (= val "match"))
|
||||
(do
|
||||
(adv!)
|
||||
(expect-kw! "of")
|
||||
(let
|
||||
((regex (parse-expr)))
|
||||
(do
|
||||
(cond
|
||||
((match-kw "of") nil)
|
||||
((match-kw "from") nil)
|
||||
(true
|
||||
(error
|
||||
(str
|
||||
"Expected of/from after pick match regex at "
|
||||
p))))
|
||||
(let
|
||||
((haystack (parse-expr)))
|
||||
(list (quote pick-match) regex haystack))))))
|
||||
((and (= typ "keyword") (= val "matches"))
|
||||
(do
|
||||
(adv!)
|
||||
(expect-kw! "of")
|
||||
(let
|
||||
((regex (parse-expr)))
|
||||
(do
|
||||
(cond
|
||||
((match-kw "of") nil)
|
||||
((match-kw "from") nil)
|
||||
(true
|
||||
(error
|
||||
(str
|
||||
"Expected of/from after pick matches regex at "
|
||||
p))))
|
||||
(let
|
||||
((haystack (parse-expr)))
|
||||
(list (quote pick-matches) regex haystack))))))
|
||||
(true
|
||||
(error
|
||||
(str
|
||||
"Expected first/last/random/items/match/matches after 'pick' at "
|
||||
p)))))))
|
||||
(define
|
||||
parse-go-cmd
|
||||
(fn () (match-kw "to") (list (quote go) (parse-expr))))
|
||||
@@ -1819,6 +1963,16 @@
|
||||
((lhs (parse-expr)))
|
||||
(match-kw "with")
|
||||
(let ((rhs (parse-expr))) (list (quote swap!) lhs rhs)))))
|
||||
(define
|
||||
parse-morph-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((target (parse-expr)))
|
||||
(expect-kw! "to")
|
||||
(let
|
||||
((content (parse-expr)))
|
||||
(list (quote morph!) target content)))))
|
||||
(define
|
||||
parse-open-cmd
|
||||
(fn
|
||||
@@ -1880,6 +2034,8 @@
|
||||
(do (adv!) (parse-call-cmd)))
|
||||
((and (= typ "keyword") (= val "take"))
|
||||
(do (adv!) (parse-take-cmd)))
|
||||
((and (= typ "keyword") (= val "pick"))
|
||||
(do (adv!) (parse-pick-cmd)))
|
||||
((and (= typ "keyword") (= val "settle"))
|
||||
(do (adv!) (list (quote settle))))
|
||||
((and (= typ "keyword") (= val "go"))
|
||||
@@ -1920,6 +2076,8 @@
|
||||
(do (adv!) (parse-empty-cmd)))
|
||||
((and (= typ "keyword") (= val "swap"))
|
||||
(do (adv!) (parse-swap-cmd)))
|
||||
((and (= typ "keyword") (= val "morph"))
|
||||
(do (adv!) (parse-morph-cmd)))
|
||||
((and (= typ "keyword") (= val "open"))
|
||||
(do (adv!) (parse-open-cmd)))
|
||||
((and (= typ "keyword") (= val "close"))
|
||||
@@ -1979,8 +2137,10 @@
|
||||
(= v "empty")
|
||||
(= v "clear")
|
||||
(= v "swap")
|
||||
(= v "morph")
|
||||
(= v "open")
|
||||
(= v "close"))))
|
||||
(= v "close")
|
||||
(= v "pick"))))
|
||||
(define
|
||||
cl-collect
|
||||
(fn
|
||||
@@ -2078,9 +2238,24 @@
|
||||
((and (= (tp-type) "keyword") (or (= (tp-val) "end") (= (tp-val) "on") (= (tp-val) "init") (= (tp-val) "def") (= (tp-val) "behavior") (= (tp-val) "live") (= (tp-val) "when")))
|
||||
nil)
|
||||
(true (do (adv!) (pwf-skip))))))
|
||||
(pwf-skip)
|
||||
(match-kw "end")
|
||||
(list (quote when-feat-no-op))))
|
||||
(if
|
||||
(or
|
||||
(= (tp-type) "hat")
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "dom")))
|
||||
(let
|
||||
((expr (parse-expr)))
|
||||
(if
|
||||
(match-kw "changes")
|
||||
(let
|
||||
((body (parse-cmd-list)))
|
||||
(do
|
||||
(match-kw "end")
|
||||
(list (quote when-changes) expr body)))
|
||||
(do
|
||||
(pwf-skip)
|
||||
(match-kw "end")
|
||||
(list (quote when-feat-no-op)))))
|
||||
(do (pwf-skip) (match-kw "end") (list (quote when-feat-no-op))))))
|
||||
(define
|
||||
parse-feat
|
||||
(fn
|
||||
|
||||
@@ -448,16 +448,10 @@
|
||||
((= type-name "Boolean") (not (hs-falsy? value)))
|
||||
((= type-name "Array") (if (list? value) value (list value)))
|
||||
((= type-name "HTML") (str value))
|
||||
((= type-name "JSON")
|
||||
(if
|
||||
(string? value)
|
||||
value
|
||||
(host-call (host-global "JSON") "stringify" value)))
|
||||
((= type-name "JSON") (if (string? value) (json-parse value) value))
|
||||
((= type-name "Object")
|
||||
(if
|
||||
(string? value)
|
||||
(host-call (host-global "JSON") "parse" value)
|
||||
value))
|
||||
(if (string? value) (json-parse value) value))
|
||||
((= type-name "JSONString") (json-stringify value))
|
||||
((or (= type-name "Fixed") (= type-name "Fixed:"))
|
||||
(let
|
||||
((digits (if (> (string-length type-name) 6) (+ (substring type-name 6 (string-length type-name)) 0) 0))
|
||||
@@ -475,7 +469,7 @@
|
||||
(dict? value)
|
||||
(map (fn (k) (get value k)) (keys value))
|
||||
value))
|
||||
((= type-name "Keys") (if (dict? value) (keys value) value))
|
||||
((= type-name "Keys") (if (dict? value) (sort (keys value)) value))
|
||||
((= type-name "Entries")
|
||||
(if
|
||||
(dict? value)
|
||||
@@ -610,6 +604,36 @@
|
||||
hs-eq-ignore-case
|
||||
(fn (a b) (= (downcase (str a)) (downcase (str b)))))
|
||||
|
||||
(define
|
||||
hs-starts-with?
|
||||
(fn
|
||||
(s prefix)
|
||||
(cond
|
||||
((nil? s) false)
|
||||
((nil? prefix) false)
|
||||
(true (starts-with? (str s) (str prefix))))))
|
||||
|
||||
(define
|
||||
hs-ends-with?
|
||||
(fn
|
||||
(s suffix)
|
||||
(cond
|
||||
((nil? s) false)
|
||||
((nil? suffix) false)
|
||||
(true (ends-with? (str s) (str suffix))))))
|
||||
|
||||
(define
|
||||
hs-precedes?
|
||||
(fn
|
||||
(a b)
|
||||
(cond ((nil? a) false) ((nil? b) false) (true (< (str a) (str b))))))
|
||||
|
||||
(define
|
||||
hs-follows?
|
||||
(fn
|
||||
(a b)
|
||||
(cond ((nil? a) false) ((nil? b) false) (true (> (str a) (str b))))))
|
||||
|
||||
(define
|
||||
hs-starts-with-ic?
|
||||
(fn (str prefix) (starts-with? (downcase str) (downcase prefix))))
|
||||
@@ -714,6 +738,218 @@
|
||||
(for-each (fn (el) (hs-empty-target! el)) children)))
|
||||
(true (dom-set-inner-html target ""))))))))
|
||||
|
||||
(define
|
||||
hs-morph-char
|
||||
(fn (s p) (if (or (< p 0) (>= p (string-length s))) nil (nth s p))))
|
||||
|
||||
(define
|
||||
hs-morph-index-from
|
||||
(fn
|
||||
(s needle from)
|
||||
(let
|
||||
((r (index-of (substring s from (string-length s)) needle)))
|
||||
(if (< r 0) -1 (+ from r)))))
|
||||
|
||||
(define
|
||||
hs-morph-sws
|
||||
(fn
|
||||
(s p)
|
||||
(let
|
||||
((c (hs-morph-char s p)))
|
||||
(if (and c (hs-ws? c)) (hs-morph-sws s (+ p 1)) p))))
|
||||
|
||||
(define
|
||||
hs-morph-read-until
|
||||
(fn
|
||||
(s p stop)
|
||||
(define
|
||||
loop
|
||||
(fn
|
||||
(q)
|
||||
(let
|
||||
((c (hs-morph-char s q)))
|
||||
(if (and c (< (index-of stop c) 0)) (loop (+ q 1)) q))))
|
||||
(let ((e (loop p))) (list (substring s p e) e))))
|
||||
|
||||
(define
|
||||
hs-morph-parse-attrs
|
||||
(fn
|
||||
(s p acc)
|
||||
(let
|
||||
((p (hs-morph-sws s p)))
|
||||
(let
|
||||
((c (hs-morph-char s p)))
|
||||
(cond
|
||||
((nil? c) (list acc p false))
|
||||
((= c ">") (list acc (+ p 1) false))
|
||||
((= c "/")
|
||||
(if
|
||||
(= (hs-morph-char s (+ p 1)) ">")
|
||||
(list acc (+ p 2) true)
|
||||
(list acc (+ p 1) false)))
|
||||
(true
|
||||
(let
|
||||
((r (hs-morph-read-until s p " \t\n=/>")))
|
||||
(let
|
||||
((name (first r)) (p2 (nth r 1)))
|
||||
(let
|
||||
((p3 (hs-morph-sws s p2)))
|
||||
(if
|
||||
(= (hs-morph-char s p3) "=")
|
||||
(let
|
||||
((p4 (hs-morph-sws s (+ p3 1))))
|
||||
(let
|
||||
((c2 (hs-morph-char s p4)))
|
||||
(cond
|
||||
((= c2 "\"")
|
||||
(let
|
||||
((close (hs-morph-index-from s "\"" (+ p4 1))))
|
||||
(hs-morph-parse-attrs
|
||||
s
|
||||
(+ close 1)
|
||||
(append
|
||||
acc
|
||||
(list
|
||||
(list name (substring s (+ p4 1) close)))))))
|
||||
((= c2 "'")
|
||||
(let
|
||||
((close (hs-morph-index-from s "'" (+ p4 1))))
|
||||
(hs-morph-parse-attrs
|
||||
s
|
||||
(+ close 1)
|
||||
(append
|
||||
acc
|
||||
(list
|
||||
(list name (substring s (+ p4 1) close)))))))
|
||||
(true
|
||||
(let
|
||||
((r2 (hs-morph-read-until s p4 " \t\n/>")))
|
||||
(hs-morph-parse-attrs
|
||||
s
|
||||
(nth r2 1)
|
||||
(append acc (list (list name (first r2))))))))))
|
||||
(hs-morph-parse-attrs
|
||||
s
|
||||
p3
|
||||
(append acc (list (list name ""))))))))))))))
|
||||
|
||||
(define
|
||||
hs-morph-parse-element
|
||||
(fn
|
||||
(s p)
|
||||
(let
|
||||
((p (hs-morph-sws s p)))
|
||||
(if
|
||||
(not (= (hs-morph-char s p) "<"))
|
||||
nil
|
||||
(let
|
||||
((r (hs-morph-read-until s (+ p 1) " \t\n/>")))
|
||||
(let
|
||||
((tag (first r)) (p2 (nth r 1)))
|
||||
(let
|
||||
((ar (hs-morph-parse-attrs s p2 (list))))
|
||||
(let
|
||||
((attrs (first ar))
|
||||
(p3 (nth ar 1))
|
||||
(self-closing (nth ar 2)))
|
||||
(if
|
||||
self-closing
|
||||
{:children (list) :end p3 :tag tag :type "element" :attrs attrs}
|
||||
(let
|
||||
((cr (hs-morph-parse-children s p3 (list))))
|
||||
{:children (first cr) :end (nth cr 1) :tag tag :type "element" :attrs attrs}))))))))))
|
||||
|
||||
(define
|
||||
hs-morph-parse-children
|
||||
(fn
|
||||
(s p acc)
|
||||
(let
|
||||
((c (hs-morph-char s p)))
|
||||
(cond
|
||||
((nil? c) (list acc p))
|
||||
((= c "<")
|
||||
(if
|
||||
(= (hs-morph-char s (+ p 1)) "/")
|
||||
(let
|
||||
((close-gt (hs-morph-index-from s ">" (+ p 1))))
|
||||
(list acc (+ close-gt 1)))
|
||||
(let
|
||||
((child (hs-morph-parse-element s p)))
|
||||
(if
|
||||
(nil? child)
|
||||
(list acc p)
|
||||
(hs-morph-parse-children
|
||||
s
|
||||
(get child :end)
|
||||
(append acc (list child)))))))
|
||||
(true
|
||||
(let
|
||||
((r (hs-morph-read-until s p "<")))
|
||||
(hs-morph-parse-children
|
||||
s
|
||||
(nth r 1)
|
||||
(append acc (list {:text (first r) :type "text"})))))))))
|
||||
|
||||
(define
|
||||
hs-morph-apply-attrs
|
||||
(fn
|
||||
(el attrs keep-id)
|
||||
(for-each
|
||||
(fn
|
||||
(av)
|
||||
(let
|
||||
((n (first av)) (v (nth av 1)))
|
||||
(cond
|
||||
((= n "class")
|
||||
(for-each
|
||||
(fn
|
||||
(c)
|
||||
(when (> (string-length c) 0) (dom-add-class el c)))
|
||||
(split v " ")))
|
||||
((and keep-id (= n "id")) nil)
|
||||
(true (dom-set-attr el n v)))))
|
||||
attrs)))
|
||||
|
||||
(define
|
||||
hs-morph-build-children
|
||||
(fn
|
||||
(parent children)
|
||||
(cond
|
||||
((= (len children) 0) nil)
|
||||
((and (= (len children) 1) (= (get (first children) :type) "text"))
|
||||
(dom-set-inner-html parent (get (first children) :text)))
|
||||
(true (for-each (fn (c) (hs-morph-build-child parent c)) children)))))
|
||||
|
||||
(define
|
||||
hs-morph-build-child
|
||||
(fn
|
||||
(parent node)
|
||||
(cond
|
||||
((= (get node :type) "element")
|
||||
(let
|
||||
((el (dom-create-element (get node :tag))))
|
||||
(do
|
||||
(hs-morph-apply-attrs el (get node :attrs) false)
|
||||
(hs-morph-build-children el (get node :children))
|
||||
(dom-append parent el)
|
||||
(hs-activate! el))))
|
||||
(true nil))))
|
||||
|
||||
(define
|
||||
hs-morph!
|
||||
(fn
|
||||
(target content)
|
||||
(when
|
||||
target
|
||||
(let
|
||||
((tree (hs-morph-parse-element content 0)))
|
||||
(when
|
||||
tree
|
||||
(do
|
||||
(hs-morph-apply-attrs target (get tree :attrs) true)
|
||||
(dom-set-inner-html target "")
|
||||
(hs-morph-build-children target (get tree :children))))))))
|
||||
|
||||
(define
|
||||
hs-open!
|
||||
(fn
|
||||
@@ -902,6 +1138,33 @@
|
||||
(e (if (nil? end) (len col) (+ end 1))))
|
||||
(slice col s e))))
|
||||
|
||||
(define
|
||||
hs-pick-first
|
||||
(fn
|
||||
(col n)
|
||||
(let ((m (if (< n (len col)) n (len col)))) (slice col 0 m))))
|
||||
|
||||
(define
|
||||
hs-pick-last
|
||||
(fn
|
||||
(col n)
|
||||
(let
|
||||
((total (len col)))
|
||||
(let
|
||||
((start (if (< n total) (- total n) 0)))
|
||||
(slice col start total)))))
|
||||
|
||||
(define
|
||||
hs-pick-random
|
||||
(fn
|
||||
(col n)
|
||||
(if
|
||||
(nil? n)
|
||||
(first col)
|
||||
(let ((m (if (< n (len col)) n (len col)))) (slice col 0 m)))))
|
||||
|
||||
(define hs-pick-items (fn (col start end) (slice col start end)))
|
||||
|
||||
(define
|
||||
hs-sorted-by
|
||||
(fn
|
||||
@@ -965,3 +1228,117 @@
|
||||
(define
|
||||
hs-sorted-by-desc
|
||||
(fn (col key-fn) (reverse (hs-sorted-by col key-fn))))
|
||||
|
||||
(define
|
||||
hs-dom-has-var?
|
||||
(fn
|
||||
(el name)
|
||||
(if
|
||||
(nil? el)
|
||||
false
|
||||
(let
|
||||
((store (host-get el "__hs_vars")))
|
||||
(if (nil? store) false (has-key? store name))))))
|
||||
|
||||
(define
|
||||
hs-dom-get-var-raw
|
||||
(fn
|
||||
(el name)
|
||||
(let
|
||||
((store (host-get el "__hs_vars")))
|
||||
(if (nil? store) nil (host-get store name)))))
|
||||
|
||||
(define
|
||||
hs-dom-set-var-raw!
|
||||
(fn
|
||||
(el name val)
|
||||
(do
|
||||
(when
|
||||
(nil? (host-get el "__hs_vars"))
|
||||
(host-set! el "__hs_vars" (dict)))
|
||||
(host-set! (host-get el "__hs_vars") name val)
|
||||
(hs-dom-fire-watchers! el name val))))
|
||||
|
||||
(define
|
||||
hs-dom-resolve-start
|
||||
(fn
|
||||
(el)
|
||||
(if
|
||||
(nil? el)
|
||||
nil
|
||||
(let
|
||||
((scope (dom-get-attr el "dom-scope")))
|
||||
(cond
|
||||
((or (nil? scope) (= scope "") (= scope "isolated")) el)
|
||||
((starts-with? scope "closest ")
|
||||
(dom-closest el (slice scope 8 (len scope))))
|
||||
((starts-with? scope "parent of ")
|
||||
(let
|
||||
((match (dom-closest el (slice scope 10 (len scope)))))
|
||||
(if match (dom-parent match) nil)))
|
||||
(true el))))))
|
||||
|
||||
(define
|
||||
hs-dom-walk
|
||||
(fn
|
||||
(el name)
|
||||
(cond
|
||||
((nil? el) nil)
|
||||
((hs-dom-has-var? el name) (hs-dom-get-var-raw el name))
|
||||
((= (dom-get-attr el "dom-scope") "isolated") nil)
|
||||
(true (hs-dom-walk (dom-parent el) name)))))
|
||||
|
||||
(define
|
||||
hs-dom-find-owner
|
||||
(fn
|
||||
(el name)
|
||||
(cond
|
||||
((nil? el) nil)
|
||||
((hs-dom-has-var? el name) el)
|
||||
((= (dom-get-attr el "dom-scope") "isolated") nil)
|
||||
(true (hs-dom-find-owner (dom-parent el) name)))))
|
||||
|
||||
(define
|
||||
hs-dom-get
|
||||
(fn (el name) (hs-dom-walk (hs-dom-resolve-start el) name)))
|
||||
|
||||
(define
|
||||
hs-dom-set!
|
||||
(fn
|
||||
(el name val)
|
||||
(let
|
||||
((start (hs-dom-resolve-start el)))
|
||||
(let
|
||||
((owner (hs-dom-find-owner start name)))
|
||||
(hs-dom-set-var-raw! (if owner owner start) name val)))))
|
||||
|
||||
(define _hs-dom-watchers (list))
|
||||
|
||||
(define
|
||||
hs-dom-watch!
|
||||
(fn
|
||||
(el name handler)
|
||||
(set! _hs-dom-watchers (cons (list el name handler) _hs-dom-watchers))))
|
||||
|
||||
(define
|
||||
hs-dom-fire-watchers!
|
||||
(fn
|
||||
(el name val)
|
||||
(for-each
|
||||
(fn
|
||||
(entry)
|
||||
(when
|
||||
(and
|
||||
(= (nth entry 1) name)
|
||||
(hs-dom-is-ancestor? el (nth entry 0)))
|
||||
((nth entry 2) val)))
|
||||
_hs-dom-watchers)))
|
||||
|
||||
(define
|
||||
hs-dom-is-ancestor?
|
||||
(fn
|
||||
(a b)
|
||||
(cond
|
||||
((nil? b) false)
|
||||
((= a b) true)
|
||||
(true (hs-dom-is-ancestor? a (dom-parent b))))))
|
||||
|
||||
@@ -117,6 +117,7 @@
|
||||
"first"
|
||||
"last"
|
||||
"random"
|
||||
"pick"
|
||||
"empty"
|
||||
"clear"
|
||||
"swap"
|
||||
@@ -173,11 +174,16 @@
|
||||
"default"
|
||||
"halt"
|
||||
"precedes"
|
||||
"precede"
|
||||
"follow"
|
||||
"follows"
|
||||
"ignoring"
|
||||
"case"
|
||||
"changes"
|
||||
"focus"
|
||||
"blur"))
|
||||
"blur"
|
||||
"dom"
|
||||
"morph"))
|
||||
|
||||
(define hs-keyword? (fn (word) (some (fn (k) (= k word)) hs-keywords)))
|
||||
|
||||
@@ -472,6 +478,14 @@
|
||||
(hs-advance! 1)
|
||||
(hs-emit! "attr" (read-ident pos) start)
|
||||
(scan!))
|
||||
(and
|
||||
(= ch "^")
|
||||
(< (+ pos 1) src-len)
|
||||
(hs-ident-char? (hs-peek 1)))
|
||||
(do
|
||||
(hs-advance! 1)
|
||||
(hs-emit! "hat" (read-ident pos) start)
|
||||
(scan!))
|
||||
(and
|
||||
(= ch "~")
|
||||
(< (+ pos 1) src-len)
|
||||
|
||||
Reference in New Issue
Block a user