Add Timeline tab reselect return-to-top transition

app/application.ml

@@ -373,9 +373,20 @@ let favorites_event state event =
 
 let select_destination state destination =
   if Journal_routes.destination state.routes = destination
-  then state
+  then (
+    if destination = Journal_routes.Journals
+       && Journal_routes.route state.routes = Timeline
+       && state.modal = No_modal
+       && state.graph_ready
+    then
+      let timeline = Journal_timeline_state.request_top state.timeline in
+      if timeline == state.timeline then state else { state with timeline }
+    else state)
   else
-    { state with routes = Journal_routes.select_destination state.routes destination }
+    { state with
+      routes = Journal_routes.select_destination state.routes destination
+    ; timeline = Journal_timeline_state.cancel_scroll state.timeline
+    }
     |> fun state ->
     favorites_event state (Select (destination = Journal_routes.Favorites))
 ;;
@@ -5715,7 +5726,11 @@ let start
           ~request_generation:generation
       in
       with_direct_request
-        { snapshot with routes; next_request_generation = Int64.succ generation }
+        { snapshot with
+          routes
+        ; timeline = Journal_timeline_state.cancel_scroll snapshot.timeline
+        ; next_request_generation = Int64.succ generation
+        }
         (Journal_graph_request.Load_detail
            { block_id; after = None; limit = 128; request_generation = generation })
     in

app/journal_lui_native.ml

@@ -14,6 +14,7 @@ let apple_profiles =
 ;;
 
 let payload_property = property "payload" StringScalar true None
+let scroll_request_property = property "scroll_request" StringScalar false None
 
 let event_schema =
   event
@@ -65,7 +66,7 @@ let registry =
        apple_profiles
        true
        children
-       [ payload_property ]
+       [ payload_property; scroll_request_property ]
        [ event_schema ]);
   register_component
     registry
@@ -118,9 +119,16 @@ let mount ?key ~payload ~children ?on_event identifier context parent =
   node
 ;;
 
-let list ?key ~payload ?on_event children : Lui_elements.t =
+let list ?key ~payload ?(scroll_request = "null") ?scroll_request_signal ?on_event children : Lui_elements.t =
   fun context parent ->
-  mount ?key ~payload ~children ?on_event list_identifier context parent
+  let node = mount ?key ~payload ~children ?on_event list_identifier context parent in
+  (match scroll_request_signal with
+   | None -> Lui_ui.extension_property context node "scroll_request" (StringValue scroll_request)
+   | Some source ->
+     let values = Signal.map (fun json -> StringValue json) source in
+     Signal.on_dispose context.Lui_ui.ui_scope (fun () -> Signal.dispose_signal values);
+     Lui_ui.extension_property_signal context node "scroll_request" values);
+  node
 ;;
 
 let image_preview ?key ~payload ?on_event children : Lui_elements.t =

app/journal_lui_native.mli

@@ -3,11 +3,12 @@
    Replaces the [Ui.Native_widget.Extension] registrations that previously
    carried kinds 2103, 2104 and 2106 over the bonsai_swiftui
    native-widget channel, plus the native collection.
-   Each component ships its properties as one [payload] string field holding
+   Components ship their content as one [payload] string field holding
    the same JSON object the Swift [Properties] structs already decode, and
    reports events through one ["event"] extension event with [id] (int) and
    [payload] (JSON string) fields, matching the old
-   [BonsaiNativeEvent(id, payload)] contract. *)
+   [BonsaiNativeEvent(id, payload)] contract. Native lists carry their independent
+   scroll command in a separate [scroll_request] string property. *)
 
 (** Lui extension identifiers (slugs). *)
 val chrome_identifier : string
@@ -46,6 +47,8 @@ val mount
 val list
   :  ?key:string
   -> payload:string
+  -> ?scroll_request:string
+  -> ?scroll_request_signal:string Signal.signal
   -> ?on_event:(event -> unit)
   -> Lui_elements.t list
   -> Lui_elements.t

app/journal_native_collection.ml

@@ -19,6 +19,7 @@ let view
       ~test_id
       ~rows
       ~scroll_target
+      ?scroll_target_signal
       ~on_scroll_completed
       ~actions_enabled
       ~on_visible_range
@@ -27,6 +28,7 @@ let view
       ~on_delete
       ~on_copy
       ~children
+      ()
   =
   let indexed =
     List.map (fun (row, child) -> row.slot_index, row, child) (List.combine rows children)
@@ -137,27 +139,35 @@ let view
                 }))
       | _ -> ())
   in
-  let scroll_request =
+  let scroll_request target =
     Option.map
       (fun (token, section, row) ->
+         let date = String.equal row ("day:" ^ section) in
          V.Native_list.scroll_request
            ~token
            ~target:
              (V.Native_list.target
                 ~section:(Ui.Key.string section)
-                ~row_path:[ Ui.Key.string row ])
+                ~row_path:(if date then [] else [ Ui.Key.string row ]))
            ~anchor:Top
-           ~animated:false
+           ~animated:date
            ())
-      scroll_target
+      target
   in
-  V.Native_list.vertical
+  let list ?scroll_request_signal () = V.Native_list.vertical
     ~key
     ~style:Plain
-    ?scroll_request
+    ?scroll_request:(scroll_request scroll_target)
+    ?scroll_request_signal
     ~on_scroll_completed
     ~on_visible_range
-    sections
+    sections in
+  (match scroll_target_signal with
+   | None -> list ()
+   | Some source -> V.of_lui (fun context parent ->
+       let requests = Signal.map scroll_request source in
+       Signal.on_dispose context.Lui_ui.ui_scope (fun () -> Signal.dispose_signal requests);
+       Ui.mount (list ~scroll_request_signal:requests ()) context parent))
   |> V.Viewport.Vertical.with_test_id test_id
   |> V.Viewport.Vertical.overlay
        ~key:(Ui.Key.string "journal-empty-presentation")

app/journal_native_collection.mli

@@ -13,6 +13,7 @@ val view
   -> test_id:Ui.Test_id.t
   -> rows:row list
   -> scroll_target:(int64 * string * string) option
+  -> ?scroll_target_signal:(int64 * string * string) option Signal.signal
   -> on_scroll_completed:Ui.Event.Handler.t
   -> actions_enabled:bool
   -> on_visible_range:Ui.Event.Handler.t
@@ -21,4 +22,5 @@ val view
   -> on_delete:Ui.Event.Handler.t
   -> on_copy:Ui.Event.Handler.t
   -> children:Ui.View.t list
+  -> unit
   -> Ui.View.Viewport.Vertical.t

app/journal_timeline.ml

@@ -42,9 +42,11 @@ module Store = struct
   type t =
     { rows : (string, row) Hashtbl.t
     ; listeners : (string, (int, listener) Hashtbl.t) Hashtbl.t
+    ; scroll_listeners : (int, listener) Hashtbl.t
+    ; mutable scroll_target : (int64 * int * string) option
     ; 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
@@ -53,6 +55,8 @@ module Store = struct
   let create ?(observe = fun _ -> ()) () =
     { rows = Hashtbl.create 64
     ; listeners = Hashtbl.create 64
+    ; scroll_listeners = Hashtbl.create 2
+    ; scroll_target = None
     ; observe
     ; last = None
     ; shape = None
@@ -64,6 +68,26 @@ module Store = struct
 
   let find t block_id = Hashtbl.find_opt t.rows block_id
 
+  let scroll_target t = t.scroll_target
+
+  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 publish_scroll t target =
+    if t.scroll_target <> target then (
+      t.scroll_target <- target;
+      let listeners = Hashtbl.fold (fun _ value rest -> value :: rest) t.scroll_listeners [] in
+      List.iter (fun listener ->
+        if listener.active && listener.epoch = t.epoch then listener.callback ()) listeners)
+  ;;
+
   let subscribe t block_id callback =
     let bucket =
       match Hashtbl.find_opt t.listeners block_id with
@@ -102,6 +126,7 @@ module Store = struct
   (* Only a changed timeline presentation reaches this traversal. Media,
      navigation, draft and visible-demand writes do not scan retained rows. *)
   let synchronize t state =
+    publish_scroll t (Timeline.scroll_target state);
     let same =
       Option.fold
         ~none:false
@@ -158,7 +183,7 @@ 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;
@@ -169,6 +194,7 @@ module Store = struct
   ;;
 
   let reset t =
+    publish_scroll t None;
     t.epoch <- t.epoch + 1;
     t.last <- None;
     t.shape <- None;
@@ -321,14 +347,25 @@ let view
     else presented
   in
   let rows, children = List.split presented in
-  Journal_native_collection.view
+  let scroll_target target =
+    Option.bind target (fun (token, day, row) ->
+      let section = string_of_int day in
+      if String.equal row ("day:" ^ section) then
+        (* Empty Today can be synthesized before future slots. Resolve the
+           top intent from the actual presentation, preserving Capture rows. *)
+        (match rows with
+         | [] -> None
+         | (first : Journal_native_collection.row) :: _ ->
+           Some (token, first.section, "day:" ^ first.section))
+      else Some (token, section, row))
+  in
+  let collection ?scroll_target_signal target =
+    Journal_native_collection.view
     ~key:(Ui.Key.string "journal-timeline-list")
     ~test_id:(Ui.Test_id.string "journal-timeline")
     ~rows
-    ~scroll_target:
-      (Option.map
-         (fun (token, day, row) -> token, string_of_int day, row)
-         (Timeline.scroll_target state))
+    ~scroll_target:target
+    ?scroll_target_signal
     ~on_scroll_completed
     ~actions_enabled:(delete_enabled && actions_enabled)
     ~on_visible_range
@@ -337,6 +374,19 @@ let view
     ~on_delete
     ~on_copy
     ~children
+    ()
+  in
+  (match store with
+   | None -> collection (scroll_target (Timeline.scroll_target state))
+   | Some store -> V.of_lui (fun context parent ->
+       let command = Signal.state context.Lui_ui.ui_scheduler
+         (scroll_target (Store.scroll_target store)) in
+       let unsubscribe = Store.subscribe_scroll store (fun () ->
+         Signal.set command (scroll_target (Store.scroll_target store))) in
+       Signal.on_dispose context.ui_scope (fun () ->
+         unsubscribe ();
+         Signal.dispose_signal (Signal.value command));
+       Ui.mount (collection ~scroll_target_signal:(Signal.value command) None) context parent))
   |> V.Body.Vertical.fill
   |> fun content -> V.Body.Vertical.create [ content ]
 ;;

app/journal_timeline_state.ml

@@ -1050,6 +1050,25 @@ let next_request (state : t) =
 
 let pending_request (state : t) = state.pending
 
+let request_top (state : t) =
+  match state.scroll_target with
+  | Some _ -> state
+  | None ->
+    let token = Int64.succ state.scroll_generation in
+    { state with
+      scroll_generation = token
+    ; scroll_target = Some (token, state.today, "day:" ^ string_of_int state.today)
+    ; scroll_outcome = None
+    }
+;;
+
+let cancel_scroll (state : t) =
+  match state.scroll_target with
+  | None -> state
+  | Some _ ->
+    { state with scroll_target = None; scroll_outcome = Some Cancelled }
+;;
+
 let prepend_timeline_entry (state : t) (entry : Journal_graph_projection.timeline_entry) =
   let before = state in
   let block = entry.Journal_graph_projection.block in
@@ -1184,14 +1203,13 @@ 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. *)
+(* Content rendering consumes slots/date/errors. Scroll commands have an
+   independent mounted subscription; demand and recovery do not rebuild rows. *)
 let equal_presentation (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))
 ;;

app/journal_timeline_state.mli

@@ -41,8 +41,8 @@ val replace_timeline_entry_page
 
 val prepend_timeline_entry : t -> Journal_graph_projection.timeline_entry -> t
 
-(** Equality of the rendered slots, date/error presentation and scroll command.
-    Demand windows and recovery bookkeeping do not affect this comparison. *)
+(** Equality of rendered content. Scroll commands, demand windows and recovery
+    bookkeeping do not affect this comparison. *)
 val equal_presentation : t -> t -> bool
 
 val observe_visible_range : t -> first_index:int -> last_exclusive:int -> t
@@ -77,6 +77,10 @@ val fail_day_request
 val retry_day : t -> day:int -> t
 val first_visible_index : t -> int
 val scroll_generation : t -> int64
+(** Request the first date, coalescing an outstanding native scroll. *)
+val request_top : t -> t
+val cancel_scroll : t -> t
+
 val scroll_target : t -> (int64 * int * string) option
 val scroll_outcome : t -> Journal_view.View.Native_list.outcome option