diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index 79ce6b7b..97adec86 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -218,6 +218,27 @@ ((parts (rest ast))) (let ((event-name (first parts))) + ;; Pre-extract :throttle and :debounce kwargs (handler-wrapping modifiers) + ;; from parts so scan-on doesn't need extra params. Stored as closure vars + ;; that the handler-build step inside scan-on can read. + (define _throttle-ms nil) + (define _debounce-ms nil) + (define + _strip-throttle-debounce + (fn + (lst) + (cond + ((<= (len lst) 1) lst) + ((= (first lst) :throttle) + (do + (set! _throttle-ms (nth lst 1)) + (_strip-throttle-debounce (rest (rest lst))))) + ((= (first lst) :debounce) + (do + (set! _debounce-ms (nth lst 1)) + (_strip-throttle-debounce (rest (rest lst))))) + (true + (cons (first lst) (_strip-throttle-debounce (rest lst))))))) (define scan-on (fn @@ -250,6 +271,13 @@ ((wrapped-body (if catch-info (let ((var (make-symbol (nth catch-info 0))) (catch-body (hs-to-sx (nth catch-info 1)))) (if finally-info (list (quote let) (list (list (quote __hs-exc) nil) (list (quote __hs-reraise) false)) (list (quote do) (list (quote guard) (list var (list true (list (quote let) (list (list var (list (quote host-hs-normalize-exc) var))) (list (quote guard) (list (quote __inner-exc) (list true (list (quote do) (list (quote set!) (quote __hs-exc) (quote __inner-exc)) (list (quote set!) (quote __hs-reraise) true)))) catch-body)))) compiled-body) (hs-to-sx finally-info) (list (quote when) (quote __hs-reraise) (list (quote raise) (quote __hs-exc))))) (list (quote let) (list (list (quote __hs-exc) nil) (list (quote __hs-reraise) false)) (list (quote do) (list (quote guard) (list var (list true (list (quote let) (list (list var (list (quote host-hs-normalize-exc) var))) (list (quote guard) (list (quote __inner-exc) (list true (list (quote do) (list (quote set!) (quote __hs-exc) (quote __inner-exc)) (list (quote set!) (quote __hs-reraise) true)))) catch-body)))) compiled-body) (list (quote when) (quote __hs-reraise) (list (quote raise) (quote __hs-exc))))))) (if finally-info (list (quote do) compiled-body (hs-to-sx finally-info)) compiled-body)))) (let ((handler (let ((uses-the-result? (fn (expr) (cond ((= expr (quote the-result)) true) ((list? expr) (some (fn (x) (uses-the-result? x)) expr)) (true false))))) (let ((base-handler (list (quote fn) (list (quote event)) (if (uses-the-result? wrapped-body) (list (quote let) (list (list (quote the-result) nil)) wrapped-body) wrapped-body)))) (if count-filter-info (let ((mn (get count-filter-info "min")) (mx (get count-filter-info "max"))) (list (quote let) (list (list (quote __hs-count) 0)) (list (quote fn) (list (quote event)) (list (quote begin) (list (quote set!) (quote __hs-count) (list (quote +) (quote __hs-count) 1)) (list (quote when) (if (= mx -1) (list (quote >=) (quote __hs-count) mn) (list (quote and) (list (quote >=) (quote __hs-count) mn) (list (quote <=) (quote __hs-count) mx))) (nth base-handler 2)))))) base-handler))))) + (let + ((handler (cond + (_throttle-ms + (list (quote hs-throttle!) handler (hs-to-sx _throttle-ms))) + (_debounce-ms + (list (quote hs-debounce!) handler (hs-to-sx _debounce-ms))) + (true handler)))) (let ((on-call (if every? (list (quote hs-on-every) target event-name handler) (list (quote hs-on) target event-name handler)))) (cond @@ -309,7 +337,7 @@ (first pair) handler)) or-sources))) - on-call))))))))))))) + on-call)))))))))))))) ((= (first items) :from) (scan-on (rest (rest items)) @@ -453,7 +481,7 @@ count-filter-info elsewhere? or-sources))))) - (scan-on (rest parts) nil nil false nil nil nil nil nil false nil))))) + (scan-on (_strip-throttle-debounce (rest parts)) nil nil false nil nil nil nil nil false nil))))) (define emit-send (fn diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index 5e032e8c..973178bf 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -1347,7 +1347,17 @@ cls (first extra-classes) tgt)) - ((match-kw "for") + ((and + (= (tp-type) "keyword") (= (tp-val) "for") + ;; Only consume 'for' as a duration clause if the next + ;; token is NOT ' in ...' — that pattern is a + ;; for-in loop, not a toggle duration. + (not + (and + (> (len tokens) (+ p 2)) + (= (get (nth tokens (+ p 1)) "type") "ident") + (= (get (nth tokens (+ p 2)) "value") "in"))) + (do (adv!) true)) (let ((dur (parse-expr))) (list (quote toggle-class-for) cls tgt dur))) @@ -3079,7 +3089,17 @@ (= (tp-val) "queue")) (do (adv!) (adv!))) (let - ((every? (match-kw "every"))) + ((every? (match-kw "every")) + (throttle-ms nil) + (debounce-ms nil)) + ;; 'throttled at ' / 'debounced at ' + ;; — parsed as handler modifiers, captured as :throttle / :debounce parts. + (when (and (= (tp-type) "ident") (= (tp-val) "throttled")) + (adv!) + (when (match-kw "at") (set! throttle-ms (parse-expr)))) + (when (and (= (tp-type) "ident") (= (tp-val) "debounced")) + (adv!) + (when (match-kw "at") (set! debounce-ms (parse-expr)))) (let ((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil))) (let @@ -3094,6 +3114,10 @@ (match-kw "end") (let ((parts (list (quote on) event-name))) + (let + ((parts (if throttle-ms (append parts (list :throttle throttle-ms)) parts))) + (let + ((parts (if debounce-ms (append parts (list :debounce debounce-ms)) parts))) (let ((parts (if every? (append parts (list :every true)) parts))) (let @@ -3116,7 +3140,7 @@ ((parts (if finally-clause (append parts (list :finally finally-clause)) parts))) (let ((parts (append parts (list (if (> (len event-vars) 0) (cons (quote do) (append (map (fn (nm) (list (quote ref) nm)) event-vars) (if (and (list? body) (= (first body) (quote do))) (rest body) (list body)))) body))))) - parts)))))))))))))))))))))))))) + parts)))))))))))))))))))))))))))) (define parse-init-feat (fn diff --git a/lib/hyperscript/runtime.sx b/lib/hyperscript/runtime.sx index 2af81826..5104f1ce 100644 --- a/lib/hyperscript/runtime.sx +++ b/lib/hyperscript/runtime.sx @@ -54,6 +54,41 @@ hs-on-every (fn (target event-name handler) (dom-listen target event-name handler))) +;; Throttle: drops events that arrive within the window. First event fires +;; immediately; subsequent events within `ms` of the previous fire are dropped. +;; Returns a wrapped handler suitable for hs-on / hs-on-every. +(define + hs-throttle! + (fn + (handler ms) + (let + ((__hs-last-fire 0)) + (fn + (event) + (let + ((__hs-now (host-call (host-global "Date") "now"))) + (when + (>= (- __hs-now __hs-last-fire) ms) + (set! __hs-last-fire __hs-now) + (handler event))))))) + +;; Debounce: waits until `ms` has elapsed since the last event before firing. +;; In our synchronous test mock no time passes, so the timer fires immediately +;; via setTimeout(_, 0); the wrapped handler still gets called once per burst. +(define + hs-debounce! + (fn + (handler ms) + (let + ((__hs-timer nil)) + (fn + (event) + (when __hs-timer (host-call (host-global "window") "clearTimeout" __hs-timer)) + (set! __hs-timer + (host-call (host-global "window") "setTimeout" + (host-new-function (list "ev") "return arguments[0](arguments[1]);") + ms handler event)))))) + ;; Wait for a DOM event on a target. ;; (hs-wait-for target event-name) — suspends until event fires (define diff --git a/plans/hs-conformance-scoreboard.md b/plans/hs-conformance-scoreboard.md index e2474753..e4947f01 100644 --- a/plans/hs-conformance-scoreboard.md +++ b/plans/hs-conformance-scoreboard.md @@ -3,22 +3,25 @@ Live tally for `plans/hs-conformance-to-100.md`. Update after every cluster commit. ``` -Baseline: 1213/1496 (81.1%) -Merged: 1494/1494 (100.0%) on counted tests; 2 documented skips -Worktree: all landed -Skipped: 2 — 'until event keyword works' (async event dispatch needs the - kernel suspended outside K.eval), 'throttled at