|
|
|
|
@@ -45,6 +45,11 @@
|
|
|
|
|
;; (hs-init thunk) — called at element boot time
|
|
|
|
|
(define meta (host-new "Object"))
|
|
|
|
|
|
|
|
|
|
;; ── Async / timing ──────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Wait for a duration in milliseconds.
|
|
|
|
|
;; In hyperscript, wait is async-transparent — execution pauses.
|
|
|
|
|
;; Here we use perform/IO suspension for true pause semantics.
|
|
|
|
|
(define
|
|
|
|
|
_hs-on-caller
|
|
|
|
|
(let
|
|
|
|
|
@@ -57,6 +62,8 @@
|
|
|
|
|
(host-set! _ctx "meta" _m)
|
|
|
|
|
_ctx)))
|
|
|
|
|
|
|
|
|
|
;; Wait for a DOM event on a target.
|
|
|
|
|
;; (hs-wait-for target event-name) — suspends until event fires
|
|
|
|
|
(define
|
|
|
|
|
hs-on
|
|
|
|
|
(fn
|
|
|
|
|
@@ -69,17 +76,14 @@
|
|
|
|
|
(dom-set-data target "hs-unlisteners" (append prev (list unlisten)))
|
|
|
|
|
unlisten))))
|
|
|
|
|
|
|
|
|
|
;; ── Async / timing ──────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Wait for a duration in milliseconds.
|
|
|
|
|
;; In hyperscript, wait is async-transparent — execution pauses.
|
|
|
|
|
;; Here we use perform/IO suspension for true pause semantics.
|
|
|
|
|
;; Wait for CSS transitions/animations to settle on an element.
|
|
|
|
|
(define
|
|
|
|
|
hs-on-every
|
|
|
|
|
(fn (target event-name handler) (dom-listen target event-name handler)))
|
|
|
|
|
|
|
|
|
|
;; Wait for a DOM event on a target.
|
|
|
|
|
;; (hs-wait-for target event-name) — suspends until event fires
|
|
|
|
|
;; ── Class manipulation ──────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Toggle a single class on an element.
|
|
|
|
|
(define
|
|
|
|
|
hs-on-intersection-attach!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -95,7 +99,7 @@
|
|
|
|
|
(host-call observer "observe" target)
|
|
|
|
|
observer)))))
|
|
|
|
|
|
|
|
|
|
;; Wait for CSS transitions/animations to settle on an element.
|
|
|
|
|
;; Toggle between two classes — exactly one is active at a time.
|
|
|
|
|
(define
|
|
|
|
|
hs-on-mutation-attach!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -116,16 +120,19 @@
|
|
|
|
|
(host-call observer "observe" target opts)
|
|
|
|
|
observer))))))
|
|
|
|
|
|
|
|
|
|
;; ── Class manipulation ──────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Toggle a single class on an element.
|
|
|
|
|
(define hs-init (fn (thunk) (thunk)))
|
|
|
|
|
|
|
|
|
|
;; Toggle between two classes — exactly one is active at a time.
|
|
|
|
|
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
|
|
|
|
|
|
|
|
|
|
;; Take a class from siblings — add to target, remove from others.
|
|
|
|
|
;; (hs-take! target cls) — like radio button class behavior
|
|
|
|
|
(define hs-init (fn (thunk) (thunk)))
|
|
|
|
|
|
|
|
|
|
;; ── DOM insertion ───────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Put content at a position relative to a target.
|
|
|
|
|
;; pos: "into" | "before" | "after"
|
|
|
|
|
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
|
|
|
|
|
|
|
|
|
|
;; ── Navigation / traversal ──────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Navigate to a URL.
|
|
|
|
|
(begin
|
|
|
|
|
(define
|
|
|
|
|
hs-wait-for
|
|
|
|
|
@@ -138,20 +145,15 @@
|
|
|
|
|
(target event-name timeout-ms)
|
|
|
|
|
(perform (list (quote io-wait-event) target event-name timeout-ms)))))
|
|
|
|
|
|
|
|
|
|
;; ── DOM insertion ───────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Put content at a position relative to a target.
|
|
|
|
|
;; pos: "into" | "before" | "after"
|
|
|
|
|
;; Find next sibling matching a selector (or any sibling).
|
|
|
|
|
(define hs-settle (fn (target) (perform (list (quote io-settle) target))))
|
|
|
|
|
|
|
|
|
|
;; ── Navigation / traversal ──────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Navigate to a URL.
|
|
|
|
|
;; Find previous sibling matching a selector.
|
|
|
|
|
(define
|
|
|
|
|
hs-toggle-class!
|
|
|
|
|
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
|
|
|
|
|
|
|
|
|
|
;; Find next sibling matching a selector (or any sibling).
|
|
|
|
|
;; First element matching selector within a scope.
|
|
|
|
|
(define
|
|
|
|
|
hs-toggle-between!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -161,7 +163,7 @@
|
|
|
|
|
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
|
|
|
|
(do (dom-remove-class target cls2) (dom-add-class target cls1)))))
|
|
|
|
|
|
|
|
|
|
;; Find previous sibling matching a selector.
|
|
|
|
|
;; Last element matching selector.
|
|
|
|
|
(define
|
|
|
|
|
hs-toggle-style!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -185,7 +187,7 @@
|
|
|
|
|
(dom-set-style target prop "hidden")
|
|
|
|
|
(dom-set-style target prop "")))))))
|
|
|
|
|
|
|
|
|
|
;; First element matching selector within a scope.
|
|
|
|
|
;; First/last within a specific scope.
|
|
|
|
|
(define
|
|
|
|
|
hs-toggle-style-between!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -197,7 +199,6 @@
|
|
|
|
|
(dom-set-style target prop val2)
|
|
|
|
|
(dom-set-style target prop val1)))))
|
|
|
|
|
|
|
|
|
|
;; Last element matching selector.
|
|
|
|
|
(define
|
|
|
|
|
hs-toggle-style-cycle!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -218,7 +219,9 @@
|
|
|
|
|
(true (find-next (rest remaining))))))
|
|
|
|
|
(dom-set-style target prop (find-next vals)))))
|
|
|
|
|
|
|
|
|
|
;; First/last within a specific scope.
|
|
|
|
|
;; ── Iteration ───────────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Repeat a thunk N times.
|
|
|
|
|
(define
|
|
|
|
|
hs-take!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -258,6 +261,7 @@
|
|
|
|
|
(dom-set-attr target name attr-val)
|
|
|
|
|
(dom-set-attr target name ""))))))))
|
|
|
|
|
|
|
|
|
|
;; Repeat forever (until break — relies on exception/continuation).
|
|
|
|
|
(begin
|
|
|
|
|
(define
|
|
|
|
|
hs-element?
|
|
|
|
|
@@ -369,9 +373,10 @@
|
|
|
|
|
(dom-insert-adjacent-html target "beforeend" value)
|
|
|
|
|
(hs-boot-subtree! target)))))))))
|
|
|
|
|
|
|
|
|
|
;; ── Iteration ───────────────────────────────────────────────────
|
|
|
|
|
;; ── Fetch ───────────────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Repeat a thunk N times.
|
|
|
|
|
;; Fetch a URL, parse response according to format.
|
|
|
|
|
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
|
|
|
|
(define
|
|
|
|
|
hs-add-to!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -384,7 +389,10 @@
|
|
|
|
|
(append target (list value))))
|
|
|
|
|
(true (do (host-call target "push" value) target)))))
|
|
|
|
|
|
|
|
|
|
;; Repeat forever (until break — relies on exception/continuation).
|
|
|
|
|
;; ── Type coercion ───────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Coerce a value to a type by name.
|
|
|
|
|
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
|
|
|
|
(define
|
|
|
|
|
hs-remove-from!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -394,10 +402,10 @@
|
|
|
|
|
(filter (fn (x) (not (= x value))) target)
|
|
|
|
|
(host-call target "splice" (host-call target "indexOf" value) 1))))
|
|
|
|
|
|
|
|
|
|
;; ── Fetch ───────────────────────────────────────────────────────
|
|
|
|
|
;; ── Object creation ─────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Fetch a URL, parse response according to format.
|
|
|
|
|
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
|
|
|
|
;; Make a new object of a given type.
|
|
|
|
|
;; (hs-make type-name) — creates empty object/collection
|
|
|
|
|
(define
|
|
|
|
|
hs-splice-at!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -421,10 +429,11 @@
|
|
|
|
|
(host-call target "splice" i 1))))
|
|
|
|
|
target))))
|
|
|
|
|
|
|
|
|
|
;; ── Type coercion ───────────────────────────────────────────────
|
|
|
|
|
;; ── Behavior installation ───────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Coerce a value to a type by name.
|
|
|
|
|
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
|
|
|
|
;; Install a behavior on an element.
|
|
|
|
|
;; A behavior is a function that takes (me ...params) and sets up features.
|
|
|
|
|
;; (hs-install behavior-fn me ...args)
|
|
|
|
|
(define
|
|
|
|
|
hs-index
|
|
|
|
|
(fn
|
|
|
|
|
@@ -436,10 +445,10 @@
|
|
|
|
|
((string? obj) (nth obj key))
|
|
|
|
|
(true (host-get obj key)))))
|
|
|
|
|
|
|
|
|
|
;; ── Object creation ─────────────────────────────────────────────
|
|
|
|
|
;; ── Measurement ─────────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Make a new object of a given type.
|
|
|
|
|
;; (hs-make type-name) — creates empty object/collection
|
|
|
|
|
;; Measure an element's bounding rect, store as local variables.
|
|
|
|
|
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
|
|
|
|
(define
|
|
|
|
|
hs-put-at!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -461,11 +470,10 @@
|
|
|
|
|
((= pos "start") (host-call target "unshift" value)))
|
|
|
|
|
target)))))))
|
|
|
|
|
|
|
|
|
|
;; ── Behavior installation ───────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Install a behavior on an element.
|
|
|
|
|
;; A behavior is a function that takes (me ...params) and sets up features.
|
|
|
|
|
;; (hs-install behavior-fn me ...args)
|
|
|
|
|
;; Return the current text selection as a string. In the browser this is
|
|
|
|
|
;; `window.getSelection().toString()`. In the mock test runner, a test
|
|
|
|
|
;; setup stashes the desired selection text at `window.__test_selection`
|
|
|
|
|
;; and the fallback path returns that so tests can assert on the result.
|
|
|
|
|
(define
|
|
|
|
|
hs-dict-without
|
|
|
|
|
(fn
|
|
|
|
|
@@ -486,27 +494,19 @@
|
|
|
|
|
(host-call (host-global "Reflect") "deleteProperty" out key)
|
|
|
|
|
out)))))
|
|
|
|
|
|
|
|
|
|
;; ── Measurement ─────────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Measure an element's bounding rect, store as local variables.
|
|
|
|
|
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
|
|
|
|
;; ── Transition ──────────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Transition a CSS property to a value, optionally with duration.
|
|
|
|
|
;; (hs-transition target prop value duration)
|
|
|
|
|
(define
|
|
|
|
|
hs-set-on!
|
|
|
|
|
(fn
|
|
|
|
|
(props target)
|
|
|
|
|
(for-each (fn (k) (host-set! target k (get props k))) (keys props))))
|
|
|
|
|
|
|
|
|
|
;; Return the current text selection as a string. In the browser this is
|
|
|
|
|
;; `window.getSelection().toString()`. In the mock test runner, a test
|
|
|
|
|
;; setup stashes the desired selection text at `window.__test_selection`
|
|
|
|
|
;; and the fallback path returns that so tests can assert on the result.
|
|
|
|
|
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; ── Transition ──────────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Transition a CSS property to a value, optionally with duration.
|
|
|
|
|
;; (hs-transition target prop value duration)
|
|
|
|
|
(define
|
|
|
|
|
hs-ask
|
|
|
|
|
(fn
|
|
|
|
|
@@ -645,6 +645,10 @@
|
|
|
|
|
(true (find-next (dom-next-sibling el))))))
|
|
|
|
|
(find-next sibling)))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-previous
|
|
|
|
|
(fn
|
|
|
|
|
@@ -667,11 +671,8 @@
|
|
|
|
|
(define
|
|
|
|
|
hs-query-all
|
|
|
|
|
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; ── Sandbox/test runtime additions ──────────────────────────────
|
|
|
|
|
;; Property access — dot notation and .length
|
|
|
|
|
(define
|
|
|
|
|
hs-query-all-in
|
|
|
|
|
(fn
|
|
|
|
|
@@ -680,22 +681,23 @@
|
|
|
|
|
(nil? target)
|
|
|
|
|
(hs-query-all sel)
|
|
|
|
|
(host-call target "querySelectorAll" sel))))
|
|
|
|
|
|
|
|
|
|
;; DOM query stub — sandbox returns empty list
|
|
|
|
|
(define
|
|
|
|
|
hs-list-set
|
|
|
|
|
(fn
|
|
|
|
|
(lst idx val)
|
|
|
|
|
(append (take lst idx) (cons val (drop lst (+ idx 1))))))
|
|
|
|
|
;; ── Sandbox/test runtime additions ──────────────────────────────
|
|
|
|
|
;; Property access — dot notation and .length
|
|
|
|
|
;; Method dispatch — obj.method(args)
|
|
|
|
|
(define
|
|
|
|
|
hs-to-number
|
|
|
|
|
(fn (v) (if (number? v) v (or (parse-number (str v)) 0))))
|
|
|
|
|
;; DOM query stub — sandbox returns empty list
|
|
|
|
|
|
|
|
|
|
;; ── 0.9.90 features ─────────────────────────────────────────────
|
|
|
|
|
;; beep! — debug logging, returns value unchanged
|
|
|
|
|
(define
|
|
|
|
|
hs-query-first
|
|
|
|
|
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
|
|
|
|
;; Method dispatch — obj.method(args)
|
|
|
|
|
;; Property-based is — check obj.key truthiness
|
|
|
|
|
(define
|
|
|
|
|
hs-query-last
|
|
|
|
|
(fn
|
|
|
|
|
@@ -703,11 +705,9 @@
|
|
|
|
|
(let
|
|
|
|
|
((all (dom-query-all (dom-body) sel)))
|
|
|
|
|
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
|
|
|
|
|
|
|
|
|
;; ── 0.9.90 features ─────────────────────────────────────────────
|
|
|
|
|
;; beep! — debug logging, returns value unchanged
|
|
|
|
|
;; Array slicing (inclusive both ends)
|
|
|
|
|
(define hs-first (fn (scope sel) (dom-query-all scope sel)))
|
|
|
|
|
;; Property-based is — check obj.key truthiness
|
|
|
|
|
;; Collection: sorted by
|
|
|
|
|
(define
|
|
|
|
|
hs-last
|
|
|
|
|
(fn
|
|
|
|
|
@@ -715,7 +715,7 @@
|
|
|
|
|
(let
|
|
|
|
|
((all (dom-query-all scope sel)))
|
|
|
|
|
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
|
|
|
|
;; Array slicing (inclusive both ends)
|
|
|
|
|
;; Collection: sorted by descending
|
|
|
|
|
(define
|
|
|
|
|
hs-repeat-times
|
|
|
|
|
(fn
|
|
|
|
|
@@ -733,7 +733,7 @@
|
|
|
|
|
((= signal "hs-continue") (do-repeat (+ i 1)))
|
|
|
|
|
(true (do-repeat (+ i 1))))))))
|
|
|
|
|
(do-repeat 0)))
|
|
|
|
|
;; Collection: sorted by
|
|
|
|
|
;; Collection: split by
|
|
|
|
|
(define
|
|
|
|
|
hs-repeat-forever
|
|
|
|
|
(fn
|
|
|
|
|
@@ -749,7 +749,7 @@
|
|
|
|
|
((= signal "hs-continue") (do-forever))
|
|
|
|
|
(true (do-forever))))))
|
|
|
|
|
(do-forever)))
|
|
|
|
|
;; Collection: sorted by descending
|
|
|
|
|
;; Collection: joined by
|
|
|
|
|
(define
|
|
|
|
|
hs-repeat-while
|
|
|
|
|
(fn
|
|
|
|
|
@@ -762,7 +762,7 @@
|
|
|
|
|
((= signal "hs-break") nil)
|
|
|
|
|
((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
|
|
|
|
|
(true (hs-repeat-while cond-fn thunk)))))))
|
|
|
|
|
;; Collection: split by
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-repeat-until
|
|
|
|
|
(fn
|
|
|
|
|
@@ -774,13 +774,13 @@
|
|
|
|
|
((= signal "hs-continue")
|
|
|
|
|
(if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
|
|
|
|
|
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
|
|
|
|
|
;; Collection: joined by
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-for-each
|
|
|
|
|
(fn
|
|
|
|
|
(fn-body collection)
|
|
|
|
|
(let
|
|
|
|
|
((items (cond ((list? collection) collection) ((dict? collection) (if (dict-has? collection "_order") (get collection "_order") (filter (fn (k) (not (= k "_order"))) (keys collection)))) ((nil? collection) (list)) (true (list)))))
|
|
|
|
|
((items (cond ((list? collection) collection) ((nil? collection) (list)) ((host-iter? collection) (host-to-list collection)) ((dict? collection) (if (dict-has? collection "_order") (get collection "_order") (filter (fn (k) (not (= k "_order"))) (keys collection)))) (true (list)))))
|
|
|
|
|
(define
|
|
|
|
|
do-loop
|
|
|
|
|
(fn
|
|
|
|
|
@@ -2525,6 +2525,8 @@
|
|
|
|
|
((nth entry 2) val)))
|
|
|
|
|
_hs-dom-watchers)))
|
|
|
|
|
|
|
|
|
|
;; ── SourceInfo API ────────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-dom-is-ancestor?
|
|
|
|
|
(fn
|
|
|
|
|
@@ -2540,8 +2542,6 @@
|
|
|
|
|
(fn-name args)
|
|
|
|
|
(let ((fn (host-global fn-name))) (if fn (host-call-fn fn args) nil))))
|
|
|
|
|
|
|
|
|
|
;; ── SourceInfo API ────────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-source-for
|
|
|
|
|
(fn
|
|
|
|
|
@@ -2557,16 +2557,9 @@
|
|
|
|
|
(line-idx (- (get node :line) 1)))
|
|
|
|
|
(if (< line-idx (len lines)) (nth lines line-idx) ""))))
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-node-get
|
|
|
|
|
(fn
|
|
|
|
|
(node key)
|
|
|
|
|
(get (get node :fields) key)))
|
|
|
|
|
(define hs-node-get (fn (node key) (get (get node :fields) key)))
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-src
|
|
|
|
|
(fn (src-str)
|
|
|
|
|
(hs-source-for (hs-parse-ast src-str))))
|
|
|
|
|
(define hs-src (fn (src-str) (hs-source-for (hs-parse-ast src-str))))
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-src-at
|
|
|
|
|
@@ -2576,7 +2569,8 @@
|
|
|
|
|
walk
|
|
|
|
|
(fn
|
|
|
|
|
(node keys)
|
|
|
|
|
(if (or (nil? keys) (= (len keys) 0))
|
|
|
|
|
(if
|
|
|
|
|
(or (nil? keys) (= (len keys) 0))
|
|
|
|
|
node
|
|
|
|
|
(walk (hs-node-get node (first keys)) (rest keys)))))
|
|
|
|
|
(hs-source-for (walk (hs-parse-ast src-str) path))))
|
|
|
|
|
@@ -2589,7 +2583,8 @@
|
|
|
|
|
walk
|
|
|
|
|
(fn
|
|
|
|
|
(node keys)
|
|
|
|
|
(if (or (nil? keys) (= (len keys) 0))
|
|
|
|
|
(if
|
|
|
|
|
(or (nil? keys) (= (len keys) 0))
|
|
|
|
|
node
|
|
|
|
|
(walk (hs-node-get node (first keys)) (rest keys)))))
|
|
|
|
|
(hs-line-for (walk (hs-parse-ast src-str) path))))
|
|
|
|
|
|