rickub
Sign in Get started
nandi/jolt-nativepublic⑂ Fork 0
⑂ e0d9029
Branches
main View all branches → View all tags →
Commits
⬇ Clone ▾
git clone https://git.rickub.com/nandi/jolt-native.git
git clone ssh://git@rickub.com/nandi/jolt-native.git

Host key fingerprint (ed25519): SHA256:iycHnxEyq0Q7uyVpB7JlznP0G7JrTPXLYRcAU5CSLhc — verify it before your first connect.

Bring a :scroll-here row into view

frq's reply chip jumps to the message it answers by setting :scroll-here on
that row for a moment, and highlights it. libvidya scrolled to it; jvui had
no such thing, so the click highlighted a row somewhere off screen.

jvui's scroll area now takes w/reveal! from anything inside it and centres
that rectangle on the next walk, winning over the stick to the end but not
over a hand on the wheel. glimmer-jvui calls it for any container with
:scroll-here set.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
nandi committed 2026-09-10T19:21:47-07:00 Browse files
e0d9029 parent: c7d6ea8
modified glimmer-backends/glimmer-jvui/src/glimmer_jvui/core.clj +12 -2
@@ -176,8 +176,18 @@
176176 (and over? (not was)) (do (swap! hovering conj id) (fire! n :on-hover))
177177 (and was (not over?)) (do (swap! hovering disj id) (fire! n :on-unhover))))))
178178
179-(defn- emit-children! [n]
180- (fn [_id _rect] (doseq [c (:children @n)] (emit! c))))
179+(defn- emit-children!
180+ "The body a container is walked with.
181+
182+ `:scroll-here` rides along on any container: while it is set, the scroll
183+ area around the node is asked to bring it into view. frq sets it for the
184+ moment of a jump to a message and takes it off again — left on, it would
185+ pin the list there and take scrolling away from the reader."
186+ [n]
187+ (let [here? (:scroll-here (:props @n))]
188+ (fn [_id rect]
189+ (when here? (w/reveal! rect))
190+ (doseq [c (:children @n)] (emit! c)))))
181191
182192 (defn- emit!
183193 "Render one node, and through it everything below it.
@@ -176,8 +176,18 @@
176 (and over? (not was)) (do (swap! hovering conj id) (fire! n :on-hover))176 (and over? (not was)) (do (swap! hovering conj id) (fire! n :on-hover))
177 (and was (not over?)) (do (swap! hovering disj id) (fire! n :on-unhover))))))177 (and was (not over?)) (do (swap! hovering disj id) (fire! n :on-unhover))))))
178 178
179-(defn- emit-children! [n]179+(defn- emit-children!
180- (fn [_id _rect] (doseq [c (:children @n)] (emit! c))))180+ "The body a container is walked with.
181+
182+ `:scroll-here` rides along on any container: while it is set, the scroll
183+ area around the node is asked to bring it into view. frq sets it for the
184+ moment of a jump to a message and takes it off again — left on, it would
185+ pin the list there and take scrolling away from the reader."
186+ [n]
187+ (let [here? (:scroll-here (:props @n))]
188+ (fn [_id rect]
189+ (when here? (w/reveal! rect))
190+ (doseq [c (:children @n)] (emit! c)))))
181 191
182 (defn- emit!192 (defn- emit!
183 "Render one node, and through it everything below it.193 "Render one node, and through it everything below it.
modified glimmer-backends/glimmer-jvui/test/glimmer_jvui/tests.clj +27 -0
@@ -265,6 +265,32 @@
265265 (check! (and off2 (< off2 off))
266266 (str "and let go when the reader scrolled up: " off " -> " off2))))))
267267
268+(defn- check-scroll-here! []
269+ ;; frq's reply chip sets :scroll-here on the message it answers. The list
270+ ;; is stuck to its end, so the row it points at is far above the viewport
271+ ;; until something moves it.
272+ (let [root (jv/root-node) cx (ctx)
273+ target (ra/atom nil)]
274+ (gui/mount root :page
275+ [(fn [] [:scroll {:height 60 :scroll-key "jump" :stick-to-bottom true}
276+ (into [:vbox {}]
277+ (for [i (range 40)]
278+ [:vbox {:key i :scroll-here (= i (ra/deref target))}
279+ [:label {:label (str "line " i)}]]))])])
280+ (dotimes [_ 3] (jv/render-once root cx))
281+ (let [stuck (w/scroll-offset "jump")]
282+ (ra/reset! target 4)
283+ (dotimes [_ 3] (jv/render-once root cx))
284+ ;; Labels keep no rectangle, so the offset says where the list went:
285+ ;; line 4 starts under a hundred points down, and centring a line in a
286+ ;; sixty-tall viewport puts the offset below that — nowhere near the
287+ ;; end, where forty lines leave it.
288+ (let [off (w/scroll-offset "jump")]
289+ (check! (and stuck (> stuck 400.0))
290+ (str "the list starts at its end: offset=" stuck))
291+ (check! (and off (< off 100.0))
292+ (str "a :scroll-here row is brought on screen: offset=" off))))))
293+
268294 (defn- check-checkbox-round-trips! []
269295 (let [root (jv/root-node) cx (ctx)]
270296 (ra/reset! on? false)
@@ -332,6 +358,7 @@
332358 ["an unknown tag is a container" check-unknown-tag-is-a-container!]
333359 ["a row does not stretch" check-rows-do-not-stretch!]
334360 ["a list sticks to the end" check-scroll-sticks!]
361+ ["a row asks to be seen" check-scroll-here!]
335362 ["Enter sends" check-enter-sends!]
336363 ["an entry round-trips" check-entry-round-trips!]
337364 ["a paste reaches the client" check-paste-reaches-the-client!]
@@ -265,6 +265,32 @@
265 (check! (and off2 (< off2 off))265 (check! (and off2 (< off2 off))
266 (str "and let go when the reader scrolled up: " off " -> " off2))))))266 (str "and let go when the reader scrolled up: " off " -> " off2))))))
267 267
268+(defn- check-scroll-here! []
269+ ;; frq's reply chip sets :scroll-here on the message it answers. The list
270+ ;; is stuck to its end, so the row it points at is far above the viewport
271+ ;; until something moves it.
272+ (let [root (jv/root-node) cx (ctx)
273+ target (ra/atom nil)]
274+ (gui/mount root :page
275+ [(fn [] [:scroll {:height 60 :scroll-key "jump" :stick-to-bottom true}
276+ (into [:vbox {}]
277+ (for [i (range 40)]
278+ [:vbox {:key i :scroll-here (= i (ra/deref target))}
279+ [:label {:label (str "line " i)}]]))])])
280+ (dotimes [_ 3] (jv/render-once root cx))
281+ (let [stuck (w/scroll-offset "jump")]
282+ (ra/reset! target 4)
283+ (dotimes [_ 3] (jv/render-once root cx))
284+ ;; Labels keep no rectangle, so the offset says where the list went:
285+ ;; line 4 starts under a hundred points down, and centring a line in a
286+ ;; sixty-tall viewport puts the offset below that — nowhere near the
287+ ;; end, where forty lines leave it.
288+ (let [off (w/scroll-offset "jump")]
289+ (check! (and stuck (> stuck 400.0))
290+ (str "the list starts at its end: offset=" stuck))
291+ (check! (and off (< off 100.0))
292+ (str "a :scroll-here row is brought on screen: offset=" off))))))
293+
268 (defn- check-checkbox-round-trips! []294 (defn- check-checkbox-round-trips! []
269 (let [root (jv/root-node) cx (ctx)]295 (let [root (jv/root-node) cx (ctx)]
270 (ra/reset! on? false)296 (ra/reset! on? false)
@@ -332,6 +358,7 @@
332 ["an unknown tag is a container" check-unknown-tag-is-a-container!]358 ["an unknown tag is a container" check-unknown-tag-is-a-container!]
333 ["a row does not stretch" check-rows-do-not-stretch!]359 ["a row does not stretch" check-rows-do-not-stretch!]
334 ["a list sticks to the end" check-scroll-sticks!]360 ["a list sticks to the end" check-scroll-sticks!]
361+ ["a row asks to be seen" check-scroll-here!]
335 ["Enter sends" check-enter-sends!]362 ["Enter sends" check-enter-sends!]
336 ["an entry round-trips" check-entry-round-trips!]363 ["an entry round-trips" check-entry-round-trips!]
337 ["a paste reaches the client" check-paste-reaches-the-client!]364 ["a paste reaches the client" check-paste-reaches-the-client!]
modified jvui/src/jvui/widgets.clj +44 -3
@@ -641,6 +641,35 @@
641641 ;; and the name outlives the node.
642642 (atom {}))
643643
644+(defonce ^:private reveals
645+ ;; What a viewport has been asked to bring into view, by area, for the next
646+ ;; walk to act on. Apart from `scroll-areas` because the ask is made from
647+ ;; INSIDE the body, which runs before the area writes its own state back —
648+ ;; kept there, that write would wipe the ask it was just handed.
649+ (atom {}))
650+
651+(def ^:private ^:dynamic *viewport*
652+ "The scroll area the body being walked sits in: where its content starts,
653+ how far it is scrolled and how much of it shows. What `reveal!` measures a
654+ rectangle against."
655+ nil)
656+
657+(defn reveal!
658+ "Ask the scroll area around the caller to bring `rect` into view, centred.
659+
660+ `rect` is as this walk placed it, so already moved by the offset. The area
661+ acts on it on the next walk, and a walk is asked for only when the offset
662+ would actually change: a caller that asks on every frame for the moment of
663+ a jump costs nothing once the list is there. Outside a scroll area it does
664+ nothing."
665+ [[_ y _ rh]]
666+ (when-let [{:keys [area top off h maxoff]} *viewport*]
667+ (let [at (+ (- (double y) top) off)
668+ target (min maxoff (max 0.0 (- at (max 0.0 (/ (- h (double rh)) 2.0)))))]
669+ (swap! reveals assoc area target)
670+ (when (> (Math/abs (- target off)) 0.5) (c/refresh!))))
671+ nil)
672+
644673 (defn scroll-offset
645674 "How far the area named `k` is scrolled, or nil if it has never shown.
646675
@@ -707,15 +736,24 @@
707736 wheeled (reduce (fn [o e] (min maxoff (max 0.0 (- o (* 40.0 (:dy e))))))
708737 off0 wheel)
709738 moved? (not= wheeled off0)
739+ ;; What a child asked to be shown, on the walk before this one. Taken
740+ ;; off as it is read: a child that still wants it asks again.
741+ reveal (get @reveals area)
742+ _ (swap! reveals dissoc area)
710743 ;; Sticking and jumping are the same control pulling opposite
711744 ;; ways. Sticking wins over a jump, so a jump to an old message
712745 ;; is not snatched back by the next arrival — but a hand on the
713- ;; wheel wins over both.
714- stick? (and stick-to-bottom (not jump?) (not moved?) (:at-end st true))
746+ ;; wheel wins over both. A child asking to be seen wins over the
747+ ;; stick too: it is a jump to somewhere other than the end.
748+ stick? (and stick-to-bottom (not jump?) (not reveal) (not moved?)
749+ (:at-end st true))
715750 off (cond
751+ moved? wheeled
752+ reveal (min maxoff (max 0.0 (double reveal)))
716753 jump? maxoff
717754 stick? maxoff
718755 :else wheeled)
756+ padding (double (or (:padding opts) 0.0))
719757 ;; The gutter the bar is drawn in, taken off the content whether or
720758 ;; not there is anything to scroll yet. Always, because the
721759 ;; alternative is that a list reflows the moment it grows past the
@@ -747,7 +785,10 @@
747785 :offset [0.0 (- off)]}
748786 (dissoc opts :height :scroll-key :reserve :stick-to-bottom
749787 :scroll-to-bottom :on-at-end))
750- body)
788+ (fn [bid [_ by :as brect]]
789+ (binding [*viewport* {:area area :top (+ (double by) padding)
790+ :off off :h h :maxoff maxoff}]
791+ (body bid brect))))
751792 ;; Within a couple of lines of the end counts as at it: a reader
752793 ;; who has not moved should not stop being followed because the
753794 ;; last message was a pixel taller than the one before.
@@ -641,6 +641,35 @@
641 ;; and the name outlives the node.641 ;; and the name outlives the node.
642 (atom {}))642 (atom {}))
643 643
644+(defonce ^:private reveals
645+ ;; What a viewport has been asked to bring into view, by area, for the next
646+ ;; walk to act on. Apart from `scroll-areas` because the ask is made from
647+ ;; INSIDE the body, which runs before the area writes its own state back —
648+ ;; kept there, that write would wipe the ask it was just handed.
649+ (atom {}))
650+
651+(def ^:private ^:dynamic *viewport*
652+ "The scroll area the body being walked sits in: where its content starts,
653+ how far it is scrolled and how much of it shows. What `reveal!` measures a
654+ rectangle against."
655+ nil)
656+
657+(defn reveal!
658+ "Ask the scroll area around the caller to bring `rect` into view, centred.
659+
660+ `rect` is as this walk placed it, so already moved by the offset. The area
661+ acts on it on the next walk, and a walk is asked for only when the offset
662+ would actually change: a caller that asks on every frame for the moment of
663+ a jump costs nothing once the list is there. Outside a scroll area it does
664+ nothing."
665+ [[_ y _ rh]]
666+ (when-let [{:keys [area top off h maxoff]} *viewport*]
667+ (let [at (+ (- (double y) top) off)
668+ target (min maxoff (max 0.0 (- at (max 0.0 (/ (- h (double rh)) 2.0)))))]
669+ (swap! reveals assoc area target)
670+ (when (> (Math/abs (- target off)) 0.5) (c/refresh!))))
671+ nil)
672+
644 (defn scroll-offset673 (defn scroll-offset
645 "How far the area named `k` is scrolled, or nil if it has never shown.674 "How far the area named `k` is scrolled, or nil if it has never shown.
646 675
@@ -707,15 +736,24 @@
707 wheeled (reduce (fn [o e] (min maxoff (max 0.0 (- o (* 40.0 (:dy e))))))736 wheeled (reduce (fn [o e] (min maxoff (max 0.0 (- o (* 40.0 (:dy e))))))
708 off0 wheel)737 off0 wheel)
709 moved? (not= wheeled off0)738 moved? (not= wheeled off0)
739+ ;; What a child asked to be shown, on the walk before this one. Taken
740+ ;; off as it is read: a child that still wants it asks again.
741+ reveal (get @reveals area)
742+ _ (swap! reveals dissoc area)
710 ;; Sticking and jumping are the same control pulling opposite743 ;; Sticking and jumping are the same control pulling opposite
711 ;; ways. Sticking wins over a jump, so a jump to an old message744 ;; ways. Sticking wins over a jump, so a jump to an old message
712 ;; is not snatched back by the next arrival — but a hand on the745 ;; is not snatched back by the next arrival — but a hand on the
713- ;; wheel wins over both.746+ ;; wheel wins over both. A child asking to be seen wins over the
714- stick? (and stick-to-bottom (not jump?) (not moved?) (:at-end st true))747+ ;; stick too: it is a jump to somewhere other than the end.
748+ stick? (and stick-to-bottom (not jump?) (not reveal) (not moved?)
749+ (:at-end st true))
715 off (cond750 off (cond
751+ moved? wheeled
752+ reveal (min maxoff (max 0.0 (double reveal)))
716 jump? maxoff753 jump? maxoff
717 stick? maxoff754 stick? maxoff
718 :else wheeled)755 :else wheeled)
756+ padding (double (or (:padding opts) 0.0))
719 ;; The gutter the bar is drawn in, taken off the content whether or757 ;; The gutter the bar is drawn in, taken off the content whether or
720 ;; not there is anything to scroll yet. Always, because the758 ;; not there is anything to scroll yet. Always, because the
721 ;; alternative is that a list reflows the moment it grows past the759 ;; alternative is that a list reflows the moment it grows past the
@@ -747,7 +785,10 @@
747 :offset [0.0 (- off)]}785 :offset [0.0 (- off)]}
748 (dissoc opts :height :scroll-key :reserve :stick-to-bottom786 (dissoc opts :height :scroll-key :reserve :stick-to-bottom
749 :scroll-to-bottom :on-at-end))787 :scroll-to-bottom :on-at-end))
750- body)788+ (fn [bid [_ by :as brect]]
789+ (binding [*viewport* {:area area :top (+ (double by) padding)
790+ :off off :h h :maxoff maxoff}]
791+ (body bid brect))))
751 ;; Within a couple of lines of the end counts as at it: a reader792 ;; Within a couple of lines of the end counts as at it: a reader
752 ;; who has not moved should not stop being followed because the793 ;; who has not moved should not stop being followed because the
753 ;; last message was a pixel taller than the one before.794 ;; last message was a pixel taller than the one before.
modified jvui/test/jvui/tests.clj +33 -0
@@ -381,6 +381,38 @@
381381 (check! (< @first-y top)
382382 (str "a wheel down moves the contents up: " top " -> " @first-y)))))
383383
384+(defn- check-reveal! []
385+ ;; A reply's "go to the message" is a row far above the end of the list
386+ ;; asking to be on screen. It has to land there, and the list has to go
387+ ;; back to the reader's hands once nothing is asking any more.
388+ (let [cx (ctx) target-y (atom nil) view-y (atom nil) ask? (atom false)
389+ render (fn []
390+ (w/scroll* {:height 100 :scroll-key "reveal" :stick-to-bottom true}
391+ (fn [_ [_ y]]
392+ (reset! view-y y)
393+ (doseq [i (range 40)]
394+ (if (= i 5)
395+ (c/box* {:dir :vertical}
396+ (fn [_ r]
397+ (when @ask? (w/reveal! r))
398+ (reset! target-y
399+ (second (w/label "target" {:expand :none})))))
400+ (w/label (str "row " i) {:expand :none}))))))]
401+ (dotimes [_ 3] (frame! cx render))
402+ (check! (> (w/scroll-offset "reveal") 100.0) "the list starts stuck to its end")
403+ (reset! ask? true)
404+ (dotimes [_ 2] (frame! cx render))
405+ (let [y (- @target-y @view-y)]
406+ (check! (and (>= y 0.0) (<= (+ y 16.0) 100.0))
407+ (str "an asked-for row is brought into the viewport: y=" y)))
408+ (reset! ask? false)
409+ (frame! cx render)
410+ (let [off (w/scroll-offset "reveal")]
411+ (frame! cx render [{:kind :motion :x 50 :y 50}
412+ {:kind :wheel :dx 0.0 :dy -3.0}])
413+ (check! (> (w/scroll-offset "reveal") off)
414+ "and the wheel moves it again once nothing asks"))))
415+
384416 ;; --- theme -------------------------------------------------------------------
385417
386418 (defn- check-theme! []
@@ -502,6 +534,7 @@
502534 ["a paste of nothing asks" check-paste-with-no-text!]
503535 ["tab moves focus" check-tab-moves-focus!]
504536 ["a viewport scrolls" check-scroll!]
537+ ["a row asks to be seen" check-reveal!]
505538 ["the theme mixes" check-theme!]])
506539
507540 (defn -main [& _]
@@ -381,6 +381,38 @@
381 (check! (< @first-y top)381 (check! (< @first-y top)
382 (str "a wheel down moves the contents up: " top " -> " @first-y)))))382 (str "a wheel down moves the contents up: " top " -> " @first-y)))))
383 383
384+(defn- check-reveal! []
385+ ;; A reply's "go to the message" is a row far above the end of the list
386+ ;; asking to be on screen. It has to land there, and the list has to go
387+ ;; back to the reader's hands once nothing is asking any more.
388+ (let [cx (ctx) target-y (atom nil) view-y (atom nil) ask? (atom false)
389+ render (fn []
390+ (w/scroll* {:height 100 :scroll-key "reveal" :stick-to-bottom true}
391+ (fn [_ [_ y]]
392+ (reset! view-y y)
393+ (doseq [i (range 40)]
394+ (if (= i 5)
395+ (c/box* {:dir :vertical}
396+ (fn [_ r]
397+ (when @ask? (w/reveal! r))
398+ (reset! target-y
399+ (second (w/label "target" {:expand :none})))))
400+ (w/label (str "row " i) {:expand :none}))))))]
401+ (dotimes [_ 3] (frame! cx render))
402+ (check! (> (w/scroll-offset "reveal") 100.0) "the list starts stuck to its end")
403+ (reset! ask? true)
404+ (dotimes [_ 2] (frame! cx render))
405+ (let [y (- @target-y @view-y)]
406+ (check! (and (>= y 0.0) (<= (+ y 16.0) 100.0))
407+ (str "an asked-for row is brought into the viewport: y=" y)))
408+ (reset! ask? false)
409+ (frame! cx render)
410+ (let [off (w/scroll-offset "reveal")]
411+ (frame! cx render [{:kind :motion :x 50 :y 50}
412+ {:kind :wheel :dx 0.0 :dy -3.0}])
413+ (check! (> (w/scroll-offset "reveal") off)
414+ "and the wheel moves it again once nothing asks"))))
415+
384 ;; --- theme -------------------------------------------------------------------416 ;; --- theme -------------------------------------------------------------------
385 417
386 (defn- check-theme! []418 (defn- check-theme! []
@@ -502,6 +534,7 @@
502 ["a paste of nothing asks" check-paste-with-no-text!]534 ["a paste of nothing asks" check-paste-with-no-text!]
503 ["tab moves focus" check-tab-moves-focus!]535 ["tab moves focus" check-tab-moves-focus!]
504 ["a viewport scrolls" check-scroll!]536 ["a viewport scrolls" check-scroll!]
537+ ["a row asks to be seen" check-reveal!]
505 ["the theme mixes" check-theme!]])538 ["the theme mixes" check-theme!]])
506 539
507 (defn -main [& _]540 (defn -main [& _]