diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml index 14e2563e..038ba6f4 100644 --- a/hosts/ocaml/bin/run_tests.ml +++ b/hosts/ocaml/bin/run_tests.ml @@ -1985,12 +1985,26 @@ let run_spec_tests env test_files = Hashtbl.replace r "right" (Number 100.0); Hashtbl.replace r "bottom" (Number 100.0); Dict r | "insertAdjacentHTML" -> - (* Simplified: coerce value to string and append to innerHTML *) + (* Position-aware insertion, coerce value to string *) (match rest with - | [String _pos; value] -> + | [String pos; value] -> let html = match dom_stringify value with String s -> s | _ -> "" in let cur = match Hashtbl.find_opt d "innerHTML" with Some (String s) -> s | _ -> "" in - Hashtbl.replace d "innerHTML" (String (cur ^ html)); Nil + let new_html = match pos with + | "afterbegin" -> html ^ cur (* prepend *) + | _ -> cur ^ html (* beforeend / default: append *) + in + Hashtbl.replace d "innerHTML" (String new_html); + (* Sync textContent *) + let buf = Buffer.create (String.length new_html) in + let in_tag = ref false in + String.iter (fun c -> + if c = '<' then in_tag := true + else if c = '>' then in_tag := false + else if not !in_tag then Buffer.add_char buf c + ) new_html; + Hashtbl.replace d "textContent" (String (Buffer.contents buf)); + Nil | _ -> Nil) | "showModal" | "show" -> Hashtbl.replace d "open" (Bool true); diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index 85148e37..8512f149 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -856,6 +856,12 @@ (quote dom-add-class) (hs-to-sx raw-tgt) (nth ast 1))))) + ((= head (quote set-style)) + (list + (quote dom-set-style) + (hs-to-sx (nth ast 3)) + (nth ast 1) + (nth ast 2))) ((= head (quote multi-add-class)) (let ((target (hs-to-sx (nth ast 1))) diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index 8bb9546a..e854e59f 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -775,50 +775,62 @@ parse-add-cmd (fn () - (if - (= (tp-type) "class") - (let - ((cls (get (adv!) "value")) (extra-classes (list))) - (define - collect-classes! - (fn - () - (when - (= (tp-type) "class") - (set! - extra-classes - (append extra-classes (list (get (adv!) "value")))) - (collect-classes!)))) - (collect-classes!) + (cond + ((= (tp-type) "class") (let - ((tgt (parse-tgt-kw "to" (list (quote me))))) + ((cls (get (adv!) "value")) (extra-classes (list))) + (define + collect-classes! + (fn + () + (when + (= (tp-type) "class") + (set! + extra-classes + (append extra-classes (list (get (adv!) "value")))) + (collect-classes!)))) + (collect-classes!) (let - ((when-clause (if (match-kw "when") (parse-expr) nil))) - (if - (empty? extra-classes) + ((tgt (if (match-kw "to") (parse-expr) (list (quote me))))) + (let + ((when-clause (if (match-kw "when") (parse-expr) nil))) (if - when-clause - (list (quote add-class-when) cls tgt when-clause) - (list (quote add-class) cls tgt)) - (if - when-clause - (list - (quote multi-add-class-when) - tgt + (empty? extra-classes) + (if when-clause - cls - extra-classes) - (cons - (quote multi-add-class) - (cons tgt (cons cls extra-classes)))))))) - (let - ((value (parse-expr))) - (if - (match-kw "to") + (list (quote add-class-when) cls tgt when-clause) + (list (quote add-class) cls tgt)) + (if + when-clause + (list + (quote multi-add-class-when) + tgt + when-clause + cls + extra-classes) + (cons + (quote multi-add-class) + (cons tgt (cons cls extra-classes))))))))) + ((= (tp-type) "style") + (let + ((prop (get (adv!) "value")) + (value + (if + (= (tp-type) "local") + (get (adv!) "value") + (parse-expr)))) (let - ((tgt (parse-expr))) - (list (quote add-value) value tgt)) - nil))))) + ((tgt (if (match-kw "to") (parse-expr) (list (quote me))))) + (list (quote set-style) prop value tgt)))) + (true + (let + ((value (parse-expr))) + (if + (match-kw "to") + (let + ((tgt (parse-expr))) + (list (quote add-value) value tgt)) + nil)))))) (define parse-remove-cmd (fn @@ -1050,17 +1062,19 @@ ((match-kw "after") (list (quote put!) value "after" (parse-expr))) ((match-kw "at") - (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))))) + (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