HS: fix empty/halt/morph/reset/dialog — 17 upstream tests pass
- parser `empty` no-target → (ref "me") (was bogus (sym "me")) - parser `halt` modes distinguish: "all"/"bubbling"/"default" halt execution (raise hs-return), "the-event"/"the event's" only stop propagation/default. "'s" now matched as op token, not keyword. - parser `get` cmd: dispatch + cmd-kw list + parse-get-cmd (parses expr with optional `as TYPE`). Required for `get result as JSON` in fetch chains. - compiler empty-target for (local X): emit (set! X (hs-empty-like X)) so arrays/sets/maps clear the variable, not call DOM empty on the value. - runtime hs-empty-like: container-of-same-type empty value. - runtime hs-empty-target!: drop dead FORM branch that was short-circuiting to innerHTML=""; the querySelectorAll-over-inputs branch now runs. - runtime hs-halt!: take ev param (was free `event` lookup); raise hs-return to stop execution unless mode is "the-event". - runtime hs-reset!: type-aware — FORM → reset, INPUT/TEXTAREA → value/checked from defaults, SELECT → defaultSelected option. - runtime hs-open!/hs-close!: toggle `open` attribute on details elements (not just the prop) so dom-has-attr? assertions work. - runtime hs-coerce JSON: json-stringify dict/list (was str). - test-runner mock: host-get on List + "length"/"size" (was only Dict); dom-set-attr tracks defaultChecked / defaultSelected / defaultValue; mock_query_all supports comma-separated selector groups. - generator: emit boolean attrs (checked/selected/etc) even with null value; drop overcautious "skip HS with bare quotes or embedded HTML" guard so morph tests (source contains embedded <div>) emit properly. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1637,6 +1637,20 @@ let run_spec_tests env test_files =
|
||||
in
|
||||
|
||||
let rec mock_query_all el sel =
|
||||
(* Handle comma-separated selector groups: "a, b, c" *)
|
||||
if String.contains sel ',' then
|
||||
let parts = String.split_on_char ',' sel
|
||||
|> List.map String.trim
|
||||
|> List.filter (fun s -> String.length s > 0) in
|
||||
let seen = ref [] in
|
||||
List.concat_map (fun part ->
|
||||
let results = mock_query_all el part in
|
||||
List.filter (fun r ->
|
||||
if List.memq r !seen then false
|
||||
else (seen := r :: !seen; true)
|
||||
) results
|
||||
) parts
|
||||
else
|
||||
match split_selector sel with
|
||||
| [single] -> mock_query_all_single el single
|
||||
| first :: rest ->
|
||||
@@ -1705,6 +1719,11 @@ let run_spec_tests env test_files =
|
||||
| [Nil; _] -> Nil
|
||||
| [String s; String "length"] -> Number (float_of_int (String.length s))
|
||||
| [List l; String "length"] -> Number (float_of_int (List.length l))
|
||||
| [ListRef { contents = l }; String "length"] -> Number (float_of_int (List.length l))
|
||||
| [List l; String "size"] -> Number (float_of_int (List.length l))
|
||||
| [ListRef { contents = l }; String "size"] -> Number (float_of_int (List.length l))
|
||||
| [Dict d; String "size"] when not (Hashtbl.mem d "__mock_type") ->
|
||||
Number (float_of_int (Hashtbl.length d))
|
||||
| [Dict d; String key] ->
|
||||
let mt = match Hashtbl.find_opt d "__mock_type" with Some (String t) -> t | _ -> "" in
|
||||
(* classList.length *)
|
||||
@@ -1789,6 +1808,18 @@ let run_spec_tests env test_files =
|
||||
| Bool false -> String "false"
|
||||
| List l -> String (String.concat "," (List.map (fun v -> match dom_stringify v with String s -> s | _ -> "") l))
|
||||
| Nil -> String ""
|
||||
| Dict d ->
|
||||
(* Avoid `inspect` on circular mock-DOM dicts. Prefer outerHTML, fall
|
||||
back to a tag placeholder, then "[object Object]". *)
|
||||
(match Hashtbl.find_opt d "outerHTML" with
|
||||
| Some (String s) when String.length s > 0 -> String s
|
||||
| _ ->
|
||||
(match Hashtbl.find_opt d "__mock_type" with
|
||||
| Some (String "element") ->
|
||||
let tag = match Hashtbl.find_opt d "tagName" with
|
||||
| Some (String t) -> String.lowercase_ascii t | _ -> "div" in
|
||||
String ("<" ^ tag ^ ">")
|
||||
| _ -> String "[object Object]"))
|
||||
| v -> String (Sx_types.inspect v)
|
||||
in
|
||||
|
||||
@@ -1980,6 +2011,21 @@ let run_spec_tests env test_files =
|
||||
Hashtbl.replace d "className" (String sv);
|
||||
end;
|
||||
if name = "disabled" then Hashtbl.replace d "disabled" (Bool true);
|
||||
if name = "checked" then begin
|
||||
Hashtbl.replace d "defaultChecked" (Bool true);
|
||||
Hashtbl.replace d "checked" (Bool true);
|
||||
end;
|
||||
if name = "selected" then begin
|
||||
Hashtbl.replace d "defaultSelected" (Bool true);
|
||||
Hashtbl.replace d "selected" (Bool true);
|
||||
end;
|
||||
if name = "value" then begin
|
||||
(match Hashtbl.find_opt d "defaultValue" with
|
||||
| Some _ -> ()
|
||||
| None -> Hashtbl.replace d "defaultValue" (String sv));
|
||||
Hashtbl.replace d "value" (String sv);
|
||||
end;
|
||||
if name = "type" then Hashtbl.replace d "type" (String sv);
|
||||
if name = "style" then begin
|
||||
(* Parse CSS string into the style sub-dict *)
|
||||
let style_d = match Hashtbl.find_opt d "style" with Some (Dict s) -> s | _ ->
|
||||
@@ -2543,6 +2589,11 @@ let run_spec_tests env test_files =
|
||||
ignore (Sx_types.env_bind env "console-log" (NativeFn ("console-log", fun _ -> Nil)));
|
||||
ignore (Sx_types.env_bind env "console-debug" (NativeFn ("console-debug", fun _ -> Nil)));
|
||||
ignore (Sx_types.env_bind env "console-error" (NativeFn ("console-error", fun _ -> Nil)));
|
||||
(* promiseAString / promiseAnInt: upstream hyperscript tests use these to
|
||||
exercise promise awaiting. In the synchronous mock environment they
|
||||
resolve immediately to the expected value. *)
|
||||
ignore (Sx_types.env_bind env "promiseAString" (NativeFn ("promiseAString", fun _ -> String "foo")));
|
||||
ignore (Sx_types.env_bind env "promiseAnInt" (NativeFn ("promiseAnInt", fun _ -> Number 42.0)));
|
||||
(* eval-hs: compile hyperscript source to SX and evaluate it.
|
||||
Used by eval-only behavioral tests (comparisonOperator, mathOperator, etc.).
|
||||
Accepts optional ctx dict: {:me V :locals {:x V :y V ...}}. Catches
|
||||
|
||||
@@ -23,14 +23,48 @@
|
||||
((th (first target)))
|
||||
(cond
|
||||
((= th dot-sym)
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(hs-to-sx (nth target 1))
|
||||
(nth target 2)
|
||||
value))
|
||||
(let
|
||||
((base-ast (nth target 1)) (prop (nth target 2)))
|
||||
(cond
|
||||
((and (list? base-ast) (= (first base-ast) (quote query)) (let ((s (nth base-ast 1))) (and (string? s) (> (len s) 0) (= (substring s 0 1) "."))))
|
||||
(list
|
||||
(quote for-each)
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote __hs-el))
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(quote __hs-el)
|
||||
prop
|
||||
value))
|
||||
(list (quote hs-query-all) (nth base-ast 1))))
|
||||
((and (list? base-ast) (= (first base-ast) dot-sym) (let ((inner (nth base-ast 1))) (and (list? inner) (= (first inner) (quote query)) (let ((s (nth inner 1))) (and (string? s) (> (len s) 0) (= (substring s 0 1) "."))))))
|
||||
(let
|
||||
((inner (nth base-ast 1))
|
||||
(mid-prop (nth base-ast 2)))
|
||||
(list
|
||||
(quote for-each)
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote __hs-el))
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(list
|
||||
(quote host-get)
|
||||
(quote __hs-el)
|
||||
mid-prop)
|
||||
prop
|
||||
value))
|
||||
(list (quote hs-query-all) (nth inner 1)))))
|
||||
(true
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(hs-to-sx base-ast)
|
||||
prop
|
||||
value)))))
|
||||
((= th (quote attr))
|
||||
(list
|
||||
(quote dom-set-attr)
|
||||
(quote hs-set-attr!)
|
||||
(hs-to-sx (nth target 2))
|
||||
(nth target 1)
|
||||
value))
|
||||
@@ -84,7 +118,7 @@
|
||||
(list? prop-ast)
|
||||
(= (first prop-ast) (quote attr)))
|
||||
(list
|
||||
(quote dom-set-attr)
|
||||
(quote hs-set-attr!)
|
||||
(hs-to-sx obj-ast)
|
||||
(nth prop-ast 1)
|
||||
value)
|
||||
@@ -323,56 +357,120 @@
|
||||
(cond
|
||||
((and (list? expr) (= (first expr) (quote attr)))
|
||||
(let
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me))))
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
|
||||
(attr-name (nth expr 1)))
|
||||
(list
|
||||
(quote dom-set-attr)
|
||||
el
|
||||
(nth expr 1)
|
||||
(quote let)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote dom-get-attr) el (nth expr 1)))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote dom-get-attr) el attr-name))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote dom-set-attr) el attr-name (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) dot-sym))
|
||||
(let
|
||||
((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
|
||||
(list
|
||||
(quote host-set!)
|
||||
obj
|
||||
prop
|
||||
(quote let)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote host-get) obj prop))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) obj prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote host-set!) 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)))
|
||||
(prop (nth expr 1)))
|
||||
(list
|
||||
(quote dom-set-style)
|
||||
el
|
||||
prop
|
||||
(quote let)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote dom-get-style) el prop))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote dom-get-style) el prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote dom-set-style) el prop (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) (quote dom-ref)))
|
||||
(let
|
||||
((el (hs-to-sx (nth expr 2))) (name (nth expr 1)))
|
||||
(list
|
||||
(quote hs-dom-set!)
|
||||
el
|
||||
name
|
||||
(list (quote +) (list (quote hs-dom-get) el name) amount))))
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote hs-dom-get) el name))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote hs-dom-set!) el name (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) (quote array-index)) (list? (nth expr 1)) (= (first (nth expr 1)) (quote ref)))
|
||||
(let
|
||||
((var-sym (make-symbol (nth (nth expr 1) 1)))
|
||||
(idx (hs-to-sx (nth expr 2))))
|
||||
(list
|
||||
(quote let)
|
||||
(list (list (quote __hs-idx) idx))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote nth) var-sym (quote __hs-idx)))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list
|
||||
(quote set!)
|
||||
var-sym
|
||||
(list
|
||||
(quote hs-list-set)
|
||||
var-sym
|
||||
(quote __hs-idx)
|
||||
(quote __hs-new)))
|
||||
(list (quote set!) (quote it) (quote __hs-new)))))))
|
||||
(true
|
||||
(let
|
||||
((t (hs-to-sx expr)))
|
||||
(list (quote set!) t (list (quote +) t amount)))))))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list (quote +) (list (quote hs-to-number) t) amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote set!) t (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new)))))))))
|
||||
(define
|
||||
emit-dec
|
||||
(fn
|
||||
@@ -380,56 +478,120 @@
|
||||
(cond
|
||||
((and (list? expr) (= (first expr) (quote attr)))
|
||||
(let
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me))))
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
|
||||
(attr-name (nth expr 1)))
|
||||
(list
|
||||
(quote dom-set-attr)
|
||||
el
|
||||
(nth expr 1)
|
||||
(quote let)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote dom-get-attr) el (nth expr 1)))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote dom-get-attr) el attr-name))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote dom-set-attr) el attr-name (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) dot-sym))
|
||||
(let
|
||||
((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
|
||||
(list
|
||||
(quote host-set!)
|
||||
obj
|
||||
prop
|
||||
(quote let)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote host-get) obj prop))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) obj prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote host-set!) 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)))
|
||||
(prop (nth expr 1)))
|
||||
(list
|
||||
(quote dom-set-style)
|
||||
el
|
||||
prop
|
||||
(quote let)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote dom-get-style) el prop))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote dom-get-style) el prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote dom-set-style) el prop (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) (quote dom-ref)))
|
||||
(let
|
||||
((el (hs-to-sx (nth expr 2))) (name (nth expr 1)))
|
||||
(list
|
||||
(quote hs-dom-set!)
|
||||
el
|
||||
name
|
||||
(list (quote -) (list (quote hs-dom-get) el name) amount))))
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote hs-dom-get) el name))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote hs-dom-set!) el name (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) (quote array-index)) (list? (nth expr 1)) (= (first (nth expr 1)) (quote ref)))
|
||||
(let
|
||||
((var-sym (make-symbol (nth (nth expr 1) 1)))
|
||||
(idx (hs-to-sx (nth expr 2))))
|
||||
(list
|
||||
(quote let)
|
||||
(list (list (quote __hs-idx) idx))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote nth) var-sym (quote __hs-idx)))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list
|
||||
(quote set!)
|
||||
var-sym
|
||||
(list
|
||||
(quote hs-list-set)
|
||||
var-sym
|
||||
(quote __hs-idx)
|
||||
(quote __hs-new)))
|
||||
(list (quote set!) (quote it) (quote __hs-new)))))))
|
||||
(true
|
||||
(let
|
||||
((t (hs-to-sx expr)))
|
||||
(list (quote set!) t (list (quote -) t amount)))))))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list (quote -) (list (quote hs-to-number) t) amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote set!) t (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new)))))))))
|
||||
(define
|
||||
emit-behavior
|
||||
(fn
|
||||
@@ -1009,7 +1171,15 @@
|
||||
(hs-to-sx tgt)
|
||||
(list (quote hs-remove-from!) val (hs-to-sx tgt)))))
|
||||
((= head (quote empty-target))
|
||||
(list (quote hs-empty-target!) (hs-to-sx (nth ast 1))))
|
||||
(let
|
||||
((tgt (nth ast 1)))
|
||||
(if
|
||||
(and (list? tgt) (= (first tgt) (quote local)))
|
||||
(list
|
||||
(quote set!)
|
||||
(make-symbol (nth tgt 1))
|
||||
(list (quote hs-empty-like) (make-symbol (nth tgt 1))))
|
||||
(list (quote hs-empty-target!) (hs-to-sx tgt)))))
|
||||
((= head (quote open-element))
|
||||
(list (quote hs-open!) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote close-element))
|
||||
@@ -1160,6 +1330,9 @@
|
||||
(or
|
||||
(= (first c) (quote hs-fetch))
|
||||
(= (first c) (quote hs-wait))
|
||||
(= (first c) (quote hs-wait-for))
|
||||
(= (first c) (quote hs-query-first))
|
||||
(= (first c) (quote hs-query-all))
|
||||
(= (first c) (quote perform)))))
|
||||
compiled))
|
||||
(reduce
|
||||
@@ -1486,7 +1659,8 @@
|
||||
(hs-to-sx (nth ast 1))
|
||||
(list (quote fn) (list) (hs-to-sx (nth (nth ast 2) 2)))
|
||||
(nth ast 3)))
|
||||
((= head (quote halt!)) (list (quote hs-halt!) (nth ast 1)))
|
||||
((= head (quote halt!))
|
||||
(list (quote hs-halt!) (quote event) (nth ast 1)))
|
||||
((= head (quote focus!))
|
||||
(list (quote dom-focus) (hs-to-sx (nth ast 1))))
|
||||
(true ast))))))))
|
||||
|
||||
@@ -1205,14 +1205,33 @@
|
||||
(adv!)
|
||||
(let
|
||||
((source (if (match-kw "from") (parse-expr) nil)))
|
||||
(if
|
||||
source
|
||||
(list (quote wait-for) event-name :from source)
|
||||
(list (quote wait-for) event-name)))))
|
||||
(let
|
||||
((timeout-dur (if (match-kw "or") (if (= (tp-type) "number") (let ((tok (adv!))) (let ((raw (get tok "value")) (suffix (if (and (= (tp-type) "ident") (or (= (tp-val) "ms") (= (tp-val) "s"))) (get (adv!) "value") ""))) (parse-dur (str raw suffix)))) nil) nil)))
|
||||
(cond
|
||||
((and source timeout-dur)
|
||||
(list
|
||||
(quote wait-for)
|
||||
event-name
|
||||
:from source
|
||||
:or timeout-dur))
|
||||
(source
|
||||
(list (quote wait-for) event-name :from source))
|
||||
(timeout-dur
|
||||
(list (quote wait-for) event-name :or timeout-dur))
|
||||
(true (list (quote wait-for) event-name)))))))
|
||||
((= (tp-type) "number")
|
||||
(let
|
||||
((tok (adv!)))
|
||||
(list (quote wait) (parse-dur (get tok "value")))))
|
||||
(let
|
||||
((raw (get tok "value"))
|
||||
(suffix
|
||||
(if
|
||||
(and
|
||||
(= (tp-type) "ident")
|
||||
(or (= (tp-val) "ms") (= (tp-val) "s")))
|
||||
(get (adv!) "value")
|
||||
"")))
|
||||
(list (quote wait) (parse-dur (str raw suffix))))))
|
||||
(true (list (quote wait) 0)))))
|
||||
(define
|
||||
parse-detail-dict
|
||||
@@ -1337,7 +1356,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (cond ((and (= (tp-type) "ident") (= (tp-val) "element")) (do (adv!) (parse-atom))) ((= (tp-type) "id") (parse-atom)) ((= (tp-type) "class") (parse-atom)) ((= (tp-type) "selector") (parse-atom)) (true nil))))
|
||||
((tgt (cond ((and (= (tp-type) "ident") (= (tp-val) "element")) (do (adv!) (parse-atom))) ((and (= (tp-type) "keyword") (= (tp-val) "its")) (do (adv!) (list (quote ref) "it"))) ((= (tp-type) "id") (parse-atom)) ((= (tp-type) "class") (parse-atom)) ((= (tp-type) "selector") (parse-atom)) (true nil))))
|
||||
(define
|
||||
parse-one-transition
|
||||
(fn
|
||||
@@ -1473,18 +1492,7 @@
|
||||
(if (= (tp-type) "comma") (adv!) nil)
|
||||
(ca-collect (append acc (list arg)))))))
|
||||
(ca-collect (list))))
|
||||
(define
|
||||
parse-call-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((name (get (adv!) "value")))
|
||||
(if
|
||||
(= (tp-type) "paren-open")
|
||||
(let
|
||||
((args (parse-call-args)))
|
||||
(cons (quote call) (cons name args)))
|
||||
(list (quote call) name)))))
|
||||
(define parse-call-cmd (fn () (parse-expr)))
|
||||
(define parse-get-cmd (fn () (parse-expr)))
|
||||
(define
|
||||
parse-take-cmd
|
||||
@@ -1841,7 +1849,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((mode (cond ((match-kw "the") (do (match-kw "event") (match-kw "'s") "event")) ((or (match-kw "default") (and (= (tp-val) "default") (do (adv!) true))) "default") ((or (match-kw "bubbling") (and (= (tp-val) "bubbling") (do (adv!) true))) "bubbling") (true "event"))))
|
||||
((mode (cond ((match-kw "the") (do (match-kw "event") (when (and (= (tp-type) "op") (= (tp-val) "'s")) (adv!)) "the-event")) ((or (match-kw "default") (and (= (tp-val) "default") (do (adv!) true))) "default") ((or (match-kw "bubbling") (and (= (tp-val) "bubbling") (do (adv!) true))) "bubbling") (true "all"))))
|
||||
(list (quote halt!) mode))))
|
||||
(define
|
||||
parse-param-list
|
||||
@@ -1965,7 +1973,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((target (cond ((at-end?) (list (quote sym) "me")) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote sym) "me")) (true (parse-expr)))))
|
||||
((target (cond ((at-end?) (list (quote ref) "me")) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote ref) "me")) (true (parse-expr)))))
|
||||
(list (quote empty-target) target))))
|
||||
(define
|
||||
parse-swap-cmd
|
||||
|
||||
@@ -156,26 +156,77 @@
|
||||
(dom-set-attr target name ""))))))))
|
||||
|
||||
;; First element matching selector within a scope.
|
||||
(define
|
||||
hs-put!
|
||||
(fn
|
||||
(value pos target)
|
||||
(cond
|
||||
((= pos "into")
|
||||
(if (list? target) target (dom-set-inner-html target value)))
|
||||
((= pos "before")
|
||||
(dom-insert-adjacent-html target "beforebegin" value))
|
||||
((= pos "after") (dom-insert-adjacent-html target "afterend" value))
|
||||
((= pos "start")
|
||||
(if
|
||||
(list? target)
|
||||
(append! target value 0)
|
||||
(dom-insert-adjacent-html target "afterbegin" value)))
|
||||
((= pos "end")
|
||||
(if
|
||||
(list? target)
|
||||
(append! target value)
|
||||
(dom-insert-adjacent-html target "beforeend" value))))))
|
||||
(begin
|
||||
(define
|
||||
hs-element?
|
||||
(fn
|
||||
(v)
|
||||
(and v (or (host-get v "nodeType") (host-get v "__mock_type")))))
|
||||
(define
|
||||
hs-set-attr!
|
||||
(fn
|
||||
(el name val)
|
||||
(if (nil? val) (dom-remove-attr el name) (dom-set-attr el name val))))
|
||||
(define
|
||||
hs-put!
|
||||
(fn
|
||||
(value pos 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)))))))))
|
||||
|
||||
;; Last element matching selector.
|
||||
(define
|
||||
@@ -228,16 +279,22 @@
|
||||
(define
|
||||
hs-halt!
|
||||
(fn
|
||||
(mode)
|
||||
(when
|
||||
event
|
||||
(cond
|
||||
((= mode "default") (host-call event "preventDefault"))
|
||||
((= mode "bubbling") (host-call event "stopPropagation"))
|
||||
(true
|
||||
(do
|
||||
(host-call event "preventDefault")
|
||||
(host-call event "stopPropagation")))))))
|
||||
(ev mode)
|
||||
(do
|
||||
(when
|
||||
ev
|
||||
(cond
|
||||
((= mode "default") (host-call ev "preventDefault"))
|
||||
((= mode "bubbling") (host-call ev "stopPropagation"))
|
||||
((= mode "the-event")
|
||||
(do
|
||||
(host-call ev "preventDefault")
|
||||
(host-call ev "stopPropagation")))
|
||||
(true
|
||||
(do
|
||||
(host-call ev "preventDefault")
|
||||
(host-call ev "stopPropagation")))))
|
||||
(when (not (= mode "the-event")) (raise (list "hs-return" nil))))))
|
||||
|
||||
;; ── Type coercion ───────────────────────────────────────────────
|
||||
|
||||
@@ -249,7 +306,51 @@
|
||||
|
||||
;; Make a new object of a given type.
|
||||
;; (hs-make type-name) — creates empty object/collection
|
||||
(define hs-reset! (fn (target) (host-call target "reset" (list))))
|
||||
(define
|
||||
hs-reset!
|
||||
(fn
|
||||
(target)
|
||||
(cond
|
||||
((list? target) (for-each (fn (el) (hs-reset! el)) target))
|
||||
((nil? target) nil)
|
||||
(true
|
||||
(let
|
||||
((tag (dom-get-prop target "tagName")))
|
||||
(cond
|
||||
((= tag "FORM") (host-call target "reset" (list)))
|
||||
((or (= tag "INPUT") (= tag "TEXTAREA"))
|
||||
(let
|
||||
((input-type (dom-get-prop target "type")))
|
||||
(cond
|
||||
((or (= input-type "checkbox") (= input-type "radio"))
|
||||
(dom-set-prop
|
||||
target
|
||||
"checked"
|
||||
(dom-get-prop target "defaultChecked")))
|
||||
(true
|
||||
(dom-set-prop
|
||||
target
|
||||
"value"
|
||||
(dom-get-prop target "defaultValue"))))))
|
||||
((= tag "SELECT")
|
||||
(let
|
||||
((options (host-call target "querySelectorAll" "option"))
|
||||
(default-val nil))
|
||||
(do
|
||||
(for-each
|
||||
(fn
|
||||
(opt)
|
||||
(when
|
||||
(and
|
||||
(nil? default-val)
|
||||
(dom-get-prop opt "defaultSelected"))
|
||||
(set! default-val (dom-get-prop opt "value"))))
|
||||
options)
|
||||
(when
|
||||
(and (nil? default-val) (> (len options) 0))
|
||||
(set! default-val (dom-get-prop (first options) "value")))
|
||||
(when default-val (dom-set-prop target "value" default-val)))))
|
||||
(true nil)))))))
|
||||
|
||||
;; ── Behavior installation ───────────────────────────────────────
|
||||
|
||||
@@ -306,6 +407,20 @@
|
||||
hs-query-all
|
||||
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
|
||||
|
||||
(define
|
||||
hs-list-set
|
||||
(fn (lst idx val) (map-indexed (fn (i x) (if (= i idx) val x)) lst)))
|
||||
|
||||
(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)))))
|
||||
|
||||
(define
|
||||
hs-query-first
|
||||
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
||||
@@ -387,6 +502,10 @@
|
||||
(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
|
||||
@@ -419,17 +538,14 @@
|
||||
(define
|
||||
hs-append!
|
||||
(fn (value target) (dom-insert-adjacent-html target "beforeend" value))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
(define
|
||||
hs-fetch
|
||||
(fn
|
||||
(url format)
|
||||
(perform (list "io-fetch" url (if format format "text")))))
|
||||
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
(define
|
||||
hs-coerce
|
||||
(fn
|
||||
@@ -520,8 +636,7 @@
|
||||
(map (fn (k) (list k (get value k))) (keys value))
|
||||
value))
|
||||
(true value))))
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
;; Method dispatch — obj.method(args)
|
||||
(define
|
||||
hs-add
|
||||
(fn
|
||||
@@ -531,7 +646,9 @@
|
||||
((list? b) (cons a b))
|
||||
((or (string? a) (string? b)) (str a b))
|
||||
(true (+ a b)))))
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
(define
|
||||
hs-make
|
||||
(fn
|
||||
@@ -542,15 +659,13 @@
|
||||
((= type-name "Set") (list))
|
||||
((= type-name "Map") (dict))
|
||||
(true (dict)))))
|
||||
;; Method dispatch — obj.method(args)
|
||||
;; Property-based is — check obj.key truthiness
|
||||
(define hs-install (fn (behavior-fn) (behavior-fn me)))
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
;; Array slicing (inclusive both ends)
|
||||
(define
|
||||
hs-measure
|
||||
(fn (target) (perform (list (quote io-measure) target))))
|
||||
;; Property-based is — check obj.key truthiness
|
||||
;; Collection: sorted by
|
||||
(define
|
||||
hs-transition
|
||||
(fn
|
||||
@@ -563,7 +678,7 @@
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop value)
|
||||
(when duration (hs-settle target))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
;; Collection: sorted by descending
|
||||
(define
|
||||
hs-transition-from
|
||||
(fn
|
||||
@@ -577,7 +692,7 @@
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop (str to-val))
|
||||
(when duration (hs-settle target))))
|
||||
;; Collection: sorted by
|
||||
;; Collection: split by
|
||||
(define
|
||||
hs-type-check
|
||||
(fn
|
||||
@@ -597,17 +712,17 @@
|
||||
(= (host-typeof value) "element")
|
||||
(= (host-typeof value) "text")))
|
||||
(true (= (host-typeof value) (downcase type-name)))))))
|
||||
;; Collection: sorted by descending
|
||||
;; Collection: joined by
|
||||
(define
|
||||
hs-type-check-strict
|
||||
(fn
|
||||
(value type-name)
|
||||
(if (nil? value) false (hs-type-check value type-name))))
|
||||
;; Collection: split by
|
||||
|
||||
(define
|
||||
hs-strict-eq
|
||||
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
|
||||
;; Collection: joined by
|
||||
|
||||
(define
|
||||
hs-eq-ignore-case
|
||||
(fn (a b) (= (downcase (str a)) (downcase (str b)))))
|
||||
@@ -738,6 +853,17 @@
|
||||
((dict? v) (= (len (keys v)) 0))
|
||||
(true false))))
|
||||
|
||||
(define
|
||||
hs-empty-like
|
||||
(fn
|
||||
(v)
|
||||
(cond
|
||||
((list? v) (list))
|
||||
((dict? v) (dict))
|
||||
((string? v) "")
|
||||
((nil? v) nil)
|
||||
(true v))))
|
||||
|
||||
(define
|
||||
hs-empty-target!
|
||||
(fn
|
||||
@@ -756,7 +882,6 @@
|
||||
(or (= input-type "checkbox") (= input-type "radio"))
|
||||
(dom-set-prop target "checked" false)
|
||||
(dom-set-prop target "value" ""))))
|
||||
((= tag "FORM") (dom-set-inner-html target ""))
|
||||
((= tag "FORM")
|
||||
(let
|
||||
((children (host-call target "querySelectorAll" "input, textarea, select")))
|
||||
@@ -981,10 +1106,10 @@
|
||||
(el)
|
||||
(let
|
||||
((tag (dom-get-prop el "tagName")))
|
||||
(if
|
||||
(= tag "DIALOG")
|
||||
(host-call el "showModal")
|
||||
(dom-set-prop el "open" true)))))
|
||||
(cond
|
||||
((= tag "DIALOG") (host-call el "showModal"))
|
||||
(true
|
||||
(do (dom-set-attr el "open" "") (dom-set-prop el "open" true)))))))
|
||||
|
||||
(define
|
||||
hs-close!
|
||||
@@ -992,10 +1117,12 @@
|
||||
(el)
|
||||
(let
|
||||
((tag (dom-get-prop el "tagName")))
|
||||
(if
|
||||
(= tag "DIALOG")
|
||||
(host-call el "close")
|
||||
(dom-set-prop el "open" false)))))
|
||||
(cond
|
||||
((= tag "DIALOG") (host-call el "close"))
|
||||
(true
|
||||
(do
|
||||
(host-call el "removeAttribute" "open")
|
||||
(dom-set-prop el "open" false)))))))
|
||||
|
||||
(define
|
||||
hs-hide!
|
||||
|
||||
@@ -183,7 +183,8 @@
|
||||
"focus"
|
||||
"blur"
|
||||
"dom"
|
||||
"morph"))
|
||||
"morph"
|
||||
"using"))
|
||||
|
||||
(define hs-keyword? (fn (word) (some (fn (k) (= k word)) hs-keywords)))
|
||||
|
||||
|
||||
@@ -23,14 +23,48 @@
|
||||
((th (first target)))
|
||||
(cond
|
||||
((= th dot-sym)
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(hs-to-sx (nth target 1))
|
||||
(nth target 2)
|
||||
value))
|
||||
(let
|
||||
((base-ast (nth target 1)) (prop (nth target 2)))
|
||||
(cond
|
||||
((and (list? base-ast) (= (first base-ast) (quote query)) (let ((s (nth base-ast 1))) (and (string? s) (> (len s) 0) (= (substring s 0 1) "."))))
|
||||
(list
|
||||
(quote for-each)
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote __hs-el))
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(quote __hs-el)
|
||||
prop
|
||||
value))
|
||||
(list (quote hs-query-all) (nth base-ast 1))))
|
||||
((and (list? base-ast) (= (first base-ast) dot-sym) (let ((inner (nth base-ast 1))) (and (list? inner) (= (first inner) (quote query)) (let ((s (nth inner 1))) (and (string? s) (> (len s) 0) (= (substring s 0 1) "."))))))
|
||||
(let
|
||||
((inner (nth base-ast 1))
|
||||
(mid-prop (nth base-ast 2)))
|
||||
(list
|
||||
(quote for-each)
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote __hs-el))
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(list
|
||||
(quote host-get)
|
||||
(quote __hs-el)
|
||||
mid-prop)
|
||||
prop
|
||||
value))
|
||||
(list (quote hs-query-all) (nth inner 1)))))
|
||||
(true
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(hs-to-sx base-ast)
|
||||
prop
|
||||
value)))))
|
||||
((= th (quote attr))
|
||||
(list
|
||||
(quote dom-set-attr)
|
||||
(quote hs-set-attr!)
|
||||
(hs-to-sx (nth target 2))
|
||||
(nth target 1)
|
||||
value))
|
||||
@@ -44,6 +78,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))
|
||||
@@ -55,6 +95,8 @@
|
||||
(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))
|
||||
((= th (quote of))
|
||||
(let
|
||||
((prop-ast (nth target 1)) (obj-ast (nth target 2)))
|
||||
@@ -76,7 +118,7 @@
|
||||
(list? prop-ast)
|
||||
(= (first prop-ast) (quote attr)))
|
||||
(list
|
||||
(quote dom-set-attr)
|
||||
(quote hs-set-attr!)
|
||||
(hs-to-sx obj-ast)
|
||||
(nth prop-ast 1)
|
||||
value)
|
||||
@@ -247,7 +289,14 @@
|
||||
(ast)
|
||||
(let
|
||||
((var-name (nth ast 1))
|
||||
(collection (hs-to-sx (nth ast 2)))
|
||||
(raw-coll (hs-to-sx (nth ast 2)))
|
||||
(collection
|
||||
(if
|
||||
(symbol? raw-coll)
|
||||
(list
|
||||
(quote hs-safe-call)
|
||||
(list (quote fn) (list) raw-coll))
|
||||
raw-coll))
|
||||
(body (hs-to-sx (nth ast 3))))
|
||||
(if
|
||||
(and (> (len ast) 4) (= (nth ast 4) :index))
|
||||
@@ -308,48 +357,120 @@
|
||||
(cond
|
||||
((and (list? expr) (= (first expr) (quote attr)))
|
||||
(let
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me))))
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
|
||||
(attr-name (nth expr 1)))
|
||||
(list
|
||||
(quote dom-set-attr)
|
||||
el
|
||||
(nth expr 1)
|
||||
(quote let)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote dom-get-attr) el (nth expr 1)))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote dom-get-attr) el attr-name))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote dom-set-attr) el attr-name (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) dot-sym))
|
||||
(let
|
||||
((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
|
||||
(list
|
||||
(quote host-set!)
|
||||
obj
|
||||
prop
|
||||
(quote let)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote host-get) obj prop))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) obj prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote host-set!) 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)))
|
||||
(prop (nth expr 1)))
|
||||
(list
|
||||
(quote dom-set-style)
|
||||
el
|
||||
prop
|
||||
(quote let)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote dom-get-style) el prop))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote dom-get-style) el prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote dom-set-style) el prop (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) (quote dom-ref)))
|
||||
(let
|
||||
((el (hs-to-sx (nth expr 2))) (name (nth expr 1)))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote hs-dom-get) el name))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote hs-dom-set!) el name (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) (quote array-index)) (list? (nth expr 1)) (= (first (nth expr 1)) (quote ref)))
|
||||
(let
|
||||
((var-sym (make-symbol (nth (nth expr 1) 1)))
|
||||
(idx (hs-to-sx (nth expr 2))))
|
||||
(list
|
||||
(quote let)
|
||||
(list (list (quote __hs-idx) idx))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote nth) var-sym (quote __hs-idx)))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list
|
||||
(quote set!)
|
||||
var-sym
|
||||
(list
|
||||
(quote hs-list-set)
|
||||
var-sym
|
||||
(quote __hs-idx)
|
||||
(quote __hs-new)))
|
||||
(list (quote set!) (quote it) (quote __hs-new)))))))
|
||||
(true
|
||||
(let
|
||||
((t (hs-to-sx expr)))
|
||||
(list (quote set!) t (list (quote +) t amount)))))))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list (quote +) (list (quote hs-to-number) t) amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote set!) t (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new)))))))))
|
||||
(define
|
||||
emit-dec
|
||||
(fn
|
||||
@@ -357,48 +478,120 @@
|
||||
(cond
|
||||
((and (list? expr) (= (first expr) (quote attr)))
|
||||
(let
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me))))
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
|
||||
(attr-name (nth expr 1)))
|
||||
(list
|
||||
(quote dom-set-attr)
|
||||
el
|
||||
(nth expr 1)
|
||||
(quote let)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote dom-get-attr) el (nth expr 1)))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote dom-get-attr) el attr-name))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote dom-set-attr) el attr-name (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) dot-sym))
|
||||
(let
|
||||
((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
|
||||
(list
|
||||
(quote host-set!)
|
||||
obj
|
||||
prop
|
||||
(quote let)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote host-get) obj prop))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) obj prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote host-set!) 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)))
|
||||
(prop (nth expr 1)))
|
||||
(list
|
||||
(quote dom-set-style)
|
||||
el
|
||||
prop
|
||||
(quote let)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote dom-get-style) el prop))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote dom-get-style) el prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote dom-set-style) el prop (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) (quote dom-ref)))
|
||||
(let
|
||||
((el (hs-to-sx (nth expr 2))) (name (nth expr 1)))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote hs-dom-get) el name))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote hs-dom-set!) el name (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) (quote array-index)) (list? (nth expr 1)) (= (first (nth expr 1)) (quote ref)))
|
||||
(let
|
||||
((var-sym (make-symbol (nth (nth expr 1) 1)))
|
||||
(idx (hs-to-sx (nth expr 2))))
|
||||
(list
|
||||
(quote let)
|
||||
(list (list (quote __hs-idx) idx))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote nth) var-sym (quote __hs-idx)))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list
|
||||
(quote set!)
|
||||
var-sym
|
||||
(list
|
||||
(quote hs-list-set)
|
||||
var-sym
|
||||
(quote __hs-idx)
|
||||
(quote __hs-new)))
|
||||
(list (quote set!) (quote it) (quote __hs-new)))))))
|
||||
(true
|
||||
(let
|
||||
((t (hs-to-sx expr)))
|
||||
(list (quote set!) t (list (quote -) t amount)))))))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list (quote -) (list (quote hs-to-number) t) amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote set!) t (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new)))))))))
|
||||
(define
|
||||
emit-behavior
|
||||
(fn
|
||||
@@ -427,7 +620,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?)) (= head (quote exists?)))
|
||||
((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 +752,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 +880,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 +971,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?)
|
||||
@@ -922,7 +1171,15 @@
|
||||
(hs-to-sx tgt)
|
||||
(list (quote hs-remove-from!) val (hs-to-sx tgt)))))
|
||||
((= head (quote empty-target))
|
||||
(list (quote hs-empty-target!) (hs-to-sx (nth ast 1))))
|
||||
(let
|
||||
((tgt (nth ast 1)))
|
||||
(if
|
||||
(and (list? tgt) (= (first tgt) (quote local)))
|
||||
(list
|
||||
(quote set!)
|
||||
(make-symbol (nth tgt 1))
|
||||
(list (quote hs-empty-like) (make-symbol (nth tgt 1))))
|
||||
(list (quote hs-empty-target!) (hs-to-sx tgt)))))
|
||||
((= head (quote open-element))
|
||||
(list (quote hs-open!) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote close-element))
|
||||
@@ -937,6 +1194,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 +1239,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!)
|
||||
@@ -1051,6 +1330,9 @@
|
||||
(or
|
||||
(= (first c) (quote hs-fetch))
|
||||
(= (first c) (quote hs-wait))
|
||||
(= (first c) (quote hs-wait-for))
|
||||
(= (first c) (quote hs-query-first))
|
||||
(= (first c) (quote hs-query-all))
|
||||
(= (first c) (quote perform)))))
|
||||
compiled))
|
||||
(reduce
|
||||
@@ -1061,7 +1343,7 @@
|
||||
(list (list (quote it) cmd))
|
||||
body))
|
||||
(nth compiled (- (len compiled) 1))
|
||||
(reverse (rest (reverse compiled))))
|
||||
(rest (reverse compiled)))
|
||||
(cons (quote do) compiled))))
|
||||
((= head (quote wait)) (list (quote hs-wait) (nth ast 1)))
|
||||
((= head (quote wait-for)) (emit-wait-for ast))
|
||||
@@ -1194,20 +1476,39 @@
|
||||
((= 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"))
|
||||
((= head (quote exit)) nil)
|
||||
((= 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)
|
||||
@@ -1352,7 +1653,14 @@
|
||||
(quote when)
|
||||
(list (quote nil?) t)
|
||||
(list (quote set!) t v))))
|
||||
((= head (quote halt!)) (list (quote hs-halt!) (nth ast 1)))
|
||||
((= head (quote hs-is))
|
||||
(list
|
||||
(quote hs-is)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(list (quote fn) (list) (hs-to-sx (nth (nth ast 2) 2)))
|
||||
(nth ast 3)))
|
||||
((= head (quote halt!))
|
||||
(list (quote hs-halt!) (quote event) (nth ast 1)))
|
||||
((= head (quote focus!))
|
||||
(list (quote dom-focus) (hs-to-sx (nth ast 1))))
|
||||
(true ast))))))))
|
||||
|
||||
@@ -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)))
|
||||
@@ -288,7 +298,7 @@
|
||||
(adv!)
|
||||
(let
|
||||
((name val) (args (parse-call-args)))
|
||||
(list (quote call) (list (quote ref) name) args))))
|
||||
(cons (quote call) (cons (list (quote ref) name) args)))))
|
||||
(true nil)))))
|
||||
(define
|
||||
parse-poss
|
||||
@@ -301,7 +311,7 @@
|
||||
((= (tp-type) "paren-open")
|
||||
(let
|
||||
((args (parse-call-args)))
|
||||
(list (quote call) obj args)))
|
||||
(cons (quote call) (cons obj args))))
|
||||
((= (tp-type) "bracket-open")
|
||||
(do
|
||||
(adv!)
|
||||
@@ -479,20 +489,24 @@
|
||||
(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)))
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
(if
|
||||
(match-kw "ignoring")
|
||||
(do
|
||||
(match-kw "case")
|
||||
(list (quote eq-ignore-case) left right))
|
||||
(if
|
||||
(match-kw "ignoring")
|
||||
(do
|
||||
(match-kw "case")
|
||||
(list (quote eq-ignore-case) left right))
|
||||
(and
|
||||
(list? right)
|
||||
(= (len right) 2)
|
||||
(= (first right) (quote ref))
|
||||
(string? (nth right 1)))
|
||||
(list
|
||||
(quote hs-is)
|
||||
left
|
||||
(list (quote fn) (list) right)
|
||||
(nth right 1))
|
||||
(list (quote =) left right))))))))
|
||||
((and (= typ "keyword") (= val "am"))
|
||||
(do
|
||||
@@ -504,12 +518,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 +675,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 +921,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 +1141,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 +1154,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
|
||||
@@ -1153,14 +1205,33 @@
|
||||
(adv!)
|
||||
(let
|
||||
((source (if (match-kw "from") (parse-expr) nil)))
|
||||
(if
|
||||
source
|
||||
(list (quote wait-for) event-name :from source)
|
||||
(list (quote wait-for) event-name)))))
|
||||
(let
|
||||
((timeout-dur (if (match-kw "or") (if (= (tp-type) "number") (let ((tok (adv!))) (let ((raw (get tok "value")) (suffix (if (and (= (tp-type) "ident") (or (= (tp-val) "ms") (= (tp-val) "s"))) (get (adv!) "value") ""))) (parse-dur (str raw suffix)))) nil) nil)))
|
||||
(cond
|
||||
((and source timeout-dur)
|
||||
(list
|
||||
(quote wait-for)
|
||||
event-name
|
||||
:from source
|
||||
:or timeout-dur))
|
||||
(source
|
||||
(list (quote wait-for) event-name :from source))
|
||||
(timeout-dur
|
||||
(list (quote wait-for) event-name :or timeout-dur))
|
||||
(true (list (quote wait-for) event-name)))))))
|
||||
((= (tp-type) "number")
|
||||
(let
|
||||
((tok (adv!)))
|
||||
(list (quote wait) (parse-dur (get tok "value")))))
|
||||
(let
|
||||
((raw (get tok "value"))
|
||||
(suffix
|
||||
(if
|
||||
(and
|
||||
(= (tp-type) "ident")
|
||||
(or (= (tp-val) "ms") (= (tp-val) "s")))
|
||||
(get (adv!) "value")
|
||||
"")))
|
||||
(list (quote wait) (parse-dur (str raw suffix))))))
|
||||
(true (list (quote wait) 0)))))
|
||||
(define
|
||||
parse-detail-dict
|
||||
@@ -1241,10 +1312,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 +1326,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
|
||||
@@ -1279,7 +1356,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (cond ((and (= (tp-type) "ident") (= (tp-val) "element")) (do (adv!) (parse-atom))) ((= (tp-type) "id") (parse-atom)) ((= (tp-type) "class") (parse-atom)) ((= (tp-type) "selector") (parse-atom)) (true nil))))
|
||||
((tgt (cond ((and (= (tp-type) "ident") (= (tp-val) "element")) (do (adv!) (parse-atom))) ((and (= (tp-type) "keyword") (= (tp-val) "its")) (do (adv!) (list (quote ref) "it"))) ((= (tp-type) "id") (parse-atom)) ((= (tp-type) "class") (parse-atom)) ((= (tp-type) "selector") (parse-atom)) (true nil))))
|
||||
(define
|
||||
parse-one-transition
|
||||
(fn
|
||||
@@ -1370,11 +1447,13 @@
|
||||
(fn
|
||||
()
|
||||
(if
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "gql"))
|
||||
(and
|
||||
(or (= (tp-type) "keyword") (= (tp-type) "ident"))
|
||||
(= (tp-val) "gql"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((gql-source (if (= (tp-type) "brace-open") (do (adv!) (define collect-gql (fn (acc depth) (cond ((at-end?) (join " " acc)) ((= (tp-type) "brace-open") (do (adv!) (collect-gql (append acc (list "{")) (+ depth 1)))) ((= (tp-type) "brace-close") (if (= depth 0) (do (adv!) (join " " acc)) (do (adv!) (collect-gql (append acc (list "}")) (- depth 1))))) (true (let ((v (tp-val))) (adv!) (collect-gql (append acc (list (if v v ""))) depth)))))) (str "{ " (collect-gql (list) 0) " }")) (if (or (and (= (tp-type) "keyword") (= (tp-val) "query")) (and (= (tp-type) "keyword") (= (tp-val) "mutation")) (and (= (tp-type) "keyword") (= (tp-val) "subscription"))) (let ((op-word (tp-val))) (adv!) (if (= (tp-type) "brace-open") (do (adv!) (define collect-gql2 (fn (acc depth) (cond ((at-end?) (join " " acc)) ((= (tp-type) "brace-open") (do (adv!) (collect-gql2 (append acc (list "{")) (+ depth 1)))) ((= (tp-type) "brace-close") (if (= depth 0) (do (adv!) (join " " acc)) (do (adv!) (collect-gql2 (append acc (list "}")) (- depth 1))))) (true (let ((v (tp-val))) (adv!) (collect-gql2 (append acc (list (if v v ""))) depth)))))) (str op-word " { " (collect-gql2 (list) 0) " }")) (str op-word ""))) ""))))
|
||||
((gql-source (if (= (tp-type) "brace-open") (do (adv!) (define collect-gql (fn (acc depth) (cond ((at-end?) (join " " acc)) ((= (tp-type) "brace-open") (do (adv!) (collect-gql (append acc (list "{")) (+ depth 1)))) ((= (tp-type) "brace-close") (if (= depth 0) (do (adv!) (join " " acc)) (do (adv!) (collect-gql (append acc (list "}")) (- depth 1))))) (true (let ((v (tp-val))) (adv!) (collect-gql (append acc (list (if v v ""))) depth)))))) (str "{ " (collect-gql (list) 0) " }")) (if (or (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "query")) (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "mutation")) (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "subscription"))) (let ((op-word (tp-val))) (adv!) (if (= (tp-type) "brace-open") (do (adv!) (define collect-gql2 (fn (acc depth) (cond ((at-end?) (join " " acc)) ((= (tp-type) "brace-open") (do (adv!) (collect-gql2 (append acc (list "{")) (+ depth 1)))) ((= (tp-type) "brace-close") (if (= depth 0) (do (adv!) (join " " acc)) (do (adv!) (collect-gql2 (append acc (list "}")) (- depth 1))))) (true (let ((v (tp-val))) (adv!) (collect-gql2 (append acc (list (if v v ""))) depth)))))) (str op-word " { " (collect-gql2 (list) 0) " }")) (str op-word ""))) ""))))
|
||||
(let
|
||||
((url (if (and (= (tp-type) "keyword") (= (tp-val) "from")) (do (adv!) (parse-arith (parse-poss (parse-atom)))) nil)))
|
||||
(list (quote fetch-gql) gql-source url))))
|
||||
@@ -1383,7 +1462,7 @@
|
||||
(let
|
||||
((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom)))))
|
||||
(let
|
||||
((fmt-before (if (match-kw "as") (let ((f (tp-val))) (adv!) f) nil)))
|
||||
((fmt-before (if (match-kw "as") (do (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (or (= (tp-val) "an") (= (tp-val) "a"))) (adv!)) (let ((f (tp-val))) (adv!) f)) nil)))
|
||||
(when (= (tp-type) "brace-open") (parse-expr))
|
||||
(when
|
||||
(match-kw "with")
|
||||
@@ -1392,7 +1471,7 @@
|
||||
(parse-expr)
|
||||
(parse-expr)))
|
||||
(let
|
||||
((fmt-after (if (and (not fmt-before) (match-kw "as")) (let ((f (tp-val))) (adv!) f) nil)))
|
||||
((fmt-after (if (and (not fmt-before) (match-kw "as")) (do (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (or (= (tp-val) "an") (= (tp-val) "a"))) (adv!)) (let ((f (tp-val))) (adv!) f)) nil)))
|
||||
(let
|
||||
((fmt (or fmt-before fmt-after "text")))
|
||||
(list (quote fetch) url fmt)))))))))
|
||||
@@ -1413,18 +1492,8 @@
|
||||
(if (= (tp-type) "comma") (adv!) nil)
|
||||
(ca-collect (append acc (list arg)))))))
|
||||
(ca-collect (list))))
|
||||
(define
|
||||
parse-call-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((name (get (adv!) "value")))
|
||||
(if
|
||||
(= (tp-type) "paren-open")
|
||||
(let
|
||||
((args (parse-call-args)))
|
||||
(cons (quote call) (cons name args)))
|
||||
(list (quote call) name)))))
|
||||
(define parse-call-cmd (fn () (parse-expr)))
|
||||
(define parse-get-cmd (fn () (parse-expr)))
|
||||
(define
|
||||
parse-take-cmd
|
||||
(fn
|
||||
@@ -1458,6 +1527,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))))
|
||||
@@ -1683,7 +1849,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((mode (cond ((match-kw "the") (do (match-kw "event") (match-kw "'s") "event")) ((or (match-kw "default") (and (= (tp-val) "default") (do (adv!) true))) "default") ((or (match-kw "bubbling") (and (= (tp-val) "bubbling") (do (adv!) true))) "bubbling") (true "event"))))
|
||||
((mode (cond ((match-kw "the") (do (match-kw "event") (when (and (= (tp-type) "op") (= (tp-val) "'s")) (adv!)) "the-event")) ((or (match-kw "default") (and (= (tp-val) "default") (do (adv!) true))) "default") ((or (match-kw "bubbling") (and (= (tp-val) "bubbling") (do (adv!) true))) "bubbling") (true "all"))))
|
||||
(list (quote halt!) mode))))
|
||||
(define
|
||||
parse-param-list
|
||||
@@ -1807,7 +1973,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((target (cond ((at-end?) (list (quote sym) "me")) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote sym) "me")) (true (parse-expr)))))
|
||||
((target (cond ((at-end?) (list (quote ref) "me")) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote ref) "me")) (true (parse-expr)))))
|
||||
(list (quote empty-target) target))))
|
||||
(define
|
||||
parse-swap-cmd
|
||||
@@ -1817,6 +1983,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
|
||||
@@ -1874,10 +2050,14 @@
|
||||
(do (adv!) (parse-repeat-cmd)))
|
||||
((and (= typ "keyword") (= val "fetch"))
|
||||
(do (adv!) (parse-fetch-cmd)))
|
||||
((and (= typ "keyword") (= val "get"))
|
||||
(do (adv!) (parse-get-cmd)))
|
||||
((and (= typ "keyword") (= val "call"))
|
||||
(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"))
|
||||
@@ -1918,6 +2098,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"))
|
||||
@@ -1955,6 +2137,7 @@
|
||||
(= v "transition")
|
||||
(= v "repeat")
|
||||
(= v "fetch")
|
||||
(= v "get")
|
||||
(= v "call")
|
||||
(= v "take")
|
||||
(= v "settle")
|
||||
@@ -1977,8 +2160,10 @@
|
||||
(= v "empty")
|
||||
(= v "clear")
|
||||
(= v "swap")
|
||||
(= v "morph")
|
||||
(= v "open")
|
||||
(= v "close"))))
|
||||
(= v "close")
|
||||
(= v "pick"))))
|
||||
(define
|
||||
cl-collect
|
||||
(fn
|
||||
@@ -2047,6 +2232,53 @@
|
||||
((body (parse-cmd-list)))
|
||||
(match-kw "end")
|
||||
(list (quote init) body))))
|
||||
(define
|
||||
parse-live-feat
|
||||
(fn
|
||||
()
|
||||
(define
|
||||
plf-skip
|
||||
(fn
|
||||
()
|
||||
(cond
|
||||
((at-end?) nil)
|
||||
((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!) (plf-skip))))))
|
||||
(plf-skip)
|
||||
(match-kw "end")
|
||||
(list (quote live-no-op))))
|
||||
(define
|
||||
parse-when-feat
|
||||
(fn
|
||||
()
|
||||
(define
|
||||
pwf-skip
|
||||
(fn
|
||||
()
|
||||
(cond
|
||||
((at-end?) nil)
|
||||
((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))))))
|
||||
(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
|
||||
@@ -2058,6 +2290,8 @@
|
||||
((= val "init") (do (adv!) (parse-init-feat)))
|
||||
((= val "def") (do (adv!) (parse-def-feat)))
|
||||
((= val "behavior") (do (adv!) (parse-behavior-feat)))
|
||||
((= val "live") (do (adv!) (parse-live-feat)))
|
||||
((= val "when") (do (adv!) (parse-when-feat)))
|
||||
(true (parse-cmd-list))))))
|
||||
(define
|
||||
coll-feats
|
||||
|
||||
@@ -117,6 +117,7 @@
|
||||
"first"
|
||||
"last"
|
||||
"random"
|
||||
"pick"
|
||||
"empty"
|
||||
"clear"
|
||||
"swap"
|
||||
@@ -173,11 +174,17 @@
|
||||
"default"
|
||||
"halt"
|
||||
"precedes"
|
||||
"precede"
|
||||
"follow"
|
||||
"follows"
|
||||
"ignoring"
|
||||
"case"
|
||||
"changes"
|
||||
"focus"
|
||||
"blur"))
|
||||
"blur"
|
||||
"dom"
|
||||
"morph"
|
||||
"using"))
|
||||
|
||||
(define hs-keyword? (fn (word) (some (fn (k) (= k word)) hs-keywords)))
|
||||
|
||||
@@ -472,6 +479,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)
|
||||
|
||||
@@ -23,7 +23,14 @@
|
||||
(let ((sx (hs-to-sx (hs-compile src))))
|
||||
(let ((handler (eval-expr-cek
|
||||
(list (quote fn) (list (quote me)) (list (quote let) (list (list (quote it) nil) (list (quote event) nil)) sx)))))
|
||||
(handler nil)))))
|
||||
(guard
|
||||
(_e
|
||||
(true
|
||||
(if
|
||||
(and (list? _e) (= (first _e) "hs-return"))
|
||||
(nth _e 1)
|
||||
(raise _e))))
|
||||
(handler nil))))))
|
||||
|
||||
;; Evaluate with a specific me value (for "I am between" etc.)
|
||||
(define eval-hs-with-me
|
||||
@@ -31,7 +38,14 @@
|
||||
(let ((sx (hs-to-sx (hs-compile src))))
|
||||
(let ((handler (eval-expr-cek
|
||||
(list (quote fn) (list (quote me)) (list (quote let) (list (list (quote it) nil) (list (quote event) nil)) sx)))))
|
||||
(handler me-val)))))
|
||||
(guard
|
||||
(_e
|
||||
(true
|
||||
(if
|
||||
(and (list? _e) (= (first _e) "hs-return"))
|
||||
(nth _e 1)
|
||||
(raise _e))))
|
||||
(handler me-val))))))
|
||||
|
||||
;; ── add (19 tests) ──
|
||||
(defsuite "hs-upstream-add"
|
||||
@@ -235,6 +249,7 @@
|
||||
(dom-set-attr _el-d1 "id" "d1")
|
||||
(dom-add-class _el-d1 "item")
|
||||
(dom-set-attr _el-none "id" "none")
|
||||
(dom-set-attr _el-none "hidden" "")
|
||||
(dom-append (dom-body) _el-trigger)
|
||||
(dom-append (dom-body) _el-d1)
|
||||
(dom-append (dom-body) _el-none)
|
||||
@@ -365,7 +380,7 @@
|
||||
(dom-append _el-d1 _el-p)
|
||||
(dom-append _el-div _el-p3)
|
||||
(hs-activate! _el-d1)
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
;; SKIP check: skip div.innerHTML.includes("foo").should.equal(true)
|
||||
;; SKIP check: skip div.innerHTML.includes("bar").should.equal(true)
|
||||
;; SKIP check: skip div.innerHTML.includes("doh").should.equal(true)
|
||||
@@ -797,8 +812,8 @@
|
||||
(dom-append (dom-body) _el-div)
|
||||
(dom-append _el-div _el-d1)
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(assert= (dom-inner-html _el-d1) "foo")
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
(assert= (dom-inner-html _el-div) "foo")
|
||||
))
|
||||
(deftest "can set complex indirect properties rhs"
|
||||
(hs-cleanup!)
|
||||
@@ -808,8 +823,8 @@
|
||||
(dom-append (dom-body) _el-div)
|
||||
(dom-append _el-div _el-d1)
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(assert= (dom-inner-html _el-d1) "foo")
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
(assert= (dom-inner-html _el-div) "foo")
|
||||
))
|
||||
(deftest "can set chained indirect properties"
|
||||
(hs-cleanup!)
|
||||
@@ -819,8 +834,8 @@
|
||||
(dom-append (dom-body) _el-div)
|
||||
(dom-append _el-div _el-d1)
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(assert= (dom-inner-html _el-d1) "foo")
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
(assert= (dom-inner-html _el-div) "foo")
|
||||
))
|
||||
(deftest "can set styles"
|
||||
(hs-cleanup!)
|
||||
@@ -1358,8 +1373,8 @@
|
||||
(dom-append (dom-body) _el-div)
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
(assert= (dom-inner-html _el-div) "42")
|
||||
(dom-dispatch (dom-query "button") "click" nil)
|
||||
(assert= (dom-inner-html (dom-query "button")) "42")
|
||||
))
|
||||
(deftest "properly processes hyperscript in new content in a element target"
|
||||
(hs-cleanup!)
|
||||
@@ -1369,8 +1384,8 @@
|
||||
(dom-append (dom-body) _el-d1)
|
||||
(hs-activate! _el-d1)
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(assert= (dom-inner-html _el-d1) "42")
|
||||
(dom-dispatch (dom-query "button") "click" nil)
|
||||
(assert= (dom-inner-html (dom-query "button")) "42")
|
||||
))
|
||||
(deftest "properly processes hyperscript in before"
|
||||
(hs-cleanup!)
|
||||
@@ -1380,8 +1395,8 @@
|
||||
(dom-append (dom-body) _el-d1)
|
||||
(hs-activate! _el-d1)
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(assert= (dom-inner-html _el-d1) "42")
|
||||
(dom-dispatch (dom-query "button") "click" nil)
|
||||
(assert= (dom-inner-html (dom-query "button")) "42")
|
||||
))
|
||||
(deftest "properly processes hyperscript at start of"
|
||||
(hs-cleanup!)
|
||||
@@ -1391,8 +1406,8 @@
|
||||
(dom-append (dom-body) _el-d1)
|
||||
(hs-activate! _el-d1)
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(assert= (dom-inner-html _el-d1) "42")
|
||||
(dom-dispatch (dom-query "button") "click" nil)
|
||||
(assert= (dom-inner-html (dom-query "button")) "42")
|
||||
))
|
||||
(deftest "properly processes hyperscript at end of"
|
||||
(hs-cleanup!)
|
||||
@@ -1402,8 +1417,8 @@
|
||||
(dom-append (dom-body) _el-d1)
|
||||
(hs-activate! _el-d1)
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(assert= (dom-inner-html _el-d1) "42")
|
||||
(dom-dispatch (dom-query "button") "click" nil)
|
||||
(assert= (dom-inner-html (dom-query "button")) "42")
|
||||
))
|
||||
(deftest "properly processes hyperscript after"
|
||||
(hs-cleanup!)
|
||||
@@ -1413,8 +1428,8 @@
|
||||
(dom-append (dom-body) _el-d1)
|
||||
(hs-activate! _el-d1)
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(assert= (dom-inner-html _el-d1) "42")
|
||||
(dom-dispatch (dom-query "button") "click" nil)
|
||||
(assert= (dom-inner-html (dom-query "button")) "42")
|
||||
))
|
||||
(deftest "is null tolerant"
|
||||
(hs-cleanup!)
|
||||
@@ -2324,7 +2339,7 @@
|
||||
(dom-append _el-div _el-d3)
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-d2 "click" nil)
|
||||
(assert (not (dom-has-class? _el-d1 "foo")))
|
||||
(assert (not (dom-has-class? _el-div "foo")))
|
||||
(assert (dom-has-class? _el-d2 "foo"))
|
||||
(assert (not (dom-has-class? _el-d3 "foo")))
|
||||
))
|
||||
@@ -2441,7 +2456,7 @@
|
||||
(dom-append _el-div _el-d3)
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-d2 "click" nil)
|
||||
(assert= (dom-get-attr _el-d1 "data-foo") "bar")
|
||||
(assert= (dom-get-attr _el-div "data-foo") "bar")
|
||||
(assert= (dom-get-attr _el-d2 "data-foo") "")
|
||||
;; SKIP check: skip assert.isNull(d2.getAttribute("data-foo")
|
||||
;; SKIP check: skip assert.isNull(d3.getAttribute("data-foo")
|
||||
@@ -3300,7 +3315,7 @@
|
||||
(dom-append (dom-body) _el-div)
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
(assert (dom-has-class? _el-div "topping"))
|
||||
(assert (dom-has-class? (dom-query "span") "topping"))
|
||||
))
|
||||
(deftest "can append a value to a set"
|
||||
(hs-cleanup!)
|
||||
@@ -4227,6 +4242,7 @@
|
||||
(hs-cleanup!)
|
||||
(let ((_el-d (dom-create-element "details")) (_el-summary (dom-create-element "summary")) (_el-p (dom-create-element "p")) (_el-button (dom-create-element "button")))
|
||||
(dom-set-attr _el-d "id" "d")
|
||||
(dom-set-attr _el-d "open" "")
|
||||
(dom-set-inner-html _el-summary "More")
|
||||
(dom-set-inner-html _el-p "Content")
|
||||
(dom-set-attr _el-button "_" "on click close #d")
|
||||
@@ -4386,6 +4402,7 @@
|
||||
(let ((_el-cb1 (dom-create-element "input")) (_el-button (dom-create-element "button")))
|
||||
(dom-set-attr _el-cb1 "id" "cb1")
|
||||
(dom-set-attr _el-cb1 "type" "checkbox")
|
||||
(dom-set-attr _el-cb1 "checked" "")
|
||||
(dom-set-attr _el-button "_" "on click empty #cb1")
|
||||
(dom-set-inner-html _el-button "Empty")
|
||||
(dom-append (dom-body) _el-cb1)
|
||||
@@ -4401,6 +4418,7 @@
|
||||
(dom-set-attr _el-option "value" "a")
|
||||
(dom-set-inner-html _el-option "A")
|
||||
(dom-set-attr _el-option2 "value" "b")
|
||||
(dom-set-attr _el-option2 "selected" "")
|
||||
(dom-set-inner-html _el-option2 "B")
|
||||
(dom-set-attr _el-button "_" "on click empty #sel1")
|
||||
(dom-set-inner-html _el-button "Empty")
|
||||
@@ -4422,6 +4440,7 @@
|
||||
(dom-set-inner-html _el-ta2 "text")
|
||||
(dom-set-attr _el-cb2 "id" "cb2")
|
||||
(dom-set-attr _el-cb2 "type" "checkbox")
|
||||
(dom-set-attr _el-cb2 "checked" "")
|
||||
(dom-set-attr _el-button "_" "on click empty #f1")
|
||||
(dom-set-inner-html _el-button "Empty")
|
||||
(dom-append (dom-body) _el-f1)
|
||||
@@ -4649,10 +4668,11 @@
|
||||
(let ((_el-target (dom-create-element "div")) (_el-button (dom-create-element "button")))
|
||||
(dom-set-attr _el-target "id" "target")
|
||||
(dom-set-inner-html _el-target "old")
|
||||
;; HS source has bare quotes or embedded HTML
|
||||
(dom-set-attr _el-button "_" "on click morph #target to \"<div id=target>new</div>\"")
|
||||
(dom-set-inner-html _el-button "go")
|
||||
(dom-append (dom-body) _el-target)
|
||||
(dom-append (dom-body) _el-button)
|
||||
(hs-activate! _el-button)
|
||||
(dom-dispatch _el-button "click" nil)
|
||||
(assert= (dom-text-content (dom-query-by-id "target")) "new")
|
||||
))
|
||||
@@ -4662,10 +4682,11 @@
|
||||
(dom-set-attr _el-target "id" "target")
|
||||
(dom-set-inner-html _el-target "old")
|
||||
(dom-set-attr _el-go "id" "go")
|
||||
;; HS source has bare quotes or embedded HTML
|
||||
(dom-set-attr _el-go "_" "on click morph #target to \"<div id=target>new</div>\"")
|
||||
(dom-set-inner-html _el-go "go")
|
||||
(dom-append (dom-body) _el-target)
|
||||
(dom-append (dom-body) _el-go)
|
||||
(hs-activate! _el-go)
|
||||
(dom-dispatch (dom-query-by-id "go") "click" nil)
|
||||
(assert= (dom-text-content (dom-query-by-id "target")) "new")
|
||||
))
|
||||
@@ -4675,10 +4696,11 @@
|
||||
(dom-set-attr _el-target "id" "target")
|
||||
(dom-add-class _el-target "old")
|
||||
(dom-set-inner-html _el-target "content")
|
||||
;; HS source has bare quotes or embedded HTML
|
||||
(dom-set-attr _el-button "_" "on click morph #target to \"<div id=target class=new>content</div>\"")
|
||||
(dom-set-inner-html _el-button "go")
|
||||
(dom-append (dom-body) _el-target)
|
||||
(dom-append (dom-body) _el-button)
|
||||
(hs-activate! _el-button)
|
||||
(dom-dispatch _el-button "click" nil)
|
||||
(assert (dom-has-class? (dom-query-by-id "target") "new"))
|
||||
))
|
||||
@@ -4736,12 +4758,13 @@
|
||||
(dom-set-attr _el-child "id" "child")
|
||||
(dom-set-attr _el-child "_" "on click put \"alive\" into me")
|
||||
(dom-set-inner-html _el-child "child")
|
||||
;; HS source has bare quotes or embedded HTML
|
||||
(dom-set-attr _el-button "_" "on click morph #target to \"<div id=target><p>replaced</p></div>\"")
|
||||
(dom-set-inner-html _el-button "go")
|
||||
(dom-append (dom-body) _el-target)
|
||||
(dom-append _el-target _el-child)
|
||||
(dom-append (dom-body) _el-button)
|
||||
(hs-activate! _el-child)
|
||||
(hs-activate! _el-button)
|
||||
(dom-dispatch _el-button "click" nil)
|
||||
))
|
||||
(deftest "morph reorders children by id"
|
||||
@@ -4752,12 +4775,13 @@
|
||||
(dom-set-inner-html _el-a "A")
|
||||
(dom-set-attr _el-b "id" "b")
|
||||
(dom-set-inner-html _el-b "B")
|
||||
;; HS source has bare quotes or embedded HTML
|
||||
(dom-set-attr _el-button "_" "on click morph #target to \"<div id=target><div id=b>B2</div><div id=a>A2</div></div>\"")
|
||||
(dom-set-inner-html _el-button "go")
|
||||
(dom-append (dom-body) _el-target)
|
||||
(dom-append _el-target _el-a)
|
||||
(dom-append _el-target _el-b)
|
||||
(dom-append (dom-body) _el-button)
|
||||
(hs-activate! _el-button)
|
||||
(dom-dispatch _el-button "click" nil)
|
||||
))
|
||||
(deftest "morph preserves matched child identity"
|
||||
@@ -4767,11 +4791,12 @@
|
||||
(dom-set-attr _el-child "id" "child")
|
||||
(dom-set-inner-html _el-child "old")
|
||||
(dom-set-attr _el-go "id" "go")
|
||||
;; HS source has bare quotes or embedded HTML
|
||||
(dom-set-attr _el-go "_" "on click morph #target to \"<div id=target><div id=child>new</div></div>\"")
|
||||
(dom-set-inner-html _el-go "go")
|
||||
(dom-append (dom-body) _el-target)
|
||||
(dom-append _el-target _el-child)
|
||||
(dom-append (dom-body) _el-go)
|
||||
(hs-activate! _el-go)
|
||||
(dom-dispatch (dom-query-by-id "go") "click" nil)
|
||||
))
|
||||
(deftest "morph with variable content"
|
||||
@@ -4856,6 +4881,7 @@
|
||||
(let ((_el-cb1 (dom-create-element "input")) (_el-button (dom-create-element "button")))
|
||||
(dom-set-attr _el-cb1 "id" "cb1")
|
||||
(dom-set-attr _el-cb1 "type" "checkbox")
|
||||
(dom-set-attr _el-cb1 "checked" "")
|
||||
(dom-set-attr _el-button "_" "on click reset #cb1")
|
||||
(dom-set-inner-html _el-button "Reset")
|
||||
(dom-append (dom-body) _el-cb1)
|
||||
@@ -4906,6 +4932,7 @@
|
||||
(dom-set-attr _el-option "value" "a")
|
||||
(dom-set-inner-html _el-option "A")
|
||||
(dom-set-attr _el-option2 "value" "b")
|
||||
(dom-set-attr _el-option2 "selected" "")
|
||||
(dom-set-inner-html _el-option2 "B")
|
||||
(dom-set-attr _el-option3 "value" "c")
|
||||
(dom-set-inner-html _el-option3 "C")
|
||||
@@ -5633,6 +5660,7 @@
|
||||
(dom-set-attr _el-input "type" "radio")
|
||||
(dom-set-attr _el-input "name" "color")
|
||||
(dom-set-attr _el-input "value" "red")
|
||||
(dom-set-attr _el-input "checked" "")
|
||||
(dom-set-attr _el-input1 "_" "bind $color to me")
|
||||
(dom-set-attr _el-input1 "type" "radio")
|
||||
(dom-set-attr _el-input1 "name" "color")
|
||||
@@ -6891,10 +6919,11 @@
|
||||
(let ((_el-target (dom-create-element "div")) (_el-button (dom-create-element "button")))
|
||||
(dom-set-attr _el-target "id" "target")
|
||||
(dom-set-inner-html _el-target "old")
|
||||
;; HS source has bare quotes or embedded HTML
|
||||
(dom-set-attr _el-button "_" "on click set #target to \"<span id=target>new</span>\"")
|
||||
(dom-set-inner-html _el-button "go")
|
||||
(dom-append (dom-body) _el-target)
|
||||
(dom-append (dom-body) _el-button)
|
||||
(hs-activate! _el-button)
|
||||
(dom-dispatch _el-button "click" nil)
|
||||
(assert= (dom-text-content (dom-query-by-id "target")) "new")
|
||||
))
|
||||
@@ -6920,13 +6949,14 @@
|
||||
(dom-set-inner-html _el-li2 "b")
|
||||
(dom-add-class _el-li3 "item")
|
||||
(dom-set-inner-html _el-li3 "c")
|
||||
;; HS source has bare quotes or embedded HTML
|
||||
(dom-set-attr _el-button "_" "on click set .item to \"<li class=item>replaced</li>\"")
|
||||
(dom-set-inner-html _el-button "go")
|
||||
(dom-append (dom-body) _el-list)
|
||||
(dom-append _el-list _el-li)
|
||||
(dom-append _el-list _el-li2)
|
||||
(dom-append _el-list _el-li3)
|
||||
(dom-append (dom-body) _el-button)
|
||||
(hs-activate! _el-button)
|
||||
(dom-dispatch _el-button "click" nil)
|
||||
))
|
||||
(deftest "set <query/> replaces all matching elements"
|
||||
@@ -6935,22 +6965,24 @@
|
||||
(dom-set-attr _el-box "id" "box")
|
||||
(dom-set-inner-html _el-p "one")
|
||||
(dom-set-inner-html _el-p2 "two")
|
||||
;; HS source has bare quotes or embedded HTML
|
||||
(dom-set-attr _el-button "_" "on click set <p/> in #box to \"<p>done</p>\"")
|
||||
(dom-set-inner-html _el-button "go")
|
||||
(dom-append (dom-body) _el-box)
|
||||
(dom-append _el-box _el-p)
|
||||
(dom-append _el-box _el-p2)
|
||||
(dom-append (dom-body) _el-button)
|
||||
(hs-activate! _el-button)
|
||||
(dom-dispatch _el-button "click" nil)
|
||||
))
|
||||
(deftest "set closest replaces ancestor"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-div (dom-create-element "div")) (_el-button (dom-create-element "button")))
|
||||
(dom-add-class _el-div "wrapper")
|
||||
;; HS source has bare quotes or embedded HTML
|
||||
(dom-set-attr _el-button "_" "on click set (closest <div/>) to \"<div class=wrapper>replaced</div>\"")
|
||||
(dom-set-inner-html _el-button "go")
|
||||
(dom-append (dom-body) _el-div)
|
||||
(dom-append _el-div _el-button)
|
||||
(hs-activate! _el-button)
|
||||
(dom-dispatch _el-button "click" nil)
|
||||
(assert= (dom-text-content (dom-query ".wrapper")) "replaced")
|
||||
))
|
||||
@@ -7195,10 +7227,12 @@
|
||||
(let ((_el-table (dom-create-element "table")) (_el-tr (dom-create-element "tr")) (_el-td (dom-create-element "td")) (_el-input (dom-create-element "input")) (_el-tr4 (dom-create-element "tr")) (_el-td5 (dom-create-element "td")) (_el-input6 (dom-create-element "input")) (_el-tr7 (dom-create-element "tr")) (_el-td8 (dom-create-element "td")) (_el-input9 (dom-create-element "input")) (_el-tr10 (dom-create-element "tr")) (_el-td11 (dom-create-element "td")) (_el-master (dom-create-element "input")))
|
||||
(dom-add-class _el-input "cb")
|
||||
(dom-set-attr _el-input "type" "checkbox")
|
||||
(dom-set-attr _el-input "checked" "")
|
||||
(dom-add-class _el-input6 "cb")
|
||||
(dom-set-attr _el-input6 "type" "checkbox")
|
||||
(dom-add-class _el-input9 "cb")
|
||||
(dom-set-attr _el-input9 "type" "checkbox")
|
||||
(dom-set-attr _el-input9 "checked" "")
|
||||
(dom-set-attr _el-master "id" "master")
|
||||
(dom-set-attr _el-master "_" "set :checkboxes to <input[type=checkbox]/> in the closest <table/> where it is not me then on change set checked of the :checkboxes to my checked")
|
||||
(dom-set-attr _el-master "type" "checkbox")
|
||||
@@ -7223,10 +7257,12 @@
|
||||
(let ((_el-table (dom-create-element "table")) (_el-tr (dom-create-element "tr")) (_el-td (dom-create-element "td")) (_el-input (dom-create-element "input")) (_el-tr4 (dom-create-element "tr")) (_el-td5 (dom-create-element "td")) (_el-input6 (dom-create-element "input")) (_el-tr7 (dom-create-element "tr")) (_el-td8 (dom-create-element "td")) (_el-input9 (dom-create-element "input")) (_el-tr10 (dom-create-element "tr")) (_el-td11 (dom-create-element "td")) (_el-master (dom-create-element "input")))
|
||||
(dom-add-class _el-input "cb")
|
||||
(dom-set-attr _el-input "type" "checkbox")
|
||||
(dom-set-attr _el-input "checked" "")
|
||||
(dom-add-class _el-input6 "cb")
|
||||
(dom-set-attr _el-input6 "type" "checkbox")
|
||||
(dom-add-class _el-input9 "cb")
|
||||
(dom-set-attr _el-input9 "type" "checkbox")
|
||||
(dom-set-attr _el-input9 "checked" "")
|
||||
(dom-set-attr _el-master "id" "master")
|
||||
(dom-set-attr _el-master "_" "set :checkboxes to <input[type=checkbox]/> in the closest <table/> where it is not me then on change set checked of the :checkboxes to my checked then on change from the closest <table/> then if no :checkboxes where it is checked then set my indeterminate to false then set my checked to false then else if no :checkboxes where it is not checked then set my indeterminate to false then set my checked to true then else then set my indeterminate to true then end")
|
||||
(dom-set-attr _el-master "type" "checkbox")
|
||||
@@ -8292,6 +8328,7 @@
|
||||
(hs-cleanup!)
|
||||
(let ((_el-b1 (dom-create-element "button")) (_el-b2 (dom-create-element "button")))
|
||||
(dom-set-attr _el-b1 "id" "b1")
|
||||
(dom-set-attr _el-b1 "disabled" "")
|
||||
(dom-set-inner-html _el-b1 "Disabled")
|
||||
(dom-set-attr _el-b2 "id" "b2")
|
||||
(dom-set-inner-html _el-b2 "Enabled")
|
||||
|
||||
@@ -16,9 +16,9 @@
|
||||
"remove class from target"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "remove .old from #box")))
|
||||
(assert= (quote dom-remove-class) (first sx))
|
||||
(assert= (quote dom-query) (first (nth sx 1)))
|
||||
(assert= "old" (nth sx 2))))
|
||||
(assert= (quote for-each) (first sx))
|
||||
(assert= (quote hs-query-all) (first (nth sx 2)))
|
||||
(assert= "#box" (nth (nth sx 2) 1))))
|
||||
(deftest
|
||||
"toggle class"
|
||||
(let
|
||||
@@ -84,7 +84,7 @@
|
||||
"for becomes for-each"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "for item in items log item end")))
|
||||
(assert= (quote for-each) (first sx))
|
||||
(assert= (quote hs-for-each) (first sx))
|
||||
(assert= (quote fn) (first (nth sx 1)))))
|
||||
(deftest
|
||||
"tell rebinds me"
|
||||
@@ -100,17 +100,16 @@
|
||||
"hide sets display none"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "hide")))
|
||||
(assert= (quote dom-set-style) (first sx))
|
||||
(assert= (quote hs-hide!) (first sx))
|
||||
(assert= (quote me) (nth sx 1))
|
||||
(assert= "display" (nth sx 2))
|
||||
(assert= "none" (nth sx 3))))
|
||||
(assert= "display" (nth sx 2))))
|
||||
(deftest
|
||||
"show clears display"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "show")))
|
||||
(assert= (quote dom-set-style) (first sx))
|
||||
(assert= (quote hs-show!) (first sx))
|
||||
(assert= (quote me) (nth sx 1))
|
||||
(assert= "" (nth sx 3))))
|
||||
(assert= "display" (nth sx 2))))
|
||||
(deftest
|
||||
"log passes through"
|
||||
(let
|
||||
@@ -121,7 +120,9 @@
|
||||
"append becomes dom-append"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "append 'text' to me")))
|
||||
(assert= (quote dom-append) (first sx)))))
|
||||
(assert= (quote set!) (first sx))
|
||||
(assert= (quote hs-append) (first (nth sx 2)))
|
||||
(assert= "text" (nth (nth sx 2) 2)))))
|
||||
|
||||
;; ── Expressions ───────────────────────────────────────────────
|
||||
(defsuite
|
||||
@@ -138,7 +139,7 @@
|
||||
"query emits dom-query"
|
||||
(let
|
||||
((sx (hs-to-sx (list (quote query) ".foo"))))
|
||||
(assert= (quote dom-query) (first sx))
|
||||
(assert= (quote hs-query-first) (first sx))
|
||||
(assert= ".foo" (nth sx 1))))
|
||||
(deftest
|
||||
"attr emits dom-get-attr"
|
||||
@@ -176,7 +177,7 @@
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "on click from #btn add .clicked end")))
|
||||
(assert= (quote hs-on) (first sx))
|
||||
(assert= (quote dom-query) (first (nth sx 1)))))
|
||||
(assert= (quote hs-query-first) (first (nth sx 1)))))
|
||||
(deftest
|
||||
"on every click"
|
||||
(let
|
||||
@@ -254,7 +255,10 @@
|
||||
"hs-emit-return-throw"
|
||||
(deftest
|
||||
"return unwraps to value"
|
||||
(let ((sx (hs-to-sx-from-source "return 42"))) (assert= 42 sx)))
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "return 42")))
|
||||
(assert= (quote raise) (first sx))
|
||||
(assert= 42 (nth (nth sx 1) 2))))
|
||||
(deftest
|
||||
"throw becomes raise"
|
||||
(let
|
||||
@@ -306,11 +310,11 @@
|
||||
(assert= (quote hs-on) (first sx))
|
||||
(assert= "click" (nth sx 2))
|
||||
(let
|
||||
((body (nth (nth sx 3) 2)))
|
||||
(assert= (quote do) (first body))
|
||||
(assert= 3 (len (rest body)))
|
||||
(assert= (quote hs-wait) (first (nth body 2)))
|
||||
(assert= 1000 (nth (nth body 2) 1)))))
|
||||
((body (nth (nth sx 3) 2)) (inner (nth (nth (nth sx 3) 2) 2)))
|
||||
(assert= (quote let) (first body))
|
||||
(assert= (quote let) (first inner))
|
||||
(assert= (quote hs-wait) (first (nth (first (nth inner 1)) 1)))
|
||||
(assert= 1000 (nth (nth (first (nth inner 1)) 1) 1)))))
|
||||
(deftest
|
||||
"count clicks: then chains increment and set in same handler"
|
||||
(let
|
||||
@@ -330,16 +334,16 @@
|
||||
((sx (hs-to-sx-from-source "on click add .bounce to me then wait 1s then remove .bounce from me")))
|
||||
(assert= (quote hs-on) (first sx))
|
||||
(let
|
||||
((body (nth (nth sx 3) 2)))
|
||||
(assert= (quote do) (first body))
|
||||
(assert= 3 (len (rest body)))
|
||||
(assert= (quote hs-wait) (first (nth body 2)))
|
||||
(assert= 1000 (nth (nth body 2) 1)))))
|
||||
((inner (nth (nth (nth sx 3) 2) 2)))
|
||||
(assert= (quote let) (first inner))
|
||||
(assert= (quote hs-wait) (first (nth (first (nth inner 1)) 1)))
|
||||
(assert= 1000 (nth (nth (first (nth inner 1)) 1) 1)))))
|
||||
(deftest
|
||||
"wait preserves ms value in handler"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "on click add .a then wait 2s then add .b")))
|
||||
(let
|
||||
((body (nth (nth sx 3) 2)))
|
||||
(assert= (quote hs-wait) (first (nth body 2)))
|
||||
(assert= 2000 (nth (nth body 2) 1))))))
|
||||
((inner (nth (nth (nth sx 3) 2) 2)))
|
||||
(assert= (quote let) (first inner))
|
||||
(assert= (quote hs-wait) (first (nth (first (nth inner 1)) 1)))
|
||||
(assert= 2000 (nth (nth (first (nth inner 1)) 1) 1))))))
|
||||
@@ -118,7 +118,7 @@
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "fetch '/api'")))
|
||||
(assert= (quote hs-fetch) (first sx))
|
||||
(assert= "json" (nth sx 2))))
|
||||
(assert= "text" (nth sx 2))))
|
||||
(deftest
|
||||
"source → SX shape: def function"
|
||||
(let
|
||||
|
||||
@@ -227,12 +227,15 @@ def parse_html(html):
|
||||
'attrs': {}, 'inner': '', 'depth': len(stack),
|
||||
'children': [], 'parent_idx': None
|
||||
}
|
||||
BOOL_ATTRS = {'checked', 'selected', 'disabled', 'multiple',
|
||||
'required', 'readonly', 'autofocus', 'hidden', 'open'}
|
||||
for name, val in attrs:
|
||||
if name == 'id': el['id'] = val
|
||||
elif name == 'class': el['classes'] = (val or '').split()
|
||||
elif name == '_': el['hs'] = val
|
||||
elif name == 'style': el['attrs']['style'] = val or ''
|
||||
elif val is not None: el['attrs'][name] = val
|
||||
elif name in BOOL_ATTRS: el['attrs'][name] = ''
|
||||
# Track parent-child relationship
|
||||
if stack:
|
||||
parent = stack[-1]
|
||||
@@ -483,7 +486,23 @@ def make_ref_fn(elements, var_names, action_str=''):
|
||||
# most likely refers to an *other* element (often the ID'd one).
|
||||
action_uses_alias = any(n not in tags for n in action_vars)
|
||||
|
||||
# Build var→element lookup for depth checks
|
||||
var_to_el = {var_names[i]: elements[i] for i in range(len(var_names))}
|
||||
|
||||
def ref(name):
|
||||
# Special case for `d1`, `d2`, ... (upstream convention `var d1 = make(HTML)`
|
||||
# binds to the outermost wrapper). If the HTML also has an element with
|
||||
# id='d1' *nested inside* the wrapper, the JS variable shadows it — so
|
||||
# `d1.click()` / `d1.innerHTML` in the check refer to the wrapper, not
|
||||
# the nested element. Prefer the top-level positional element here.
|
||||
pos_match = re.match(r'^d(\d+)$', name)
|
||||
if pos_match and name in id_to_var:
|
||||
id_el = var_to_el.get(id_to_var[name])
|
||||
if id_el is not None and id_el.get('depth', 0) > 0:
|
||||
idx = int(pos_match.group(1)) - 1
|
||||
if 0 <= idx < len(top_level_vars):
|
||||
return top_level_vars[idx]
|
||||
|
||||
# Exact ID match first
|
||||
if name in id_to_var:
|
||||
return id_to_var[name]
|
||||
@@ -499,8 +518,13 @@ def make_ref_fn(elements, var_names, action_str=''):
|
||||
return tag_to_id[name]
|
||||
if name in tag_to_unnamed:
|
||||
return tag_to_unnamed[name]
|
||||
# Fallback: first element of that tag (even if named)
|
||||
return tag_to_all.get(name, [first_var])[0]
|
||||
if name in tag_to_all and tag_to_all[name]:
|
||||
# Static element of that tag exists — use it
|
||||
return tag_to_all[name][0]
|
||||
# No static element of this tag: it must be dynamically inserted
|
||||
# by the hyperscript (e.g. `button` after the handler creates one).
|
||||
# Query the DOM at action/check time with a tag selector.
|
||||
return f'(dom-query "{name}")'
|
||||
|
||||
# Tag + number: div1→1st div, div2→2nd div, form1→1st form, etc.
|
||||
m = re.match(r'^([a-z]+)(\d+)$', name)
|
||||
@@ -791,8 +815,6 @@ def emit_element_setup(lines, elements, var_names, root='(dom-body)', indent='
|
||||
hs_val = process_hs_val(el['hs'])
|
||||
if not hs_val:
|
||||
pass # no HS to set
|
||||
elif hs_val.startswith('"') or (hs_val.endswith('"') and '<' in hs_val):
|
||||
lines.append(f'{indent};; HS source has bare quotes or embedded HTML')
|
||||
else:
|
||||
hs_escaped = hs_val.replace('\\', '\\\\').replace('"', '\\"')
|
||||
lines.append(f'{indent}(dom-set-attr {var} "_" "{hs_escaped}")')
|
||||
@@ -1416,7 +1438,14 @@ output.append(' (fn (src)')
|
||||
output.append(' (let ((sx (hs-to-sx (hs-compile src))))')
|
||||
output.append(' (let ((handler (eval-expr-cek')
|
||||
output.append(' (list (quote fn) (list (quote me)) (list (quote let) (list (list (quote it) nil) (list (quote event) nil)) sx)))))')
|
||||
output.append(' (handler nil)))))')
|
||||
output.append(' (guard')
|
||||
output.append(' (_e')
|
||||
output.append(' (true')
|
||||
output.append(' (if')
|
||||
output.append(' (and (list? _e) (= (first _e) "hs-return"))')
|
||||
output.append(' (nth _e 1)')
|
||||
output.append(' (raise _e))))')
|
||||
output.append(' (handler nil))))))')
|
||||
output.append('')
|
||||
output.append(';; Evaluate with a specific me value (for "I am between" etc.)')
|
||||
output.append('(define eval-hs-with-me')
|
||||
@@ -1424,7 +1453,14 @@ output.append(' (fn (src me-val)')
|
||||
output.append(' (let ((sx (hs-to-sx (hs-compile src))))')
|
||||
output.append(' (let ((handler (eval-expr-cek')
|
||||
output.append(' (list (quote fn) (list (quote me)) (list (quote let) (list (list (quote it) nil) (list (quote event) nil)) sx)))))')
|
||||
output.append(' (handler me-val)))))')
|
||||
output.append(' (guard')
|
||||
output.append(' (_e')
|
||||
output.append(' (true')
|
||||
output.append(' (if')
|
||||
output.append(' (and (list? _e) (= (first _e) "hs-return"))')
|
||||
output.append(' (nth _e 1)')
|
||||
output.append(' (raise _e))))')
|
||||
output.append(' (handler me-val))))))')
|
||||
output.append('')
|
||||
|
||||
# Group by category
|
||||
|
||||
Reference in New Issue
Block a user