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:
@@ -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))))))
|
||||
|
||||
Reference in New Issue
Block a user