Scroll Timeline to top when reselecting Journals

app/application.ml

@@ -1460,6 +1460,11 @@ module Root_navigation = struct
   let step state event =
     let state =
       match event with
+      | Select Journal_routes.Journals
+        when Journal_routes.destination state.routes = Journals
+             && Journal_routes.route state.routes = Timeline
+             && state.modal = No_modal ->
+        { state with timeline = Journal_timeline_state.scroll_to_top state.timeline }
       | Select destination -> select_destination state destination
       | Capture_opened ->
         let state =
@@ -1620,6 +1625,7 @@ module Root_navigation = struct
   ;;
 
   let destination state = Journal_routes.destination state.routes
+  let timeline state = state.timeline
   let capture_presented state = state.modal = Capture_sheet
   let capture state = state.direct_capture
   let favorites state = state.favorites

app/application.mli

@@ -132,6 +132,7 @@ module Root_navigation : sig
   val create : graph_generation:int -> t
   val step : t -> event -> t
   val destination : t -> Journal_routes.destination
+  val timeline : t -> Journal_timeline_state.t
   val capture_presented : t -> bool
   val capture : t -> Journal_capture.t option
   val favorites : t -> Journal_routes.Favorites.t

app/journal_native_collection.ml

@@ -18,7 +18,7 @@ let view
       ~key
       ~test_id
       ~rows
-      ~scroll_target
+      ~scroll_request
       ~on_scroll_completed
       ~actions_enabled
       ~on_visible_range
@@ -137,39 +137,22 @@ let view
                 }))
       | _ -> ())
   in
-  let scroll_request =
-    Option.map
-      (fun (token, section, row) ->
-         V.Native_list.scroll_request
-           ~token
-           ~target:
-             (V.Native_list.target
-                ~section:(Ui.Key.string section)
-                ~row_path:[ Ui.Key.string row ])
-           ~anchor:Top
-           ~animated:false
-           ())
-      scroll_target
-  in
-  V.Native_list.vertical
+  let content = V.Native_list.vertical
     ~key
     ~style:Plain
     ?scroll_request
     ~on_scroll_completed
     ~on_visible_range
     sections
   |> V.Viewport.Vertical.with_test_id test_id
-  |> V.Viewport.Vertical.overlay
-       ~key:(Ui.Key.string "journal-empty-presentation")
-       ~overlay:
-         (if rows = []
-          then
-            V.content_unavailable
-              ~label:
-                (V.label
-                   ~title:(V.text "No journal entries yet")
-                   ~icon:(V.symbol ~name:"book" ())
-                   ())
-              ()
-          else V.empty ())
+  in
+  if rows <> [] then content
+  else
+    V.Viewport.Vertical.overlay
+      ~key:(Ui.Key.string "journal-empty-presentation")
+      ~overlay:
+        (V.content_unavailable
+           ~label:(V.label ~title:(V.text "No journal entries yet")
+             ~icon:(V.symbol ~name:"book" ()) ()) ())
+      content
 ;;

app/journal_native_collection.mli

@@ -12,7 +12,7 @@ val view
   :  key:Ui.Key.t
   -> test_id:Ui.Test_id.t
   -> rows:row list
-  -> scroll_target:(int64 * string * string) option
+  -> scroll_request:Ui.View.Native_list.scroll_request option
   -> on_scroll_completed:Ui.Event.Handler.t
   -> actions_enabled:bool
   -> on_visible_range:Ui.Event.Handler.t

app/journal_timeline.ml

@@ -23,6 +23,30 @@ let should_show_timestamp ~today ~previous_slot = function
   | Top_level _ | Day_heading _ | Day_continuation _ | Feed_continuation _ -> false
 ;;
 
+let scroll_parameters = function
+  | Timeline.Row { token; day; row } -> token, day, [ row ], false
+  | Timeline.Top { token; day } -> token, day, [], true
+;;
+
+(* Command-only payloads update the mounted native List without resubmitting
+   its rows/children, which would invalidate native self-sizing mid-scroll. *)
+let scroll_command target =
+  let request =
+    match target with
+    | None -> `Null
+    | Some target ->
+      let token, day, row_path, animated = scroll_parameters target in
+      `Assoc
+        [ "token", `Intlit (Int64.to_string token)
+        ; "target", `Assoc [ "section", `String (string_of_int day)
+                           ; "row_path", `List (List.map (fun key -> `String key) row_path) ]
+        ; "anchor", `String "top"
+        ; "animated", `Bool animated
+        ]
+  in
+  Yojson.Safe.to_string (`Assoc [ "command", `String "scroll"; "scroll_request", request ])
+;;
+
 module Store = struct
   type row =
     { entry : Journal_graph_projection.timeline_entry
@@ -44,10 +68,11 @@ module Store = struct
     ; listeners : (string, (int, listener) Hashtbl.t) Hashtbl.t
     ; observe : string -> unit
     ; mutable last : Timeline.t option
-    ; mutable shape : (int * (int64 * int * string) option * shape list) option
+    ; mutable shape : (int * shape list) option
     ; mutable revision : int
     ; mutable epoch : int
     ; mutable serial : int
+    ; scroll_listeners : (int, listener) Hashtbl.t
     }
 
   let create ?(observe = fun _ -> ()) () =
@@ -59,6 +84,7 @@ module Store = struct
     ; revision = 0
     ; epoch = 0
     ; serial = 0
+    ; scroll_listeners = Hashtbl.create 1
     }
   ;;
 
@@ -85,6 +111,16 @@ module Store = struct
         if Hashtbl.length bucket = 0 then Hashtbl.remove t.listeners block_id)
   ;;
 
+  let subscribe_scroll t callback =
+    t.serial <- t.serial + 1;
+    let id = t.serial in
+    let listener = { epoch = t.epoch; active = true; callback } in
+    Hashtbl.add t.scroll_listeners id listener;
+    fun () -> listener.active <- false; Hashtbl.remove t.scroll_listeners id
+  ;;
+
+  let scroll_target t = Option.bind t.last Timeline.scroll_target
+
   let notify t block_id =
     Option.iter
       (fun bucket ->
@@ -105,9 +141,13 @@ module Store = struct
     let same =
       Option.fold
         ~none:false
-        ~some:(fun old -> Timeline.equal_presentation old state)
+        ~some:(fun old -> Timeline.equal_content old state)
         t.last
     in
+    let scroll_changed =
+      Option.fold ~none:(Option.is_some (Timeline.scroll_target state))
+        ~some:(fun old -> Timeline.scroll_target old <> Timeline.scroll_target state) t.last
+    in
     t.last <- Some state;
     if not same
     then (
@@ -158,21 +198,31 @@ module Store = struct
           []
       in
       List.iter (Hashtbl.remove t.rows) removed;
-      let shape = Some (Timeline.today state, Timeline.scroll_target state, shape) in
+      let shape = Some (Timeline.today state, shape) in
       if t.shape <> shape
       then (
         t.shape <- shape;
         t.revision <- t.revision + 1;
         t.observe "timeline-structure-change");
       List.iter (notify t) (List.rev_append !changes removed));
+    if scroll_changed then
+      if same then
+        Hashtbl.iter (fun _ listener ->
+          if listener.active && listener.epoch = t.epoch then listener.callback ())
+          t.scroll_listeners
+      else
+        (* A real content change (including Capture) still submits its complete
+           row projection together with the command, as before. *)
+        t.revision <- t.revision + 1;
     t.revision
   ;;
 
   let reset t =
     t.epoch <- t.epoch + 1;
     t.last <- None;
     t.shape <- None;
-    Hashtbl.clear t.rows
+    Hashtbl.clear t.rows;
+    Hashtbl.clear t.scroll_listeners
   ;;
 end
 
@@ -317,13 +367,18 @@ let view
     else presented
   in
   let rows, children = List.split presented in
-  Journal_native_collection.view
+  let content = Journal_native_collection.view
     ~key:(Ui.Key.string "journal-timeline-list")
     ~test_id:(Ui.Test_id.string "journal-timeline")
     ~rows
-    ~scroll_target:
+    ~scroll_request:
       (Option.map
-         (fun (token, day, row) -> token, string_of_int day, row)
+         (fun target ->
+            let token, day, row_path, animated = scroll_parameters target in
+            let row_path = List.map Ui.Key.string row_path in
+            V.Native_list.scroll_request ~token
+              ~target:(V.Native_list.target ~section:(Ui.Key.string (string_of_int day)) ~row_path)
+              ~anchor:Top ~animated ())
          (Timeline.scroll_target state))
     ~on_scroll_completed
     ~actions_enabled:(delete_enabled && actions_enabled)
@@ -333,6 +388,20 @@ let view
     ~on_delete
     ~on_copy
     ~children
+  in
+  let content =
+    match store with
+    | None -> content
+    | Some store ->
+      V.of_lui (fun context parent ->
+        let node = Ui.mount content context parent in
+        let unsubscribe = Store.subscribe_scroll store (fun () ->
+          Lui_ui.extension_property context node "payload"
+            (Lui_protocol.StringValue (scroll_command (Store.scroll_target store)))) in
+        Signal.on_dispose context.Lui_ui.ui_scope unsubscribe;
+        node)
+  in
+  content
   |> V.Body.Vertical.fill
   |> fun content -> V.Body.Vertical.create [ content ]
 ;;

app/journal_timeline_state.ml

@@ -14,6 +14,10 @@ type slot =
       }
   | Feed_continuation of { before_day : int }
 
+type scroll_target =
+  | Row of { token : int64; day : int; row : string }
+  | Top of { token : int64; day : int }
+
 type recovery =
   { day : int
   ; target_count : int
@@ -43,7 +47,7 @@ type t =
   ; visible_first : int
   ; visible_last_exclusive : int
   ; scroll_generation : int64
-  ; scroll_target : (int64 * int * string) option
+  ; scroll_target : scroll_target option
   ; scroll_outcome : Journal_view.View.Native_list.outcome option
   ; visible_demand : request list option
   ; pending : (int64 * request) option
@@ -1116,8 +1120,8 @@ let prepend_timeline_entry (state : t) (entry : Journal_graph_projection.timelin
       Rrbvec.find_map
         (function
           | Top_level entry as slot ->
-            Some (token, Journal_model.journal_day entry.block, slot_key slot)
-          | Day_continuation { day; _ } as slot -> Some (token, day, slot_key slot)
+            Some (Row { token; day = Journal_model.journal_day entry.block; row = slot_key slot })
+          | Day_continuation { day; _ } as slot -> Some (Row { token; day; row = slot_key slot })
           | Day_heading _ | Feed_continuation _ -> None)
         next.slots
   }
@@ -1186,16 +1190,28 @@ let observe_visible_range (state : t) ~first_index ~last_exclusive =
 
 (* Rendering consumes slots/date/errors and the active scroll command, not the
    latest demand window or recovery bookkeeping. Slots are persistent. *)
-let equal_presentation (left : t) (right : t) =
+let equal_content (left : t) (right : t) =
   left == right
   || (left.slots == right.slots
       && left.today = right.today
       && left.day_failures == right.day_failures
-      && left.scroll_target = right.scroll_target
       && (left.day_failures = []
           || Option.is_some left.pending = Option.is_some right.pending))
 ;;
 
+let equal_presentation (left : t) (right : t) =
+  equal_content left right && left.scroll_target = right.scroll_target
+;;
+
+let scroll_to_top state =
+  let token = Int64.succ state.scroll_generation in
+  { state with
+    scroll_generation = token
+  ; scroll_target = Some (Top { token; day = state.today })
+  ; scroll_outcome = None
+  }
+;;
+
 let retained_slot (state : t) index = Rrbvec.nth_opt state.slots index
 let fold_slots f initial (state : t) = Rrbvec.fold_left f initial state.slots
 
@@ -1232,7 +1248,7 @@ let scroll_outcome (state : t) = state.scroll_outcome
 
 let complete_scroll state ~token ~outcome =
   match state.scroll_target with
-  | Some (current, _, _) when current = token ->
+  | Some (Row { token = current; _ } | Top { token = current; _ }) when current = token ->
     { state with scroll_target = None; scroll_outcome = Some outcome }
   | None | Some _ -> state
 ;;

app/journal_timeline_state.mli

@@ -14,6 +14,10 @@ type slot =
       }
   | Feed_continuation of { before_day : int }
 
+type scroll_target =
+  | Row of { token : int64; day : int; row : string }
+  | Top of { token : int64; day : int }
+
 type t
 
 val empty : today:int -> t
@@ -45,6 +49,9 @@ val prepend_timeline_entry : t -> Journal_graph_projection.timeline_entry -> t
     Demand windows and recovery bookkeeping do not affect this comparison. *)
 val equal_presentation : t -> t -> bool
 
+(** Equality of row/date/error content, excluding scroll commands. *)
+val equal_content : t -> t -> bool
+
 val observe_visible_range : t -> first_index:int -> last_exclusive:int -> t
 
 (** Read an index relative to the first retained slot. Out-of-range indices return [None]. *)
@@ -77,7 +84,10 @@ val fail_day_request
 val retry_day : t -> day:int -> t
 val first_visible_index : t -> int
 val scroll_generation : t -> int64
-val scroll_target : t -> (int64 * int * string) option
+val scroll_target : t -> scroll_target option
+
+(** Request the native top edge without changing retained content or demand. *)
+val scroll_to_top : t -> t
 val scroll_outcome : t -> Journal_view.View.Native_list.outcome option
 
 val complete_scroll