HS: behavior scoping + element ref + script tag registration (+5 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 17s

This commit is contained in:
2026-04-27 00:56:12 +00:00
parent 5ddd558eb7
commit 310b649fe7
4 changed files with 636 additions and 242 deletions

View File

@@ -34,7 +34,8 @@
(cond (cond
((= th dot-sym) ((= th dot-sym)
(let (let
((base-ast (nth target 1)) (prop (nth target 2))) ((base-ast (nth target 1))
(prop (nth target 2)))
(cond (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) ".")))) ((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 (list
@@ -85,7 +86,10 @@
(nth target 1) (nth target 1)
value)) value))
((= th (quote ref)) ((= th (quote ref))
(list (quote set!) (make-symbol (nth target 1)) value)) (list
(quote set!)
(make-symbol (nth target 1))
value))
((= th (quote local)) ((= th (quote local))
(list (list
(quote hs-scoped-set!) (quote hs-scoped-set!)
@@ -113,7 +117,8 @@
(list (quote hs-set-inner-html!) (hs-to-sx target) value)) (list (quote hs-set-inner-html!) (hs-to-sx target) value))
((= th (quote of)) ((= th (quote of))
(let (let
((prop-ast (nth target 1)) (obj-ast (nth target 2))) ((prop-ast (nth target 1))
(obj-ast (nth target 2)))
(if (if
(and (list? prop-ast) (= (first prop-ast) dot-sym)) (and (list? prop-ast) (= (first prop-ast) dot-sym))
(let (let
@@ -377,7 +382,8 @@
(fn (fn
(ast) (ast)
(let (let
((mode (nth ast 1)) (body (hs-to-sx (nth ast 2)))) ((mode (nth ast 1))
(body (hs-to-sx (nth ast 2))))
(cond (cond
((and (list? mode) (= (first mode) (quote forever))) ((and (list? mode) (= (first mode) (quote forever)))
(list (list
@@ -414,13 +420,23 @@
(list (quote fn) (list) body))))))) (list (quote fn) (list) body)))))))
(define (define
hs-reserved-var? hs-reserved-var?
(fn (name) (or (= name "meta") (= name "event") (= name "it") (= name "result"))) (fn
(name)
(or
(= name "meta")
(= name "event")
(= name "it")
(= name "result")))
emit-for emit-for
(fn (fn
(ast) (ast)
(let (let
((var-name (nth ast 1)) ((var-name (nth ast 1))
(safe-param (if (hs-reserved-var? var-name) (str "_hs_lv_" var-name) var-name)) (safe-param
(if
(hs-reserved-var? var-name)
(str "_hs_lv_" var-name)
var-name))
(raw-coll-ast (nth ast 2)) (raw-coll-ast (nth ast 2))
(where-cond (where-cond
(if (if
@@ -455,7 +471,9 @@
(quote map-indexed) (quote map-indexed)
(list (list
(quote fn) (quote fn)
(list (make-symbol (nth ast 5)) (make-symbol safe-param)) (list
(make-symbol (nth ast 5))
(make-symbol safe-param))
body) body)
collection) collection)
(list (list
@@ -468,13 +486,15 @@
(ast) (ast)
(let (let
((event-name (nth ast 1)) ((event-name (nth ast 1))
(has-from (and (> (len ast) 2) (= (nth ast 2) :from))) (has-from
(and (> (len ast) 2) (= (nth ast 2) :from)))
(has-from-or (has-from-or
(and (and
(> (len ast) 4) (> (len ast) 4)
(= (nth ast 2) :from) (= (nth ast 2) :from)
(= (nth ast 4) :or))) (= (nth ast 4) :or)))
(has-or (and (> (len ast) 2) (= (nth ast 2) :or)))) (has-or
(and (> (len ast) 2) (= (nth ast 2) :or))))
(cond (cond
(has-from-or (has-from-or
(list (list
@@ -483,7 +503,10 @@
event-name event-name
(nth ast 5))) (nth ast 5)))
(has-from (has-from
(list (quote hs-wait-for) (hs-to-sx (nth ast 3)) event-name)) (list
(quote hs-wait-for)
(hs-to-sx (nth ast 3))
event-name))
(has-or (has-or
(list (list
(quote hs-wait-for-or) (quote hs-wait-for-or)
@@ -512,9 +535,14 @@
(ast) (ast)
(let (let
((type-name (nth ast 1)) ((type-name (nth ast 1))
(called (if (>= (len ast) 3) (nth ast 2) nil)) (called
(if (>= (len ast) 3) (nth ast 2) nil))
(args (if (>= (len ast) 4) (nth ast 3) nil)) (args (if (>= (len ast) 4) (nth ast 3) nil))
(kind (if (>= (len ast) 5) (nth ast 4) (quote auto)))) (kind
(if
(>= (len ast) 5)
(nth ast 4)
(quote auto))))
(let (let
((make-call (cond ((nil? args) (list (quote hs-make) type-name)) (true (cons (quote hs-make) (cons type-name (map hs-to-sx args))))))) ((make-call (cond ((nil? args) (list (quote hs-make) type-name)) (true (cons (quote hs-make) (cons type-name (map hs-to-sx args)))))))
(cond (cond
@@ -571,7 +599,8 @@
(list (quote set!) (quote it) (quote __hs-new)))))) (list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) dot-sym)) ((and (list? expr) (= (first expr) dot-sym))
(let (let
((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2))) ((obj (hs-to-sx (nth expr 1)))
(prop (nth expr 2)))
(list (list
(quote let) (quote let)
(list (list
@@ -608,7 +637,8 @@
(list (quote set!) (quote it) (quote __hs-new)))))) (list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) (quote dom-ref))) ((and (list? expr) (= (first expr) (quote dom-ref)))
(let (let
((el (hs-to-sx (nth expr 2))) (name (nth expr 1))) ((el (hs-to-sx (nth expr 2)))
(name (nth expr 1)))
(list (list
(quote let) (quote let)
(list (list
@@ -687,7 +717,8 @@
(list (quote set!) (quote it) (quote __hs-new)))))) (list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) dot-sym)) ((and (list? expr) (= (first expr) dot-sym))
(let (let
((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2))) ((obj (hs-to-sx (nth expr 1)))
(prop (nth expr 2)))
(list (list
(quote let) (quote let)
(list (list
@@ -724,7 +755,8 @@
(list (quote set!) (quote it) (quote __hs-new)))))) (list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) (quote dom-ref))) ((and (list? expr) (= (first expr) (quote dom-ref)))
(let (let
((el (hs-to-sx (nth expr 2))) (name (nth expr 1))) ((el (hs-to-sx (nth expr 2)))
(name (nth expr 1)))
(list (list
(quote let) (quote let)
(list (list
@@ -782,14 +814,28 @@
(fn (fn
(ast) (ast)
(let (let
((name (nth ast 1)) (params (nth ast 2)) (body (nth ast 3))) ((name (nth ast 1))
(params (nth ast 2))
(body (nth ast 3)))
(list (list
(quote define) (quote define)
(make-symbol name) (make-symbol name)
(list (list
(quote fn) (quote fn)
(cons (quote me) (map make-symbol params)) (cons
(cons (quote do) (map hs-to-sx body))))))) (quote me)
(map
(fn
(p)
(if
(list? p)
(make-symbol (nth p 1))
(make-symbol p)))
params))
(list
(quote let)
(list (list (quote beingTold) (quote me)))
(cons (quote do) (map hs-to-sx body))))))))
(fn (fn
(ast) (ast)
(let (let
@@ -846,7 +892,10 @@
(let (let
((raw (nth ast 1))) ((raw (nth ast 1)))
(let (let
((parts (list)) (buf "") (i 0) (n (len raw))) ((parts (list))
(buf "")
(i 0)
(n (len raw)))
(define (define
tpl-flush tpl-flush
(fn (fn
@@ -884,10 +933,14 @@
(if (if
(= depth 1) (= depth 1)
j j
(tpl-find-close (+ j 1) (- depth 1))) (tpl-find-close
(+ j 1)
(- depth 1)))
(if (if
(= (nth raw j) "{") (= (nth raw j) "{")
(tpl-find-close (+ j 1) (+ depth 1)) (tpl-find-close
(+ j 1)
(+ depth 1))
(tpl-find-close (+ j 1) depth)))))) (tpl-find-close (+ j 1) depth))))))
(define (define
tpl-collect tpl-collect
@@ -898,7 +951,10 @@
(let (let
((ch (nth raw i))) ((ch (nth raw i)))
(if (if
(and (= ch "\\") (< (+ i 1) n) (= (nth raw (+ i 1)) "$")) (and
(= ch "\\")
(< (+ i 1) n)
(= (nth raw (+ i 1)) "$"))
(do (do
(set! buf (str buf "$")) (set! buf (str buf "$"))
(set! i (+ i 2)) (set! i (+ i 2))
@@ -907,39 +963,40 @@
(and (= ch "$") (< (+ i 1) n)) (and (= ch "$") (< (+ i 1) n))
(if (if
(= (nth raw (+ i 1)) "{") (= (nth raw (+ i 1)) "{")
(let
((start (+ i 2)))
(let (let
((close (tpl-find-close start 1))) ((start (+ i 2)))
(let (let
((expr-src (slice raw start close))) ((close (tpl-find-close start 1)))
(do (let
(tpl-flush) ((expr-src (slice raw start close)))
(set! (do
parts (tpl-flush)
(append (set!
parts parts
(list (append
(hs-to-sx parts
(hs-compile expr-src))))) (list
(set! i (+ close 1)) (hs-to-sx
(tpl-collect))))) (hs-compile expr-src)))))
(let (set! i (+ close 1))
((start (+ i 1))) (tpl-collect)))))
(let (let
((end (tpl-read-id start))) ((start (+ i 1)))
(let (let
((ident (slice raw start end))) ((end (tpl-read-id start)))
(do (let
(tpl-flush) ((ident (slice raw start end)))
(set! (do
parts (tpl-flush)
(append (set!
parts parts
(list (append
(hs-to-sx (hs-compile ident))))) parts
(set! i end) (list
(tpl-collect)))))) (hs-to-sx
(hs-compile ident)))))
(set! i end)
(tpl-collect))))))
(do (do
(set! buf (str buf ch)) (set! buf (str buf ch))
(set! i (+ i 1)) (set! i (+ i 1))
@@ -983,7 +1040,10 @@
(list (list
(quote hs-pick-random) (quote hs-pick-random)
(hs-to-sx (nth ast 1)) (hs-to-sx (nth ast 1))
(if (nil? (nth ast 2)) nil (hs-to-sx (nth ast 2)))))) (if
(nil? (nth ast 2))
nil
(hs-to-sx (nth ast 2))))))
((= head (quote pick-items)) ((= head (quote pick-items))
(list (list
(quote set!) (quote set!)
@@ -1082,7 +1142,10 @@
(quote hs-method-call) (quote hs-method-call)
(cons (hs-to-sx dot-node) args)))))) (cons (hs-to-sx dot-node) args))))))
((= head (quote string-postfix)) ((= head (quote string-postfix))
(list (quote str) (hs-to-sx (nth ast 1)) (nth ast 2))) (list
(quote str)
(hs-to-sx (nth ast 1))
(nth ast 2)))
((= head (quote block-literal)) ((= head (quote block-literal))
(let (let
((params (map make-symbol (nth ast 1))) ((params (map make-symbol (nth ast 1)))
@@ -1101,10 +1164,11 @@
((= prop "last") (list (quote hs-last) target)) ((= prop "last") (list (quote hs-last) target))
(true (list (quote host-get) target prop))))) (true (list (quote host-get) target prop)))))
((= head (quote ref)) ((= head (quote ref))
(if (cond
(= (nth ast 1) "selection") ((= (nth ast 1) "selection")
(list (quote hs-get-selection)) (list (quote hs-get-selection)))
(make-symbol (nth ast 1)))) ((= (nth ast 1) "element") (make-symbol "me"))
(else (make-symbol (nth ast 1)))))
((= head (quote query)) ((= head (quote query))
(list (quote hs-query-first) (nth ast 1))) (list (quote hs-query-first) (nth ast 1)))
((= head (quote query-scoped)) ((= head (quote query-scoped))
@@ -1133,7 +1197,10 @@
(hs-to-sx (nth ast 1)) (hs-to-sx (nth ast 1))
(nth ast 2))) (nth ast 2)))
((= head (quote local)) ((= head (quote local))
(list (quote hs-scoped-get) (quote me) (nth ast 1))) (list
(quote hs-scoped-get)
(quote me)
(nth ast 1)))
((= head (quote array)) ((= head (quote array))
(cons (quote list) (map hs-to-sx (rest ast)))) (cons (quote list) (map hs-to-sx (rest ast))))
((= head (quote not)) ((= head (quote not))
@@ -1196,7 +1263,8 @@
(list (quote nil?) (hs-to-sx (nth ast 1))))) (list (quote nil?) (hs-to-sx (nth ast 1)))))
((= head (quote matches?)) ((= head (quote matches?))
(let (let
((left (nth ast 1)) (right (nth ast 2))) ((left (nth ast 1))
(right (nth ast 2)))
(if (if
(and (list? right) (= (first right) (quote query))) (and (list? right) (= (first right) (quote query)))
(list (list
@@ -1316,7 +1384,10 @@
"parentElement") "parentElement")
(nth ast 1))) (nth ast 1)))
((= head (quote next)) ((= head (quote next))
(list (quote hs-next) (hs-to-sx (nth ast 2)) (nth ast 1))) (list
(quote hs-next)
(hs-to-sx (nth ast 2))
(nth ast 1)))
((= head (quote previous)) ((= head (quote previous))
(list (list
(quote hs-previous) (quote hs-previous)
@@ -1367,7 +1438,8 @@
(nth ast 2))) (nth ast 2)))
((= head (quote set-styles)) ((= head (quote set-styles))
(let (let
((pairs (nth ast 1)) (tgt (hs-to-sx (nth ast 2)))) ((pairs (nth ast 1))
(tgt (hs-to-sx (nth ast 2))))
(cons (cons
(quote do) (quote do)
(map (map
@@ -1512,7 +1584,8 @@
(list (quote hs-splice-at!) (hs-to-sx coll) idx)))) (list (quote hs-splice-at!) (hs-to-sx coll) idx))))
((and (list? tgt) (= (first tgt) dot-sym)) ((and (list? tgt) (= (first tgt) dot-sym))
(let (let
((obj (nth tgt 1)) (prop (nth tgt 2))) ((obj (nth tgt 1))
(prop (nth tgt 2)))
(emit-set (emit-set
obj obj
(list (list
@@ -1521,7 +1594,8 @@
prop)))) prop))))
((and (list? tgt) (= (first tgt) (quote of))) ((and (list? tgt) (= (first tgt) (quote of)))
(let (let
((prop-ast (nth tgt 1)) (obj-ast (nth tgt 2))) ((prop-ast (nth tgt 1))
(obj-ast (nth tgt 2)))
(let (let
((prop (cond ((string? prop-ast) prop-ast) ((and (list? prop-ast) (= (first prop-ast) (quote ref))) (nth prop-ast 1)) (true (hs-to-sx prop-ast))))) ((prop (cond ((string? prop-ast) prop-ast) ((and (list? prop-ast) (= (first prop-ast) (quote ref))) (nth prop-ast 1)) (true (hs-to-sx prop-ast)))))
(emit-set (emit-set
@@ -1533,7 +1607,8 @@
(true (list (quote dom-remove) (hs-to-sx tgt)))))) (true (list (quote dom-remove) (hs-to-sx tgt))))))
((= head (quote add-value)) ((= head (quote add-value))
(let (let
((val (hs-to-sx (nth ast 1))) (tgt (nth ast 2))) ((val (hs-to-sx (nth ast 1)))
(tgt (nth ast 2)))
(emit-set (emit-set
tgt tgt
(list (quote hs-add-to!) val (hs-to-sx tgt))))) (list (quote hs-add-to!) val (hs-to-sx tgt)))))
@@ -1547,7 +1622,8 @@
(hs-to-sx (nth ast 2))))) (hs-to-sx (nth ast 2)))))
((= head (quote remove-value)) ((= head (quote remove-value))
(let (let
((val (hs-to-sx (nth ast 1))) (tgt (nth ast 2))) ((val (hs-to-sx (nth ast 1)))
(tgt (nth ast 2)))
(emit-set (emit-set
tgt tgt
(list (quote hs-remove-from!) val (hs-to-sx tgt))))) (list (quote hs-remove-from!) val (hs-to-sx tgt)))))
@@ -1562,7 +1638,10 @@
((and (list? tgt) (= (first tgt) (quote query))) ((and (list? tgt) (= (first tgt) (quote query)))
(list (list
(quote for-each) (quote for-each)
(list (quote fn) (list (quote _el)) (list (quote hs-empty-target!) (quote _el))) (list
(quote fn)
(list (quote _el))
(list (quote hs-empty-target!) (quote _el)))
(list (quote hs-query-all) (nth tgt 1)))) (list (quote hs-query-all) (nth tgt 1))))
(true (list (quote hs-empty-target!) (hs-to-sx tgt)))))) (true (list (quote hs-empty-target!) (hs-to-sx tgt))))))
((= head (quote open-element)) ((= head (quote open-element))
@@ -1710,7 +1789,9 @@
(nth ast 3) (nth ast 3)
(hs-to-sx (nth ast 4)))) (hs-to-sx (nth ast 4))))
((= head (quote set!)) ((= head (quote set!))
(emit-set (nth ast 1) (hs-to-sx (nth ast 2)))) (emit-set
(nth ast 1)
(hs-to-sx (nth ast 2))))
((= head (quote put!)) ((= head (quote put!))
(let (let
((val (hs-to-sx (nth ast 1))) ((val (hs-to-sx (nth ast 1)))
@@ -1800,7 +1881,8 @@
(= (first c) (quote define))))) (= (first c) (quote define)))))
compiled))) compiled)))
(cons (quote do) (append defs non-defs))))))) (cons (quote do) (append defs non-defs)))))))
((= head (quote wait)) (list (quote hs-wait) (nth ast 1))) ((= head (quote wait))
(list (quote hs-wait) (nth ast 1)))
((= head (quote wait-for)) (emit-wait-for ast)) ((= head (quote wait-for)) (emit-wait-for ast))
((= head (quote log)) ((= head (quote log))
(list (quote console-log) (hs-to-sx (nth ast 1)))) (list (quote console-log) (hs-to-sx (nth ast 1))))
@@ -1813,8 +1895,16 @@
(= (len ast) 4) (= (len ast) 4)
(list? (nth ast 2)) (list? (nth ast 2))
(= (first (nth ast 2)) (quote dict)))) (= (first (nth ast 2)) (quote dict))))
(tgt (if (= (len ast) 4) (nth ast 3) (nth ast 2))) (tgt
(detail (if (= (len ast) 4) (nth ast 2) nil))) (if
(= (len ast) 4)
(nth ast 3)
(nth ast 2)))
(detail
(if
(= (len ast) 4)
(nth ast 2)
nil)))
(list (list
(quote dom-dispatch) (quote dom-dispatch)
(hs-to-sx tgt) (hs-to-sx tgt)
@@ -1823,8 +1913,16 @@
((= head (quote hide)) ((= head (quote hide))
(let (let
((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt)))) ((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt))))
(strategy (if (> (len ast) 2) (nth ast 2) "display")) (strategy
(when-cond (if (> (len ast) 3) (nth ast 3) nil))) (if
(> (len ast) 2)
(nth ast 2)
"display"))
(when-cond
(if
(> (len ast) 3)
(nth ast 3)
nil)))
(if (if
(nil? when-cond) (nil? when-cond)
(list (quote hs-hide!) tgt strategy) (list (quote hs-hide!) tgt strategy)
@@ -1839,8 +1937,16 @@
((= head (quote show)) ((= head (quote show))
(let (let
((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt)))) ((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt))))
(strategy (if (> (len ast) 2) (nth ast 2) "display")) (strategy
(when-cond (if (> (len ast) 3) (nth ast 3) nil))) (if
(> (len ast) 2)
(nth ast 2)
"display"))
(when-cond
(if
(> (len ast) 3)
(nth ast 3)
nil)))
(if (if
(nil? when-cond) (nil? when-cond)
(list (quote hs-show!) tgt strategy) (list (quote hs-show!) tgt strategy)
@@ -1884,23 +1990,41 @@
((= head (quote repeat-until)) ((= head (quote repeat-until))
(list (list
(quote hs-repeat-until) (quote hs-repeat-until)
(list (quote fn) (list) (hs-to-sx (nth ast 1))) (list
(list (quote fn) (list) (hs-to-sx (nth ast 2))))) (quote fn)
(list)
(hs-to-sx (nth ast 1)))
(list
(quote fn)
(list)
(hs-to-sx (nth ast 2)))))
((= head (quote repeat-while)) ((= head (quote repeat-while))
(list (list
(quote hs-repeat-while) (quote hs-repeat-while)
(list (quote fn) (list) (hs-to-sx (nth ast 1))) (list
(list (quote fn) (list) (hs-to-sx (nth ast 2))))) (quote fn)
(list)
(hs-to-sx (nth ast 1)))
(list
(quote fn)
(list)
(hs-to-sx (nth ast 2)))))
((= head (quote fetch)) ((= head (quote fetch))
(list (list
(if (nth ast 3) (quote hs-fetch-no-throw) (quote hs-fetch)) (if
(nth ast 3)
(quote hs-fetch-no-throw)
(quote hs-fetch))
(hs-to-sx (nth ast 1)) (hs-to-sx (nth ast 1))
(nth ast 2))) (nth ast 2)))
((= head (quote fetch-gql)) ((= head (quote fetch-gql))
(list (list
(quote hs-fetch-gql) (quote hs-fetch-gql)
(nth ast 1) (nth ast 1)
(if (nth ast 2) (hs-to-sx (nth ast 2)) nil))) (if
(nth ast 2)
(hs-to-sx (nth ast 2))
nil)))
((= head (quote call)) ((= head (quote call))
(let (let
((raw-fn (nth ast 1)) ((raw-fn (nth ast 1))
@@ -1911,14 +2035,7 @@
(hs-to-sx raw-fn))) (hs-to-sx raw-fn)))
(args (map hs-to-sx (rest (rest ast))))) (args (map hs-to-sx (rest (rest ast)))))
(let (let
((call-expr ((call-expr (if (and (list? raw-fn) (= (first raw-fn) (quote ref))) (list (quote hs-win-call) (nth raw-fn 1) (cons (quote list) args)) (cons fn-expr args))))
(if
(and (list? raw-fn) (= (first raw-fn) (quote ref)))
(list
(quote hs-win-call)
(nth raw-fn 1)
(cons (quote list) args))
(cons fn-expr args))))
(emit-set (quote the-result) call-expr)))) (emit-set (quote the-result) call-expr))))
((= head (quote return)) ((= head (quote return))
(let (let
@@ -1936,7 +2053,9 @@
((= head (quote settle)) ((= head (quote settle))
(list (quote hs-settle) (quote me))) (list (quote hs-settle) (quote me)))
((= head (quote go)) ((= head (quote go))
(list (quote hs-navigate!) (hs-to-sx (nth ast 1)))) (list
(quote hs-navigate!)
(hs-to-sx (nth ast 1))))
((= head (quote ask)) ((= head (quote ask))
(let (let
((val (list (quote hs-ask) (hs-to-sx (nth ast 1))))) ((val (list (quote hs-ask) (hs-to-sx (nth ast 1)))))
@@ -2022,17 +2141,35 @@
(let (let
((kind (nth ast 1)) ((kind (nth ast 1))
(name (nth ast 2)) (name (nth ast 2))
(from-sel (if (> (len ast) 3) (nth ast 3) nil)) (from-sel
(for-tgt (if (> (len ast) 4) (nth ast 4) nil)) (if
(attr-val (if (> (len ast) 5) (nth ast 5) nil)) (> (len ast) 3)
(with-val (if (> (len ast) 6) (nth ast 6) nil))) (nth ast 3)
nil))
(for-tgt
(if
(> (len ast) 4)
(nth ast 4)
nil))
(attr-val
(if
(> (len ast) 5)
(nth ast 5)
nil))
(with-val
(if
(> (len ast) 6)
(nth ast 6)
nil)))
(let (let
((target (if for-tgt (hs-to-sx for-tgt) (quote me))) ((target (if for-tgt (hs-to-sx for-tgt) (quote me)))
(scope (scope
(cond (cond
((nil? from-sel) nil) ((nil? from-sel) nil)
((and (list? from-sel) (= (first from-sel) (quote query))) ((and (list? from-sel) (= (first from-sel) (quote query)))
(list (quote hs-query-all) (nth from-sel 1))) (list
(quote hs-query-all)
(nth from-sel 1)))
(true (hs-to-sx from-sel)))) (true (hs-to-sx from-sel))))
(with-sx (with-sx
(if (if
@@ -2064,13 +2201,31 @@
(true (list (quote hs-take!) target kind name scope)))))) (true (list (quote hs-take!) target kind name scope))))))
((= head (quote make)) (emit-make ast)) ((= head (quote make)) (emit-make ast))
((= head (quote install)) ((= head (quote install))
(cons (quote hs-install) (map hs-to-sx (rest ast)))) (let
((bname (nth ast 1)))
(cons
(make-symbol bname)
(cons
(quote me)
(map
(fn
(arg)
(if
(and
(list? arg)
(= (first arg) (quote type-assert)))
(+ (nth arg 2) 0)
(hs-to-sx arg)))
(rest (rest ast)))))))
((= head (quote measure)) ((= head (quote measure))
(list (quote hs-measure) (hs-to-sx (nth ast 1)))) (list (quote hs-measure) (hs-to-sx (nth ast 1))))
((= head (quote increment!)) ((= head (quote increment!))
(if (if
(= (len ast) 3) (= (len ast) 3)
(emit-inc (nth ast 1) 1 (nth ast 2)) (emit-inc
(nth ast 1)
1
(nth ast 2))
(emit-inc (emit-inc
(nth ast 1) (nth ast 1)
(nth ast 2) (nth ast 2)
@@ -2078,7 +2233,10 @@
((= head (quote decrement!)) ((= head (quote decrement!))
(if (if
(= (len ast) 3) (= (len ast) 3)
(emit-dec (nth ast 1) 1 (nth ast 2)) (emit-dec
(nth ast 1)
1
(nth ast 2))
(emit-dec (emit-dec
(nth ast 1) (nth ast 1)
(nth ast 2) (nth ast 2)
@@ -2092,7 +2250,8 @@
((= head (quote on)) (emit-on ast)) ((= head (quote on)) (emit-on ast))
((= head (quote when-changes)) ((= head (quote when-changes))
(let (let
((expr (nth ast 1)) (body (nth ast 2))) ((expr (nth ast 1))
(body (nth ast 2)))
(if (if
(and (list? expr) (= (first expr) (quote dom-ref))) (and (list? expr) (= (first expr) (quote dom-ref)))
(list (list
@@ -2104,7 +2263,10 @@
((= head (quote init)) ((= head (quote init))
(list (list
(quote hs-init) (quote hs-init)
(list (quote fn) (list) (hs-to-sx (nth ast 1))))) (list
(quote fn)
(list)
(hs-to-sx (nth ast 1)))))
((= head (quote def)) ((= head (quote def))
(let (let
((body (hs-to-sx (nth ast 3))) ((body (hs-to-sx (nth ast 3)))
@@ -2143,7 +2305,10 @@
(quote =) (quote =)
(list (quote first) (quote _e)) (list (quote first) (quote _e))
"hs-return")) "hs-return"))
(list (quote nth) (quote _e) 1) (list
(quote nth)
(quote _e)
1)
(list (quote raise) (quote _e))))) (list (quote raise) (quote _e)))))
body)))) body))))
(list (list
@@ -2162,14 +2327,22 @@
(string? src) (string? src)
(first (sx-parse src)) (first (sx-parse src))
(list (quote cek-eval) (hs-to-sx src))))) (list (quote cek-eval) (hs-to-sx src)))))
((= head (quote component)) (make-symbol (nth ast 1))) ((= head (quote component))
(make-symbol (nth ast 1)))
((= head (quote render)) ((= head (quote render))
(let (let
((comp-raw (nth ast 1)) ((comp-raw (nth ast 1))
(kwargs (nth ast 2)) (kwargs (nth ast 2))
(pos (if (> (len ast) 3) (nth ast 3) nil)) (pos
(if
(> (len ast) 3)
(nth ast 3)
nil))
(target (target
(if (> (len ast) 4) (hs-to-sx (nth ast 4)) nil))) (if
(> (len ast) 4)
(hs-to-sx (nth ast 4))
nil)))
(let (let
((comp (if (string? comp-raw) (make-symbol comp-raw) (hs-to-sx comp-raw)))) ((comp (if (string? comp-raw) (make-symbol comp-raw) (hs-to-sx comp-raw))))
(define (define
@@ -2266,7 +2439,9 @@
((and (list? raw-tgt) (= (first raw-tgt) (quote query))) ((and (list? raw-tgt) (= (first raw-tgt) (quote query)))
(list (list
(quote hs-reset!) (quote hs-reset!)
(list (quote hs-query-all) (nth raw-tgt 1)))) (list
(quote hs-query-all)
(nth raw-tgt 1))))
(true (list (quote hs-reset!) (hs-to-sx raw-tgt)))))) (true (list (quote hs-reset!) (hs-to-sx raw-tgt))))))
((= head (quote default!)) ((= head (quote default!))
(let (let
@@ -2292,7 +2467,8 @@
(list (quote dom-focus) (hs-to-sx (nth ast 1)))) (list (quote dom-focus) (hs-to-sx (nth ast 1))))
((= head (quote js-block)) ((= head (quote js-block))
(let (let
((params (nth ast 1)) (js-src (nth ast 2))) ((params (nth ast 1))
(js-src (nth ast 2)))
(let (let
((bound-syms (map (fn (p) (make-symbol p)) params))) ((bound-syms (map (fn (p) (make-symbol p)) params)))
(list (list

View File

@@ -77,26 +77,51 @@
;; Marks the element to avoid double-activation. ;; Marks the element to avoid double-activation.
(define (define
hs-activate! hs-register-scripts!
(fn (fn
(el) ()
(let (for-each
((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script"))) (fn
(when (script)
(and src (not (= src prev)))
(when (when
(dom-dispatch el "hyperscript:before:init" nil) (not (dom-get-data script "hs-script-loaded"))
(hs-log-event! "hyperscript:init") (let
(dom-set-data el "hs-script" src) ((src (host-get script "innerHTML")))
(dom-set-data el "hs-active" true) (when
(dom-set-attr el "data-hyperscript-powered" "true") (and src (not (= src "")))
(let ((handler (hs-handler src))) (handler el)) (guard
(dom-dispatch el "hyperscript:after:init" nil)))))) (_e (true nil))
(eval-expr-cek (hs-to-sx-from-source src)))
(dom-set-data script "hs-script-loaded" true)))))
(hs-query-all "script[type=text/hyperscript]"))))
;; ── Boot: scan entire document ────────────────────────────────── ;; ── Boot: scan entire document ──────────────────────────────────
;; Called once at page load. Finds all elements with _ attribute, ;; Called once at page load. Finds all elements with _ attribute,
;; compiles their hyperscript, and activates them. ;; compiles their hyperscript, and activates them.
(define
hs-activate!
(fn
(el)
(do
(hs-register-scripts!)
(let
((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script")))
(when
(and src (not (= src prev)))
(when
(dom-dispatch el "hyperscript:before:init" nil)
(hs-log-event! "hyperscript:init")
(dom-set-data el "hs-script" src)
(dom-set-data el "hs-active" true)
(dom-set-attr el "data-hyperscript-powered" "true")
(let ((handler (hs-handler src))) (handler el))
(dom-dispatch el "hyperscript:after:init" nil)))))))
;; ── Boot subtree: for dynamic content ───────────────────────────
;; Called after HTMX swaps or dynamic DOM insertion.
;; Only activates elements within the given root.
(define (define
hs-deactivate! hs-deactivate!
(fn (fn
@@ -108,10 +133,6 @@
(dom-set-data el "hs-active" false) (dom-set-data el "hs-active" false)
(dom-set-data el "hs-script" nil)))) (dom-set-data el "hs-script" nil))))
;; ── Boot subtree: for dynamic content ───────────────────────────
;; Called after HTMX swaps or dynamic DOM insertion.
;; Only activates elements within the given root.
(define (define
hs-boot! hs-boot!
(fn (fn

View File

@@ -34,7 +34,8 @@
(cond (cond
((= th dot-sym) ((= th dot-sym)
(let (let
((base-ast (nth target 1)) (prop (nth target 2))) ((base-ast (nth target 1))
(prop (nth target 2)))
(cond (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) ".")))) ((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 (list
@@ -85,7 +86,10 @@
(nth target 1) (nth target 1)
value)) value))
((= th (quote ref)) ((= th (quote ref))
(list (quote set!) (make-symbol (nth target 1)) value)) (list
(quote set!)
(make-symbol (nth target 1))
value))
((= th (quote local)) ((= th (quote local))
(list (list
(quote hs-scoped-set!) (quote hs-scoped-set!)
@@ -113,7 +117,8 @@
(list (quote hs-set-inner-html!) (hs-to-sx target) value)) (list (quote hs-set-inner-html!) (hs-to-sx target) value))
((= th (quote of)) ((= th (quote of))
(let (let
((prop-ast (nth target 1)) (obj-ast (nth target 2))) ((prop-ast (nth target 1))
(obj-ast (nth target 2)))
(if (if
(and (list? prop-ast) (= (first prop-ast) dot-sym)) (and (list? prop-ast) (= (first prop-ast) dot-sym))
(let (let
@@ -377,7 +382,8 @@
(fn (fn
(ast) (ast)
(let (let
((mode (nth ast 1)) (body (hs-to-sx (nth ast 2)))) ((mode (nth ast 1))
(body (hs-to-sx (nth ast 2))))
(cond (cond
((and (list? mode) (= (first mode) (quote forever))) ((and (list? mode) (= (first mode) (quote forever)))
(list (list
@@ -414,13 +420,23 @@
(list (quote fn) (list) body))))))) (list (quote fn) (list) body)))))))
(define (define
hs-reserved-var? hs-reserved-var?
(fn (name) (or (= name "meta") (= name "event") (= name "it") (= name "result"))) (fn
(name)
(or
(= name "meta")
(= name "event")
(= name "it")
(= name "result")))
emit-for emit-for
(fn (fn
(ast) (ast)
(let (let
((var-name (nth ast 1)) ((var-name (nth ast 1))
(safe-param (if (hs-reserved-var? var-name) (str "_hs_lv_" var-name) var-name)) (safe-param
(if
(hs-reserved-var? var-name)
(str "_hs_lv_" var-name)
var-name))
(raw-coll-ast (nth ast 2)) (raw-coll-ast (nth ast 2))
(where-cond (where-cond
(if (if
@@ -455,7 +471,9 @@
(quote map-indexed) (quote map-indexed)
(list (list
(quote fn) (quote fn)
(list (make-symbol (nth ast 5)) (make-symbol safe-param)) (list
(make-symbol (nth ast 5))
(make-symbol safe-param))
body) body)
collection) collection)
(list (list
@@ -468,13 +486,15 @@
(ast) (ast)
(let (let
((event-name (nth ast 1)) ((event-name (nth ast 1))
(has-from (and (> (len ast) 2) (= (nth ast 2) :from))) (has-from
(and (> (len ast) 2) (= (nth ast 2) :from)))
(has-from-or (has-from-or
(and (and
(> (len ast) 4) (> (len ast) 4)
(= (nth ast 2) :from) (= (nth ast 2) :from)
(= (nth ast 4) :or))) (= (nth ast 4) :or)))
(has-or (and (> (len ast) 2) (= (nth ast 2) :or)))) (has-or
(and (> (len ast) 2) (= (nth ast 2) :or))))
(cond (cond
(has-from-or (has-from-or
(list (list
@@ -483,7 +503,10 @@
event-name event-name
(nth ast 5))) (nth ast 5)))
(has-from (has-from
(list (quote hs-wait-for) (hs-to-sx (nth ast 3)) event-name)) (list
(quote hs-wait-for)
(hs-to-sx (nth ast 3))
event-name))
(has-or (has-or
(list (list
(quote hs-wait-for-or) (quote hs-wait-for-or)
@@ -512,9 +535,14 @@
(ast) (ast)
(let (let
((type-name (nth ast 1)) ((type-name (nth ast 1))
(called (if (>= (len ast) 3) (nth ast 2) nil)) (called
(if (>= (len ast) 3) (nth ast 2) nil))
(args (if (>= (len ast) 4) (nth ast 3) nil)) (args (if (>= (len ast) 4) (nth ast 3) nil))
(kind (if (>= (len ast) 5) (nth ast 4) (quote auto)))) (kind
(if
(>= (len ast) 5)
(nth ast 4)
(quote auto))))
(let (let
((make-call (cond ((nil? args) (list (quote hs-make) type-name)) (true (cons (quote hs-make) (cons type-name (map hs-to-sx args))))))) ((make-call (cond ((nil? args) (list (quote hs-make) type-name)) (true (cons (quote hs-make) (cons type-name (map hs-to-sx args)))))))
(cond (cond
@@ -571,7 +599,8 @@
(list (quote set!) (quote it) (quote __hs-new)))))) (list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) dot-sym)) ((and (list? expr) (= (first expr) dot-sym))
(let (let
((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2))) ((obj (hs-to-sx (nth expr 1)))
(prop (nth expr 2)))
(list (list
(quote let) (quote let)
(list (list
@@ -608,7 +637,8 @@
(list (quote set!) (quote it) (quote __hs-new)))))) (list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) (quote dom-ref))) ((and (list? expr) (= (first expr) (quote dom-ref)))
(let (let
((el (hs-to-sx (nth expr 2))) (name (nth expr 1))) ((el (hs-to-sx (nth expr 2)))
(name (nth expr 1)))
(list (list
(quote let) (quote let)
(list (list
@@ -687,7 +717,8 @@
(list (quote set!) (quote it) (quote __hs-new)))))) (list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) dot-sym)) ((and (list? expr) (= (first expr) dot-sym))
(let (let
((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2))) ((obj (hs-to-sx (nth expr 1)))
(prop (nth expr 2)))
(list (list
(quote let) (quote let)
(list (list
@@ -724,7 +755,8 @@
(list (quote set!) (quote it) (quote __hs-new)))))) (list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) (quote dom-ref))) ((and (list? expr) (= (first expr) (quote dom-ref)))
(let (let
((el (hs-to-sx (nth expr 2))) (name (nth expr 1))) ((el (hs-to-sx (nth expr 2)))
(name (nth expr 1)))
(list (list
(quote let) (quote let)
(list (list
@@ -782,14 +814,28 @@
(fn (fn
(ast) (ast)
(let (let
((name (nth ast 1)) (params (nth ast 2)) (body (nth ast 3))) ((name (nth ast 1))
(params (nth ast 2))
(body (nth ast 3)))
(list (list
(quote define) (quote define)
(make-symbol name) (make-symbol name)
(list (list
(quote fn) (quote fn)
(cons (quote me) (map make-symbol params)) (cons
(cons (quote do) (map hs-to-sx body))))))) (quote me)
(map
(fn
(p)
(if
(list? p)
(make-symbol (nth p 1))
(make-symbol p)))
params))
(list
(quote let)
(list (list (quote beingTold) (quote me)))
(cons (quote do) (map hs-to-sx body))))))))
(fn (fn
(ast) (ast)
(let (let
@@ -846,7 +892,10 @@
(let (let
((raw (nth ast 1))) ((raw (nth ast 1)))
(let (let
((parts (list)) (buf "") (i 0) (n (len raw))) ((parts (list))
(buf "")
(i 0)
(n (len raw)))
(define (define
tpl-flush tpl-flush
(fn (fn
@@ -884,10 +933,14 @@
(if (if
(= depth 1) (= depth 1)
j j
(tpl-find-close (+ j 1) (- depth 1))) (tpl-find-close
(+ j 1)
(- depth 1)))
(if (if
(= (nth raw j) "{") (= (nth raw j) "{")
(tpl-find-close (+ j 1) (+ depth 1)) (tpl-find-close
(+ j 1)
(+ depth 1))
(tpl-find-close (+ j 1) depth)))))) (tpl-find-close (+ j 1) depth))))))
(define (define
tpl-collect tpl-collect
@@ -898,7 +951,10 @@
(let (let
((ch (nth raw i))) ((ch (nth raw i)))
(if (if
(and (= ch "\\") (< (+ i 1) n) (= (nth raw (+ i 1)) "$")) (and
(= ch "\\")
(< (+ i 1) n)
(= (nth raw (+ i 1)) "$"))
(do (do
(set! buf (str buf "$")) (set! buf (str buf "$"))
(set! i (+ i 2)) (set! i (+ i 2))
@@ -907,39 +963,40 @@
(and (= ch "$") (< (+ i 1) n)) (and (= ch "$") (< (+ i 1) n))
(if (if
(= (nth raw (+ i 1)) "{") (= (nth raw (+ i 1)) "{")
(let
((start (+ i 2)))
(let (let
((close (tpl-find-close start 1))) ((start (+ i 2)))
(let (let
((expr-src (slice raw start close))) ((close (tpl-find-close start 1)))
(do (let
(tpl-flush) ((expr-src (slice raw start close)))
(set! (do
parts (tpl-flush)
(append (set!
parts parts
(list (append
(hs-to-sx parts
(hs-compile expr-src))))) (list
(set! i (+ close 1)) (hs-to-sx
(tpl-collect))))) (hs-compile expr-src)))))
(let (set! i (+ close 1))
((start (+ i 1))) (tpl-collect)))))
(let (let
((end (tpl-read-id start))) ((start (+ i 1)))
(let (let
((ident (slice raw start end))) ((end (tpl-read-id start)))
(do (let
(tpl-flush) ((ident (slice raw start end)))
(set! (do
parts (tpl-flush)
(append (set!
parts parts
(list (append
(hs-to-sx (hs-compile ident))))) parts
(set! i end) (list
(tpl-collect)))))) (hs-to-sx
(hs-compile ident)))))
(set! i end)
(tpl-collect))))))
(do (do
(set! buf (str buf ch)) (set! buf (str buf ch))
(set! i (+ i 1)) (set! i (+ i 1))
@@ -983,7 +1040,10 @@
(list (list
(quote hs-pick-random) (quote hs-pick-random)
(hs-to-sx (nth ast 1)) (hs-to-sx (nth ast 1))
(if (nil? (nth ast 2)) nil (hs-to-sx (nth ast 2)))))) (if
(nil? (nth ast 2))
nil
(hs-to-sx (nth ast 2))))))
((= head (quote pick-items)) ((= head (quote pick-items))
(list (list
(quote set!) (quote set!)
@@ -1082,7 +1142,10 @@
(quote hs-method-call) (quote hs-method-call)
(cons (hs-to-sx dot-node) args)))))) (cons (hs-to-sx dot-node) args))))))
((= head (quote string-postfix)) ((= head (quote string-postfix))
(list (quote str) (hs-to-sx (nth ast 1)) (nth ast 2))) (list
(quote str)
(hs-to-sx (nth ast 1))
(nth ast 2)))
((= head (quote block-literal)) ((= head (quote block-literal))
(let (let
((params (map make-symbol (nth ast 1))) ((params (map make-symbol (nth ast 1)))
@@ -1101,10 +1164,11 @@
((= prop "last") (list (quote hs-last) target)) ((= prop "last") (list (quote hs-last) target))
(true (list (quote host-get) target prop))))) (true (list (quote host-get) target prop)))))
((= head (quote ref)) ((= head (quote ref))
(if (cond
(= (nth ast 1) "selection") ((= (nth ast 1) "selection")
(list (quote hs-get-selection)) (list (quote hs-get-selection)))
(make-symbol (nth ast 1)))) ((= (nth ast 1) "element") (make-symbol "me"))
(else (make-symbol (nth ast 1)))))
((= head (quote query)) ((= head (quote query))
(list (quote hs-query-first) (nth ast 1))) (list (quote hs-query-first) (nth ast 1)))
((= head (quote query-scoped)) ((= head (quote query-scoped))
@@ -1133,7 +1197,10 @@
(hs-to-sx (nth ast 1)) (hs-to-sx (nth ast 1))
(nth ast 2))) (nth ast 2)))
((= head (quote local)) ((= head (quote local))
(list (quote hs-scoped-get) (quote me) (nth ast 1))) (list
(quote hs-scoped-get)
(quote me)
(nth ast 1)))
((= head (quote array)) ((= head (quote array))
(cons (quote list) (map hs-to-sx (rest ast)))) (cons (quote list) (map hs-to-sx (rest ast))))
((= head (quote not)) ((= head (quote not))
@@ -1196,7 +1263,8 @@
(list (quote nil?) (hs-to-sx (nth ast 1))))) (list (quote nil?) (hs-to-sx (nth ast 1)))))
((= head (quote matches?)) ((= head (quote matches?))
(let (let
((left (nth ast 1)) (right (nth ast 2))) ((left (nth ast 1))
(right (nth ast 2)))
(if (if
(and (list? right) (= (first right) (quote query))) (and (list? right) (= (first right) (quote query)))
(list (list
@@ -1316,7 +1384,10 @@
"parentElement") "parentElement")
(nth ast 1))) (nth ast 1)))
((= head (quote next)) ((= head (quote next))
(list (quote hs-next) (hs-to-sx (nth ast 2)) (nth ast 1))) (list
(quote hs-next)
(hs-to-sx (nth ast 2))
(nth ast 1)))
((= head (quote previous)) ((= head (quote previous))
(list (list
(quote hs-previous) (quote hs-previous)
@@ -1367,7 +1438,8 @@
(nth ast 2))) (nth ast 2)))
((= head (quote set-styles)) ((= head (quote set-styles))
(let (let
((pairs (nth ast 1)) (tgt (hs-to-sx (nth ast 2)))) ((pairs (nth ast 1))
(tgt (hs-to-sx (nth ast 2))))
(cons (cons
(quote do) (quote do)
(map (map
@@ -1512,7 +1584,8 @@
(list (quote hs-splice-at!) (hs-to-sx coll) idx)))) (list (quote hs-splice-at!) (hs-to-sx coll) idx))))
((and (list? tgt) (= (first tgt) dot-sym)) ((and (list? tgt) (= (first tgt) dot-sym))
(let (let
((obj (nth tgt 1)) (prop (nth tgt 2))) ((obj (nth tgt 1))
(prop (nth tgt 2)))
(emit-set (emit-set
obj obj
(list (list
@@ -1521,7 +1594,8 @@
prop)))) prop))))
((and (list? tgt) (= (first tgt) (quote of))) ((and (list? tgt) (= (first tgt) (quote of)))
(let (let
((prop-ast (nth tgt 1)) (obj-ast (nth tgt 2))) ((prop-ast (nth tgt 1))
(obj-ast (nth tgt 2)))
(let (let
((prop (cond ((string? prop-ast) prop-ast) ((and (list? prop-ast) (= (first prop-ast) (quote ref))) (nth prop-ast 1)) (true (hs-to-sx prop-ast))))) ((prop (cond ((string? prop-ast) prop-ast) ((and (list? prop-ast) (= (first prop-ast) (quote ref))) (nth prop-ast 1)) (true (hs-to-sx prop-ast)))))
(emit-set (emit-set
@@ -1533,7 +1607,8 @@
(true (list (quote dom-remove) (hs-to-sx tgt)))))) (true (list (quote dom-remove) (hs-to-sx tgt))))))
((= head (quote add-value)) ((= head (quote add-value))
(let (let
((val (hs-to-sx (nth ast 1))) (tgt (nth ast 2))) ((val (hs-to-sx (nth ast 1)))
(tgt (nth ast 2)))
(emit-set (emit-set
tgt tgt
(list (quote hs-add-to!) val (hs-to-sx tgt))))) (list (quote hs-add-to!) val (hs-to-sx tgt)))))
@@ -1547,7 +1622,8 @@
(hs-to-sx (nth ast 2))))) (hs-to-sx (nth ast 2)))))
((= head (quote remove-value)) ((= head (quote remove-value))
(let (let
((val (hs-to-sx (nth ast 1))) (tgt (nth ast 2))) ((val (hs-to-sx (nth ast 1)))
(tgt (nth ast 2)))
(emit-set (emit-set
tgt tgt
(list (quote hs-remove-from!) val (hs-to-sx tgt))))) (list (quote hs-remove-from!) val (hs-to-sx tgt)))))
@@ -1562,7 +1638,10 @@
((and (list? tgt) (= (first tgt) (quote query))) ((and (list? tgt) (= (first tgt) (quote query)))
(list (list
(quote for-each) (quote for-each)
(list (quote fn) (list (quote _el)) (list (quote hs-empty-target!) (quote _el))) (list
(quote fn)
(list (quote _el))
(list (quote hs-empty-target!) (quote _el)))
(list (quote hs-query-all) (nth tgt 1)))) (list (quote hs-query-all) (nth tgt 1))))
(true (list (quote hs-empty-target!) (hs-to-sx tgt)))))) (true (list (quote hs-empty-target!) (hs-to-sx tgt))))))
((= head (quote open-element)) ((= head (quote open-element))
@@ -1710,7 +1789,9 @@
(nth ast 3) (nth ast 3)
(hs-to-sx (nth ast 4)))) (hs-to-sx (nth ast 4))))
((= head (quote set!)) ((= head (quote set!))
(emit-set (nth ast 1) (hs-to-sx (nth ast 2)))) (emit-set
(nth ast 1)
(hs-to-sx (nth ast 2))))
((= head (quote put!)) ((= head (quote put!))
(let (let
((val (hs-to-sx (nth ast 1))) ((val (hs-to-sx (nth ast 1)))
@@ -1800,7 +1881,8 @@
(= (first c) (quote define))))) (= (first c) (quote define)))))
compiled))) compiled)))
(cons (quote do) (append defs non-defs))))))) (cons (quote do) (append defs non-defs)))))))
((= head (quote wait)) (list (quote hs-wait) (nth ast 1))) ((= head (quote wait))
(list (quote hs-wait) (nth ast 1)))
((= head (quote wait-for)) (emit-wait-for ast)) ((= head (quote wait-for)) (emit-wait-for ast))
((= head (quote log)) ((= head (quote log))
(list (quote console-log) (hs-to-sx (nth ast 1)))) (list (quote console-log) (hs-to-sx (nth ast 1))))
@@ -1813,8 +1895,16 @@
(= (len ast) 4) (= (len ast) 4)
(list? (nth ast 2)) (list? (nth ast 2))
(= (first (nth ast 2)) (quote dict)))) (= (first (nth ast 2)) (quote dict))))
(tgt (if (= (len ast) 4) (nth ast 3) (nth ast 2))) (tgt
(detail (if (= (len ast) 4) (nth ast 2) nil))) (if
(= (len ast) 4)
(nth ast 3)
(nth ast 2)))
(detail
(if
(= (len ast) 4)
(nth ast 2)
nil)))
(list (list
(quote dom-dispatch) (quote dom-dispatch)
(hs-to-sx tgt) (hs-to-sx tgt)
@@ -1823,8 +1913,16 @@
((= head (quote hide)) ((= head (quote hide))
(let (let
((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt)))) ((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt))))
(strategy (if (> (len ast) 2) (nth ast 2) "display")) (strategy
(when-cond (if (> (len ast) 3) (nth ast 3) nil))) (if
(> (len ast) 2)
(nth ast 2)
"display"))
(when-cond
(if
(> (len ast) 3)
(nth ast 3)
nil)))
(if (if
(nil? when-cond) (nil? when-cond)
(list (quote hs-hide!) tgt strategy) (list (quote hs-hide!) tgt strategy)
@@ -1839,8 +1937,16 @@
((= head (quote show)) ((= head (quote show))
(let (let
((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt)))) ((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt))))
(strategy (if (> (len ast) 2) (nth ast 2) "display")) (strategy
(when-cond (if (> (len ast) 3) (nth ast 3) nil))) (if
(> (len ast) 2)
(nth ast 2)
"display"))
(when-cond
(if
(> (len ast) 3)
(nth ast 3)
nil)))
(if (if
(nil? when-cond) (nil? when-cond)
(list (quote hs-show!) tgt strategy) (list (quote hs-show!) tgt strategy)
@@ -1884,23 +1990,41 @@
((= head (quote repeat-until)) ((= head (quote repeat-until))
(list (list
(quote hs-repeat-until) (quote hs-repeat-until)
(list (quote fn) (list) (hs-to-sx (nth ast 1))) (list
(list (quote fn) (list) (hs-to-sx (nth ast 2))))) (quote fn)
(list)
(hs-to-sx (nth ast 1)))
(list
(quote fn)
(list)
(hs-to-sx (nth ast 2)))))
((= head (quote repeat-while)) ((= head (quote repeat-while))
(list (list
(quote hs-repeat-while) (quote hs-repeat-while)
(list (quote fn) (list) (hs-to-sx (nth ast 1))) (list
(list (quote fn) (list) (hs-to-sx (nth ast 2))))) (quote fn)
(list)
(hs-to-sx (nth ast 1)))
(list
(quote fn)
(list)
(hs-to-sx (nth ast 2)))))
((= head (quote fetch)) ((= head (quote fetch))
(list (list
(if (nth ast 3) (quote hs-fetch-no-throw) (quote hs-fetch)) (if
(nth ast 3)
(quote hs-fetch-no-throw)
(quote hs-fetch))
(hs-to-sx (nth ast 1)) (hs-to-sx (nth ast 1))
(nth ast 2))) (nth ast 2)))
((= head (quote fetch-gql)) ((= head (quote fetch-gql))
(list (list
(quote hs-fetch-gql) (quote hs-fetch-gql)
(nth ast 1) (nth ast 1)
(if (nth ast 2) (hs-to-sx (nth ast 2)) nil))) (if
(nth ast 2)
(hs-to-sx (nth ast 2))
nil)))
((= head (quote call)) ((= head (quote call))
(let (let
((raw-fn (nth ast 1)) ((raw-fn (nth ast 1))
@@ -1911,14 +2035,7 @@
(hs-to-sx raw-fn))) (hs-to-sx raw-fn)))
(args (map hs-to-sx (rest (rest ast))))) (args (map hs-to-sx (rest (rest ast)))))
(let (let
((call-expr ((call-expr (if (and (list? raw-fn) (= (first raw-fn) (quote ref))) (list (quote hs-win-call) (nth raw-fn 1) (cons (quote list) args)) (cons fn-expr args))))
(if
(and (list? raw-fn) (= (first raw-fn) (quote ref)))
(list
(quote hs-win-call)
(nth raw-fn 1)
(cons (quote list) args))
(cons fn-expr args))))
(emit-set (quote the-result) call-expr)))) (emit-set (quote the-result) call-expr))))
((= head (quote return)) ((= head (quote return))
(let (let
@@ -1936,7 +2053,9 @@
((= head (quote settle)) ((= head (quote settle))
(list (quote hs-settle) (quote me))) (list (quote hs-settle) (quote me)))
((= head (quote go)) ((= head (quote go))
(list (quote hs-navigate!) (hs-to-sx (nth ast 1)))) (list
(quote hs-navigate!)
(hs-to-sx (nth ast 1))))
((= head (quote ask)) ((= head (quote ask))
(let (let
((val (list (quote hs-ask) (hs-to-sx (nth ast 1))))) ((val (list (quote hs-ask) (hs-to-sx (nth ast 1)))))
@@ -2022,17 +2141,35 @@
(let (let
((kind (nth ast 1)) ((kind (nth ast 1))
(name (nth ast 2)) (name (nth ast 2))
(from-sel (if (> (len ast) 3) (nth ast 3) nil)) (from-sel
(for-tgt (if (> (len ast) 4) (nth ast 4) nil)) (if
(attr-val (if (> (len ast) 5) (nth ast 5) nil)) (> (len ast) 3)
(with-val (if (> (len ast) 6) (nth ast 6) nil))) (nth ast 3)
nil))
(for-tgt
(if
(> (len ast) 4)
(nth ast 4)
nil))
(attr-val
(if
(> (len ast) 5)
(nth ast 5)
nil))
(with-val
(if
(> (len ast) 6)
(nth ast 6)
nil)))
(let (let
((target (if for-tgt (hs-to-sx for-tgt) (quote me))) ((target (if for-tgt (hs-to-sx for-tgt) (quote me)))
(scope (scope
(cond (cond
((nil? from-sel) nil) ((nil? from-sel) nil)
((and (list? from-sel) (= (first from-sel) (quote query))) ((and (list? from-sel) (= (first from-sel) (quote query)))
(list (quote hs-query-all) (nth from-sel 1))) (list
(quote hs-query-all)
(nth from-sel 1)))
(true (hs-to-sx from-sel)))) (true (hs-to-sx from-sel))))
(with-sx (with-sx
(if (if
@@ -2064,13 +2201,31 @@
(true (list (quote hs-take!) target kind name scope)))))) (true (list (quote hs-take!) target kind name scope))))))
((= head (quote make)) (emit-make ast)) ((= head (quote make)) (emit-make ast))
((= head (quote install)) ((= head (quote install))
(cons (quote hs-install) (map hs-to-sx (rest ast)))) (let
((bname (nth ast 1)))
(cons
(make-symbol bname)
(cons
(quote me)
(map
(fn
(arg)
(if
(and
(list? arg)
(= (first arg) (quote type-assert)))
(+ (nth arg 2) 0)
(hs-to-sx arg)))
(rest (rest ast)))))))
((= head (quote measure)) ((= head (quote measure))
(list (quote hs-measure) (hs-to-sx (nth ast 1)))) (list (quote hs-measure) (hs-to-sx (nth ast 1))))
((= head (quote increment!)) ((= head (quote increment!))
(if (if
(= (len ast) 3) (= (len ast) 3)
(emit-inc (nth ast 1) 1 (nth ast 2)) (emit-inc
(nth ast 1)
1
(nth ast 2))
(emit-inc (emit-inc
(nth ast 1) (nth ast 1)
(nth ast 2) (nth ast 2)
@@ -2078,7 +2233,10 @@
((= head (quote decrement!)) ((= head (quote decrement!))
(if (if
(= (len ast) 3) (= (len ast) 3)
(emit-dec (nth ast 1) 1 (nth ast 2)) (emit-dec
(nth ast 1)
1
(nth ast 2))
(emit-dec (emit-dec
(nth ast 1) (nth ast 1)
(nth ast 2) (nth ast 2)
@@ -2092,7 +2250,8 @@
((= head (quote on)) (emit-on ast)) ((= head (quote on)) (emit-on ast))
((= head (quote when-changes)) ((= head (quote when-changes))
(let (let
((expr (nth ast 1)) (body (nth ast 2))) ((expr (nth ast 1))
(body (nth ast 2)))
(if (if
(and (list? expr) (= (first expr) (quote dom-ref))) (and (list? expr) (= (first expr) (quote dom-ref)))
(list (list
@@ -2104,7 +2263,10 @@
((= head (quote init)) ((= head (quote init))
(list (list
(quote hs-init) (quote hs-init)
(list (quote fn) (list) (hs-to-sx (nth ast 1))))) (list
(quote fn)
(list)
(hs-to-sx (nth ast 1)))))
((= head (quote def)) ((= head (quote def))
(let (let
((body (hs-to-sx (nth ast 3))) ((body (hs-to-sx (nth ast 3)))
@@ -2143,7 +2305,10 @@
(quote =) (quote =)
(list (quote first) (quote _e)) (list (quote first) (quote _e))
"hs-return")) "hs-return"))
(list (quote nth) (quote _e) 1) (list
(quote nth)
(quote _e)
1)
(list (quote raise) (quote _e))))) (list (quote raise) (quote _e)))))
body)))) body))))
(list (list
@@ -2162,14 +2327,22 @@
(string? src) (string? src)
(first (sx-parse src)) (first (sx-parse src))
(list (quote cek-eval) (hs-to-sx src))))) (list (quote cek-eval) (hs-to-sx src)))))
((= head (quote component)) (make-symbol (nth ast 1))) ((= head (quote component))
(make-symbol (nth ast 1)))
((= head (quote render)) ((= head (quote render))
(let (let
((comp-raw (nth ast 1)) ((comp-raw (nth ast 1))
(kwargs (nth ast 2)) (kwargs (nth ast 2))
(pos (if (> (len ast) 3) (nth ast 3) nil)) (pos
(if
(> (len ast) 3)
(nth ast 3)
nil))
(target (target
(if (> (len ast) 4) (hs-to-sx (nth ast 4)) nil))) (if
(> (len ast) 4)
(hs-to-sx (nth ast 4))
nil)))
(let (let
((comp (if (string? comp-raw) (make-symbol comp-raw) (hs-to-sx comp-raw)))) ((comp (if (string? comp-raw) (make-symbol comp-raw) (hs-to-sx comp-raw))))
(define (define
@@ -2266,7 +2439,9 @@
((and (list? raw-tgt) (= (first raw-tgt) (quote query))) ((and (list? raw-tgt) (= (first raw-tgt) (quote query)))
(list (list
(quote hs-reset!) (quote hs-reset!)
(list (quote hs-query-all) (nth raw-tgt 1)))) (list
(quote hs-query-all)
(nth raw-tgt 1))))
(true (list (quote hs-reset!) (hs-to-sx raw-tgt)))))) (true (list (quote hs-reset!) (hs-to-sx raw-tgt))))))
((= head (quote default!)) ((= head (quote default!))
(let (let
@@ -2292,7 +2467,8 @@
(list (quote dom-focus) (hs-to-sx (nth ast 1)))) (list (quote dom-focus) (hs-to-sx (nth ast 1))))
((= head (quote js-block)) ((= head (quote js-block))
(let (let
((params (nth ast 1)) (js-src (nth ast 2))) ((params (nth ast 1))
(js-src (nth ast 2)))
(let (let
((bound-syms (map (fn (p) (make-symbol p)) params))) ((bound-syms (map (fn (p) (make-symbol p)) params)))
(list (list

View File

@@ -77,26 +77,51 @@
;; Marks the element to avoid double-activation. ;; Marks the element to avoid double-activation.
(define (define
hs-activate! hs-register-scripts!
(fn (fn
(el) ()
(let (for-each
((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script"))) (fn
(when (script)
(and src (not (= src prev)))
(when (when
(dom-dispatch el "hyperscript:before:init" nil) (not (dom-get-data script "hs-script-loaded"))
(hs-log-event! "hyperscript:init") (let
(dom-set-data el "hs-script" src) ((src (host-get script "innerHTML")))
(dom-set-data el "hs-active" true) (when
(dom-set-attr el "data-hyperscript-powered" "true") (and src (not (= src "")))
(let ((handler (hs-handler src))) (handler el)) (guard
(dom-dispatch el "hyperscript:after:init" nil)))))) (_e (true nil))
(eval-expr-cek (hs-to-sx-from-source src)))
(dom-set-data script "hs-script-loaded" true)))))
(hs-query-all "script[type=text/hyperscript]"))))
;; ── Boot: scan entire document ────────────────────────────────── ;; ── Boot: scan entire document ──────────────────────────────────
;; Called once at page load. Finds all elements with _ attribute, ;; Called once at page load. Finds all elements with _ attribute,
;; compiles their hyperscript, and activates them. ;; compiles their hyperscript, and activates them.
(define
hs-activate!
(fn
(el)
(do
(hs-register-scripts!)
(let
((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script")))
(when
(and src (not (= src prev)))
(when
(dom-dispatch el "hyperscript:before:init" nil)
(hs-log-event! "hyperscript:init")
(dom-set-data el "hs-script" src)
(dom-set-data el "hs-active" true)
(dom-set-attr el "data-hyperscript-powered" "true")
(let ((handler (hs-handler src))) (handler el))
(dom-dispatch el "hyperscript:after:init" nil)))))))
;; ── Boot subtree: for dynamic content ───────────────────────────
;; Called after HTMX swaps or dynamic DOM insertion.
;; Only activates elements within the given root.
(define (define
hs-deactivate! hs-deactivate!
(fn (fn
@@ -108,10 +133,6 @@
(dom-set-data el "hs-active" false) (dom-set-data el "hs-active" false)
(dom-set-data el "hs-script" nil)))) (dom-set-data el "hs-script" nil))))
;; ── Boot subtree: for dynamic content ───────────────────────────
;; Called after HTMX swaps or dynamic DOM insertion.
;; Only activates elements within the given root.
(define (define
hs-boot! hs-boot!
(fn (fn