|
|
|
|
@@ -12,6 +12,29 @@
|
|
|
|
|
|
|
|
|
|
;; Register an event listener. Returns unlisten function.
|
|
|
|
|
;; (hs-on target event-name handler) → unlisten-fn
|
|
|
|
|
(begin
|
|
|
|
|
(define _hs-config-log-all false)
|
|
|
|
|
(define _hs-log-captured (list))
|
|
|
|
|
(define
|
|
|
|
|
hs-set-log-all!
|
|
|
|
|
(fn (flag) (set! _hs-config-log-all (if flag true false))))
|
|
|
|
|
(define hs-get-log-captured (fn () _hs-log-captured))
|
|
|
|
|
(define
|
|
|
|
|
hs-clear-log-captured!
|
|
|
|
|
(fn () (begin (set! _hs-log-captured (list)) nil)))
|
|
|
|
|
(define
|
|
|
|
|
hs-log-event!
|
|
|
|
|
(fn
|
|
|
|
|
(msg)
|
|
|
|
|
(when
|
|
|
|
|
_hs-config-log-all
|
|
|
|
|
(begin
|
|
|
|
|
(set! _hs-log-captured (append _hs-log-captured (list msg)))
|
|
|
|
|
(host-call (host-global "console") "log" msg)
|
|
|
|
|
nil)))))
|
|
|
|
|
|
|
|
|
|
;; Run an initializer function immediately.
|
|
|
|
|
;; (hs-init thunk) — called at element boot time
|
|
|
|
|
(define
|
|
|
|
|
hs-each
|
|
|
|
|
(fn
|
|
|
|
|
@@ -22,17 +45,17 @@
|
|
|
|
|
;; (hs-init thunk) — called at element boot time
|
|
|
|
|
(define meta (host-new "Object"))
|
|
|
|
|
|
|
|
|
|
;; Run an initializer function immediately.
|
|
|
|
|
;; (hs-init thunk) — called at element boot time
|
|
|
|
|
(define
|
|
|
|
|
hs-on-every
|
|
|
|
|
(fn (target event-name handler) (dom-listen target event-name handler)))
|
|
|
|
|
|
|
|
|
|
;; ── 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-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
|
|
|
|
|
(define
|
|
|
|
|
_hs-on-caller
|
|
|
|
|
(let
|
|
|
|
|
@@ -45,8 +68,7 @@
|
|
|
|
|
(host-set! _ctx "meta" _m)
|
|
|
|
|
_ctx)))
|
|
|
|
|
|
|
|
|
|
;; Wait for a DOM event on a target.
|
|
|
|
|
;; (hs-wait-for target event-name) — suspends until event fires
|
|
|
|
|
;; Wait for CSS transitions/animations to settle on an element.
|
|
|
|
|
(define
|
|
|
|
|
hs-on
|
|
|
|
|
(fn
|
|
|
|
|
@@ -66,14 +88,14 @@
|
|
|
|
|
(append prev (list unlisten)))
|
|
|
|
|
unlisten))))))
|
|
|
|
|
|
|
|
|
|
;; Wait for CSS transitions/animations to settle on an element.
|
|
|
|
|
;; ── Class manipulation ──────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Toggle a single class on an element.
|
|
|
|
|
(define
|
|
|
|
|
hs-on-every
|
|
|
|
|
(fn (target event-name handler) (dom-listen target event-name handler)))
|
|
|
|
|
|
|
|
|
|
;; ── Class manipulation ──────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Toggle a single class on an element.
|
|
|
|
|
;; Toggle between two classes — exactly one is active at a time.
|
|
|
|
|
(define
|
|
|
|
|
hs-on-intersection-attach!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -89,7 +111,8 @@
|
|
|
|
|
(host-call observer "observe" target)
|
|
|
|
|
observer)))))
|
|
|
|
|
|
|
|
|
|
;; Toggle between two classes — exactly one is active at a time.
|
|
|
|
|
;; Take a class from siblings — add to target, remove from others.
|
|
|
|
|
;; (hs-take! target cls) — like radio button class behavior
|
|
|
|
|
(define
|
|
|
|
|
hs-on-mutation-attach!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -110,19 +133,18 @@
|
|
|
|
|
(host-call observer "observe" target opts)
|
|
|
|
|
observer))))))
|
|
|
|
|
|
|
|
|
|
;; 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))))
|
|
|
|
|
(define hs-init (fn (thunk) (thunk)))
|
|
|
|
|
|
|
|
|
|
;; ── Navigation / traversal ──────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Navigate to a URL.
|
|
|
|
|
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
|
|
|
|
|
|
|
|
|
|
;; Find next sibling matching a selector (or any sibling).
|
|
|
|
|
(begin
|
|
|
|
|
(define
|
|
|
|
|
hs-wait-for
|
|
|
|
|
@@ -135,7 +157,7 @@
|
|
|
|
|
(target event-name timeout-ms)
|
|
|
|
|
(perform (list (quote io-wait-event) target event-name timeout-ms)))))
|
|
|
|
|
|
|
|
|
|
;; Find next sibling matching a selector (or any sibling).
|
|
|
|
|
;; Find previous sibling matching a selector.
|
|
|
|
|
(define
|
|
|
|
|
hs-settle
|
|
|
|
|
(fn
|
|
|
|
|
@@ -143,7 +165,7 @@
|
|
|
|
|
(hs-null-raise! target)
|
|
|
|
|
(when (not (nil? target)) (perform (list (quote io-settle) target)))))
|
|
|
|
|
|
|
|
|
|
;; Find previous sibling matching a selector.
|
|
|
|
|
;; First element matching selector within a scope.
|
|
|
|
|
(define
|
|
|
|
|
hs-toggle-class!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -153,7 +175,7 @@
|
|
|
|
|
(not (nil? target))
|
|
|
|
|
(host-call (host-get target "classList") "toggle" cls))))
|
|
|
|
|
|
|
|
|
|
;; First element matching selector within a scope.
|
|
|
|
|
;; Last element matching selector.
|
|
|
|
|
(define
|
|
|
|
|
hs-toggle-var-cycle!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -175,7 +197,7 @@
|
|
|
|
|
var-name
|
|
|
|
|
(if (= idx -1) (first values) (nth values (mod (+ idx 1) n))))))))
|
|
|
|
|
|
|
|
|
|
;; Last element matching selector.
|
|
|
|
|
;; First/last within a specific scope.
|
|
|
|
|
(define
|
|
|
|
|
hs-toggle-between!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -188,7 +210,6 @@
|
|
|
|
|
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
|
|
|
|
(do (dom-remove-class target cls2) (dom-add-class target cls1))))))
|
|
|
|
|
|
|
|
|
|
;; First/last within a specific scope.
|
|
|
|
|
(define
|
|
|
|
|
hs-toggle-style!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -212,6 +233,9 @@
|
|
|
|
|
(dom-set-style target prop "hidden")
|
|
|
|
|
(dom-set-style target prop "")))))))
|
|
|
|
|
|
|
|
|
|
;; ── Iteration ───────────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Repeat a thunk N times.
|
|
|
|
|
(define
|
|
|
|
|
hs-toggle-style-between!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -223,9 +247,7 @@
|
|
|
|
|
(dom-set-style target prop val2)
|
|
|
|
|
(dom-set-style target prop val1)))))
|
|
|
|
|
|
|
|
|
|
;; ── Iteration ───────────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Repeat a thunk N times.
|
|
|
|
|
;; Repeat forever (until break — relies on exception/continuation).
|
|
|
|
|
(define
|
|
|
|
|
hs-toggle-style-cycle!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -246,7 +268,10 @@
|
|
|
|
|
(true (find-next (rest remaining))))))
|
|
|
|
|
(dom-set-style target prop (find-next vals)))))
|
|
|
|
|
|
|
|
|
|
;; Repeat forever (until break — relies on exception/continuation).
|
|
|
|
|
;; ── Fetch ───────────────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Fetch a URL, parse response according to format.
|
|
|
|
|
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
|
|
|
|
(define
|
|
|
|
|
hs-take!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -269,8 +294,7 @@
|
|
|
|
|
(when with-cls (dom-remove-class target with-cls))))
|
|
|
|
|
(let
|
|
|
|
|
((attr-val (if (> (len extra) 0) (first extra) nil))
|
|
|
|
|
(with-val
|
|
|
|
|
(if (> (len extra) 1) (nth extra 1) nil)))
|
|
|
|
|
(with-val (if (> (len extra) 1) (nth extra 1) nil)))
|
|
|
|
|
(do
|
|
|
|
|
(for-each
|
|
|
|
|
(fn
|
|
|
|
|
@@ -287,10 +311,10 @@
|
|
|
|
|
(dom-set-attr target name attr-val)
|
|
|
|
|
(dom-set-attr target name ""))))))))
|
|
|
|
|
|
|
|
|
|
;; ── Fetch ───────────────────────────────────────────────────────
|
|
|
|
|
;; ── Type coercion ───────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Fetch a URL, parse response according to format.
|
|
|
|
|
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
|
|
|
|
;; Coerce a value to a type by name.
|
|
|
|
|
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
|
|
|
|
(begin
|
|
|
|
|
(define
|
|
|
|
|
hs-element?
|
|
|
|
|
@@ -447,10 +471,10 @@
|
|
|
|
|
(dom-insert-adjacent-html target "beforeend" value)
|
|
|
|
|
(hs-boot-subtree! target)))))))))))
|
|
|
|
|
|
|
|
|
|
;; ── Type coercion ───────────────────────────────────────────────
|
|
|
|
|
;; ── Object creation ─────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Coerce a value to a type by name.
|
|
|
|
|
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
|
|
|
|
;; Make a new object of a given type.
|
|
|
|
|
;; (hs-make type-name) — creates empty object/collection
|
|
|
|
|
(define
|
|
|
|
|
hs-add-to!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -464,10 +488,11 @@
|
|
|
|
|
((hs-is-set? target) (do (host-call target "add" value) target))
|
|
|
|
|
(true (do (host-call target "push" value) target)))))
|
|
|
|
|
|
|
|
|
|
;; ── Object creation ─────────────────────────────────────────────
|
|
|
|
|
;; ── Behavior installation ───────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Make a new object of a given type.
|
|
|
|
|
;; (hs-make type-name) — creates empty object/collection
|
|
|
|
|
;; 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-remove-from!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -477,11 +502,10 @@
|
|
|
|
|
((hs-is-set? target) (do (host-call target "delete" value) target))
|
|
|
|
|
(true (host-call target "splice" (host-call target "indexOf" value) 1)))))
|
|
|
|
|
|
|
|
|
|
;; ── Behavior installation ───────────────────────────────────────
|
|
|
|
|
;; ── Measurement ─────────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; 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)
|
|
|
|
|
;; Measure an element's bounding rect, store as local variables.
|
|
|
|
|
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
|
|
|
|
(define
|
|
|
|
|
hs-splice-at!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -494,10 +518,7 @@
|
|
|
|
|
((i (if (< idx 0) (+ n idx) idx)))
|
|
|
|
|
(cond
|
|
|
|
|
((or (< i 0) (>= i n)) target)
|
|
|
|
|
(true
|
|
|
|
|
(concat
|
|
|
|
|
(slice target 0 i)
|
|
|
|
|
(slice target (+ i 1) n))))))
|
|
|
|
|
(true (concat (slice target 0 i) (slice target (+ i 1) n))))))
|
|
|
|
|
(do
|
|
|
|
|
(when
|
|
|
|
|
target
|
|
|
|
|
@@ -508,10 +529,10 @@
|
|
|
|
|
(host-call target "splice" i 1))))
|
|
|
|
|
target))))
|
|
|
|
|
|
|
|
|
|
;; ── Measurement ─────────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Measure an element's bounding rect, store as local variables.
|
|
|
|
|
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
|
|
|
|
;; 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-index
|
|
|
|
|
(fn
|
|
|
|
|
@@ -523,10 +544,11 @@
|
|
|
|
|
((string? obj) (nth obj key))
|
|
|
|
|
(true (host-get obj key)))))
|
|
|
|
|
|
|
|
|
|
;; 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.
|
|
|
|
|
|
|
|
|
|
;; ── Transition ──────────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Transition a CSS property to a value, optionally with duration.
|
|
|
|
|
;; (hs-transition target prop value duration)
|
|
|
|
|
(define
|
|
|
|
|
hs-put-at!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -548,11 +570,6 @@
|
|
|
|
|
((= pos "start") (host-call target "unshift" value)))
|
|
|
|
|
target)))))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; ── Transition ──────────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Transition a CSS property to a value, optionally with duration.
|
|
|
|
|
;; (hs-transition target prop value duration)
|
|
|
|
|
(define
|
|
|
|
|
hs-dict-without
|
|
|
|
|
(fn
|
|
|
|
|
@@ -589,6 +606,11 @@
|
|
|
|
|
((w (host-global "window")))
|
|
|
|
|
(if w (host-call w "prompt" msg) nil))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; ── Transition ──────────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Transition a CSS property to a value, optionally with duration.
|
|
|
|
|
;; (hs-transition target prop value duration)
|
|
|
|
|
(define
|
|
|
|
|
hs-answer
|
|
|
|
|
(fn
|
|
|
|
|
@@ -597,11 +619,6 @@
|
|
|
|
|
((w (host-global "window")))
|
|
|
|
|
(if w (if (host-call w "confirm" msg) yes-val no-val) no-val))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; ── Transition ──────────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
;; Transition a CSS property to a value, optionally with duration.
|
|
|
|
|
;; (hs-transition target prop value duration)
|
|
|
|
|
(define
|
|
|
|
|
hs-answer-alert
|
|
|
|
|
(fn
|
|
|
|
|
@@ -662,6 +679,10 @@
|
|
|
|
|
(if (nil? sel) "" (host-call sel "toString" (list))))
|
|
|
|
|
stash)))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-reset!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -708,10 +729,6 @@
|
|
|
|
|
(when default-val (dom-set-prop target "value" default-val)))))
|
|
|
|
|
(true nil)))))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-next
|
|
|
|
|
(fn
|
|
|
|
|
@@ -730,7 +747,8 @@
|
|
|
|
|
((dom-matches? el sel) el)
|
|
|
|
|
(true (find-next (dom-next-sibling el))))))
|
|
|
|
|
(find-next sibling)))))
|
|
|
|
|
|
|
|
|
|
;; ── Sandbox/test runtime additions ──────────────────────────────
|
|
|
|
|
;; Property access — dot notation and .length
|
|
|
|
|
(define
|
|
|
|
|
hs-previous
|
|
|
|
|
(fn
|
|
|
|
|
@@ -749,10 +767,9 @@
|
|
|
|
|
((dom-matches? el sel) el)
|
|
|
|
|
(true (find-prev (dom-get-prop el "previousElementSibling"))))))
|
|
|
|
|
(find-prev sibling)))))
|
|
|
|
|
;; ── Sandbox/test runtime additions ──────────────────────────────
|
|
|
|
|
;; Property access — dot notation and .length
|
|
|
|
|
(define _hs-last-query-sel nil)
|
|
|
|
|
;; DOM query stub — sandbox returns empty list
|
|
|
|
|
(define _hs-last-query-sel nil)
|
|
|
|
|
;; Method dispatch — obj.method(args)
|
|
|
|
|
(define
|
|
|
|
|
hs-null-raise!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -763,7 +780,9 @@
|
|
|
|
|
((msg (str "'" (or (host-get (host-global "window") "_hs_last_query_sel") "target") "' is null")))
|
|
|
|
|
(host-set! (host-global "window") "_hs_null_error" msg)
|
|
|
|
|
(guard (_null-e (true nil)) (raise msg))))))
|
|
|
|
|
;; Method dispatch — obj.method(args)
|
|
|
|
|
|
|
|
|
|
;; ── 0.9.90 features ─────────────────────────────────────────────
|
|
|
|
|
;; beep! — debug logging, returns value unchanged
|
|
|
|
|
(define
|
|
|
|
|
hs-empty-raise!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -777,9 +796,7 @@
|
|
|
|
|
((msg (str "'" (or (host-get (host-global "window") "_hs_last_query_sel") "target") "' is null")))
|
|
|
|
|
(host-set! (host-global "window") "_hs_null_error" msg)
|
|
|
|
|
(guard (_null-e (true nil)) (raise msg))))))
|
|
|
|
|
|
|
|
|
|
;; ── 0.9.90 features ─────────────────────────────────────────────
|
|
|
|
|
;; beep! — debug logging, returns value unchanged
|
|
|
|
|
;; Property-based is — check obj.key truthiness
|
|
|
|
|
(define
|
|
|
|
|
hs-query-all-checked
|
|
|
|
|
(fn
|
|
|
|
|
@@ -787,14 +804,14 @@
|
|
|
|
|
(let
|
|
|
|
|
((result (hs-query-all sel)))
|
|
|
|
|
(do (hs-empty-raise! result) result))))
|
|
|
|
|
;; Property-based is — check obj.key truthiness
|
|
|
|
|
;; Array slicing (inclusive both ends)
|
|
|
|
|
(define
|
|
|
|
|
hs-dispatch!
|
|
|
|
|
(fn
|
|
|
|
|
(target event detail)
|
|
|
|
|
(hs-null-raise! target)
|
|
|
|
|
(when (not (nil? target)) (dom-dispatch target event detail))))
|
|
|
|
|
;; Array slicing (inclusive both ends)
|
|
|
|
|
;; Collection: sorted by
|
|
|
|
|
(define
|
|
|
|
|
hs-query-all
|
|
|
|
|
(fn
|
|
|
|
|
@@ -802,7 +819,7 @@
|
|
|
|
|
(do
|
|
|
|
|
(host-set! (host-global "window") "_hs_last_query_sel" sel)
|
|
|
|
|
(dom-query-all (dom-document) sel))))
|
|
|
|
|
;; Collection: sorted by
|
|
|
|
|
;; Collection: sorted by descending
|
|
|
|
|
(define
|
|
|
|
|
hs-query-all-in
|
|
|
|
|
(fn
|
|
|
|
|
@@ -811,17 +828,17 @@
|
|
|
|
|
(nil? target)
|
|
|
|
|
(hs-query-all sel)
|
|
|
|
|
(host-call target "querySelectorAll" sel))))
|
|
|
|
|
;; Collection: sorted by descending
|
|
|
|
|
;; Collection: split by
|
|
|
|
|
(define
|
|
|
|
|
hs-list-set
|
|
|
|
|
(fn
|
|
|
|
|
(lst idx val)
|
|
|
|
|
(append (take lst idx) (cons val (drop lst (+ idx 1))))))
|
|
|
|
|
;; Collection: split by
|
|
|
|
|
;; Collection: joined by
|
|
|
|
|
(define
|
|
|
|
|
hs-to-number
|
|
|
|
|
(fn (v) (if (number? v) v (or (parse-number (str v)) 0))))
|
|
|
|
|
;; Collection: joined by
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-query-first
|
|
|
|
|
(fn
|
|
|
|
|
@@ -951,7 +968,7 @@
|
|
|
|
|
((= (str ex) "hs-continue") (do-loop (rest remaining)))
|
|
|
|
|
(true (raise ex))))))))
|
|
|
|
|
(do-loop items))))
|
|
|
|
|
|
|
|
|
|
;; Collection: joined by
|
|
|
|
|
(begin
|
|
|
|
|
(define
|
|
|
|
|
hs-append
|
|
|
|
|
@@ -992,7 +1009,7 @@
|
|
|
|
|
(host-get value "outerHTML")
|
|
|
|
|
(str value))))
|
|
|
|
|
(true nil)))))
|
|
|
|
|
;; Collection: joined by
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-sender
|
|
|
|
|
(fn
|
|
|
|
|
@@ -1084,6 +1101,7 @@
|
|
|
|
|
(hs-host-to-sx (perform (list "io-parse-json" raw))))
|
|
|
|
|
((= fmt "number")
|
|
|
|
|
(hs-to-number (perform (list "io-parse-text" raw))))
|
|
|
|
|
((= fmt "html") (perform (list "io-parse-html" raw)))
|
|
|
|
|
(true (perform (list "io-parse-text" raw)))))))))
|
|
|
|
|
|
|
|
|
|
(define hs-fetch (fn (url format) (hs-fetch-impl url format false)))
|
|
|
|
|
@@ -1623,14 +1641,10 @@
|
|
|
|
|
((ch (substring sel i (+ i 1))))
|
|
|
|
|
(cond
|
|
|
|
|
((= ch ".")
|
|
|
|
|
(do
|
|
|
|
|
(flush!)
|
|
|
|
|
(set! mode "class")
|
|
|
|
|
(walk (+ i 1))))
|
|
|
|
|
(do (flush!) (set! mode "class") (walk (+ i 1))))
|
|
|
|
|
((= ch "#")
|
|
|
|
|
(do (flush!) (set! mode "id") (walk (+ i 1))))
|
|
|
|
|
(true
|
|
|
|
|
(do (set! cur (str cur ch)) (walk (+ i 1)))))))))
|
|
|
|
|
(true (do (set! cur (str cur ch)) (walk (+ i 1)))))))))
|
|
|
|
|
(walk 0)
|
|
|
|
|
(flush!)
|
|
|
|
|
{:tag tag :classes classes :id id}))))
|
|
|
|
|
@@ -1724,11 +1738,11 @@
|
|
|
|
|
(value type-name)
|
|
|
|
|
(if (nil? value) false (hs-type-check value type-name))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-strict-eq
|
|
|
|
|
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-id=
|
|
|
|
|
(fn
|
|
|
|
|
@@ -1760,6 +1774,20 @@
|
|
|
|
|
((nil? suffix) false)
|
|
|
|
|
(true (ends-with? (str s) (str suffix))))))
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-attr-watch!
|
|
|
|
|
(fn
|
|
|
|
|
(target attr-name handler)
|
|
|
|
|
(let
|
|
|
|
|
((mo-class (host-get (host-global "window") "MutationObserver")))
|
|
|
|
|
(when
|
|
|
|
|
mo-class
|
|
|
|
|
(let
|
|
|
|
|
((cb (fn (records observer) (for-each (fn (rec) (when (= (host-get rec "attributeName") attr-name) (handler (host-call target "getAttribute" attr-name)))) records))))
|
|
|
|
|
(let
|
|
|
|
|
((mo (host-new "MutationObserver" cb)))
|
|
|
|
|
(host-call mo "observe" target {:attributeFilter (list attr-name) :attributes true})))))))
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-scoped-set!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -1805,10 +1833,7 @@
|
|
|
|
|
((and (dict? a) (dict? b))
|
|
|
|
|
(let
|
|
|
|
|
((pos (host-call a "compareDocumentPosition" b)))
|
|
|
|
|
(if
|
|
|
|
|
(number? pos)
|
|
|
|
|
(not (= 0 (mod (/ pos 4) 2)))
|
|
|
|
|
false)))
|
|
|
|
|
(if (number? pos) (not (= 0 (mod (/ pos 4) 2))) false)))
|
|
|
|
|
(true (< (str a) (str b))))))
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
@@ -1929,10 +1954,7 @@
|
|
|
|
|
((and (dict? a) (dict? b))
|
|
|
|
|
(let
|
|
|
|
|
((pos (host-call a "compareDocumentPosition" b)))
|
|
|
|
|
(if
|
|
|
|
|
(number? pos)
|
|
|
|
|
(not (= 0 (mod (/ pos 4) 2)))
|
|
|
|
|
false)))
|
|
|
|
|
(if (number? pos) (not (= 0 (mod (/ pos 4) 2))) false)))
|
|
|
|
|
(true (< (str a) (str b))))))
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
@@ -1985,9 +2007,7 @@
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-morph-char
|
|
|
|
|
(fn
|
|
|
|
|
(s p)
|
|
|
|
|
(if (or (< p 0) (>= p (string-length s))) nil (nth s p))))
|
|
|
|
|
(fn (s p) (if (or (< p 0) (>= p (string-length s))) nil (nth s p))))
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-morph-index-from
|
|
|
|
|
@@ -2015,10 +2035,7 @@
|
|
|
|
|
(q)
|
|
|
|
|
(let
|
|
|
|
|
((c (hs-morph-char s q)))
|
|
|
|
|
(if
|
|
|
|
|
(and c (< (index-of stop c) 0))
|
|
|
|
|
(loop (+ q 1))
|
|
|
|
|
q))))
|
|
|
|
|
(if (and c (< (index-of stop c) 0)) (loop (+ q 1)) q))))
|
|
|
|
|
(let ((e (loop p))) (list (substring s p e) e))))
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
@@ -2060,9 +2077,7 @@
|
|
|
|
|
(append
|
|
|
|
|
acc
|
|
|
|
|
(list
|
|
|
|
|
(list
|
|
|
|
|
name
|
|
|
|
|
(substring s (+ p4 1) close)))))))
|
|
|
|
|
(list name (substring s (+ p4 1) close)))))))
|
|
|
|
|
((= c2 "'")
|
|
|
|
|
(let
|
|
|
|
|
((close (hs-morph-index-from s "'" (+ p4 1))))
|
|
|
|
|
@@ -2072,9 +2087,7 @@
|
|
|
|
|
(append
|
|
|
|
|
acc
|
|
|
|
|
(list
|
|
|
|
|
(list
|
|
|
|
|
name
|
|
|
|
|
(substring s (+ p4 1) close)))))))
|
|
|
|
|
(list name (substring s (+ p4 1) close)))))))
|
|
|
|
|
(true
|
|
|
|
|
(let
|
|
|
|
|
((r2 (hs-morph-read-until s p4 " \t\n/>")))
|
|
|
|
|
@@ -2158,9 +2171,7 @@
|
|
|
|
|
(for-each
|
|
|
|
|
(fn
|
|
|
|
|
(c)
|
|
|
|
|
(when
|
|
|
|
|
(> (string-length c) 0)
|
|
|
|
|
(dom-add-class el c)))
|
|
|
|
|
(when (> (string-length c) 0) (dom-add-class el c)))
|
|
|
|
|
(split v " ")))
|
|
|
|
|
((and keep-id (= n "id")) nil)
|
|
|
|
|
(true (dom-set-attr el n v)))))
|
|
|
|
|
@@ -2261,8 +2272,7 @@
|
|
|
|
|
((parts (split resolved ":")))
|
|
|
|
|
(let
|
|
|
|
|
((prop (first parts))
|
|
|
|
|
(val
|
|
|
|
|
(if (> (len parts) 1) (nth parts 1) nil)))
|
|
|
|
|
(val (if (> (len parts) 1) (nth parts 1) nil)))
|
|
|
|
|
(cond
|
|
|
|
|
((and (not (= prop "display")) (not (= prop "opacity")) (not (= prop "visibility")) (not (= prop "hidden")) (not (= prop "class-hidden")) (not (= prop "class-invisible")) (not (= prop "class-opacity")) (not (= prop "details")) (not (= prop "dialog")) (dict-has? _hs-hide-strategies prop))
|
|
|
|
|
(let
|
|
|
|
|
@@ -2302,8 +2312,7 @@
|
|
|
|
|
((parts (split resolved ":")))
|
|
|
|
|
(let
|
|
|
|
|
((prop (first parts))
|
|
|
|
|
(val
|
|
|
|
|
(if (> (len parts) 1) (nth parts 1) nil)))
|
|
|
|
|
(val (if (> (len parts) 1) (nth parts 1) nil)))
|
|
|
|
|
(cond
|
|
|
|
|
((and (not (= prop "display")) (not (= prop "opacity")) (not (= prop "visibility")) (not (= prop "hidden")) (not (= prop "class-hidden")) (not (= prop "class-invisible")) (not (= prop "class-opacity")) (not (= prop "details")) (not (= prop "dialog")) (dict-has? _hs-hide-strategies prop))
|
|
|
|
|
(let
|
|
|
|
|
@@ -2408,14 +2417,10 @@
|
|
|
|
|
(if
|
|
|
|
|
(= depth 1)
|
|
|
|
|
j
|
|
|
|
|
(find-close
|
|
|
|
|
(+ j 1)
|
|
|
|
|
(- depth 1)))
|
|
|
|
|
(find-close (+ j 1) (- depth 1)))
|
|
|
|
|
(if
|
|
|
|
|
(= (nth raw j) "{")
|
|
|
|
|
(find-close
|
|
|
|
|
(+ j 1)
|
|
|
|
|
(+ depth 1))
|
|
|
|
|
(find-close (+ j 1) (+ depth 1))
|
|
|
|
|
(find-close (+ j 1) depth))))))
|
|
|
|
|
(let
|
|
|
|
|
((close (find-close start 1)))
|
|
|
|
|
@@ -2526,10 +2531,7 @@
|
|
|
|
|
(if
|
|
|
|
|
(= (len lst) 0)
|
|
|
|
|
-1
|
|
|
|
|
(if
|
|
|
|
|
(= (first lst) item)
|
|
|
|
|
i
|
|
|
|
|
(idx-loop (rest lst) (+ i 1))))))
|
|
|
|
|
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
|
|
|
|
|
(idx-loop obj 0)))
|
|
|
|
|
(true
|
|
|
|
|
(let
|
|
|
|
|
@@ -2621,8 +2623,7 @@
|
|
|
|
|
(cond
|
|
|
|
|
((= end "hs-pick-end") n)
|
|
|
|
|
((= end "hs-pick-start") 0)
|
|
|
|
|
((and (number? end) (< end 0))
|
|
|
|
|
(max 0 (+ n end)))
|
|
|
|
|
((and (number? end) (< end 0)) (max 0 (+ n end)))
|
|
|
|
|
(true end))))
|
|
|
|
|
(cond
|
|
|
|
|
((string? col) (slice col s e))
|
|
|
|
|
@@ -2802,6 +2803,8 @@
|
|
|
|
|
hs-sorted-by-desc
|
|
|
|
|
(fn (col key-fn) (reverse (hs-sorted-by col key-fn))))
|
|
|
|
|
|
|
|
|
|
;; ── SourceInfo API ────────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-dom-has-var?
|
|
|
|
|
(fn
|
|
|
|
|
@@ -2821,8 +2824,6 @@
|
|
|
|
|
((store (host-get el "__hs_vars")))
|
|
|
|
|
(if (nil? store) nil (host-get store name)))))
|
|
|
|
|
|
|
|
|
|
;; ── SourceInfo API ────────────────────────────────────────────────
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-dom-set-var-raw!
|
|
|
|
|
(fn
|
|
|
|
|
@@ -2926,7 +2927,12 @@
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-null-error!
|
|
|
|
|
(fn (selector) (raise (str "'" selector "' is null"))))
|
|
|
|
|
(fn
|
|
|
|
|
(selector)
|
|
|
|
|
(let
|
|
|
|
|
((msg (str "'" selector "' is null")))
|
|
|
|
|
(host-set! (host-global "window") "_hs_null_error" msg)
|
|
|
|
|
(guard (_null-e (true nil)) (raise msg)))))
|
|
|
|
|
|
|
|
|
|
(define
|
|
|
|
|
hs-named-target
|
|
|
|
|
@@ -2946,9 +2952,7 @@
|
|
|
|
|
((results (hs-query-all selector)))
|
|
|
|
|
(if
|
|
|
|
|
(and
|
|
|
|
|
(or
|
|
|
|
|
(nil? results)
|
|
|
|
|
(and (list? results) (= (len results) 0)))
|
|
|
|
|
(or (nil? results) (and (list? results) (= (len results) 0)))
|
|
|
|
|
(string? selector)
|
|
|
|
|
(> (len selector) 0)
|
|
|
|
|
(= (substring selector 0 1) "#"))
|
|
|
|
|
|