feat: add non-linear change history with undo/redoHEADmaster

1 files changed, 95 insertions, 11 deletions

diff --git a/lib/editor.ml b/lib/editor.ml
index ea2e68a..315067b 100644
--- a/lib/editor.ml
+++ b/lib/editor.ml
@@ -14,7 +14,7 @@ type editor = {
   mode : Mode.t;
   offset : int * int;
   cursor : cursor;
-  buffer : Buffer.t;
+  buffer : Buffer.t Tipper.t;
   rendered : bool;
   istream : Command.t Sequence.t;
   nstream : Command.t Sequence.t;
@@ -39,7 +39,8 @@ let init (c : Config.t) : editor =
     buffer =
       List.hd c.files
       |> Option.map ~f:Buffer.from_file
-      |> Option.value ~default:Buffer.empty;
+      |> Option.value_or_thunk ~default:Buffer.empty
+      |> Tipper.create;
     rendered = true;
     istream = Command.i_stream;
     nstream = Command.n_stream;
@@ -59,10 +60,11 @@ let statusbar e =
   let w = e.term.size |> snd in
   let status =
     let mode = e.mode |> Mode.to_string |> sequence_of_string in
-    let lsize = Sequence.length mode
-    and c = e.buffer.kind |> Buffer.string_of_kind |> sequence_of_string
-    and br, bc = Buffer.size e.buffer
-    and cr, cc = Buffer.cursor ~rendered:false e.buffer in
+    let lsize = Sequence.length mode in
+    let buf = Tipper.focus e.buffer in
+    let c = buf.kind |> Buffer.string_of_kind |> sequence_of_string
+    and br, bc = Buffer.size buf
+    and cr, cc = Buffer.cursor ~rendered:false buf in
     let perc =
       match cr with
       | 0 -> "Top"
@@ -136,15 +138,25 @@ module Action = struct
       let dx, dy = e.offset and rs, cs = e.term.size in
       (* Limit cursor to buffer view *)
       let rs = rs - e.status_size in
-      let cx, cy = Buffer.cursor e.buffer in
+      let cx, cy = e.buffer |> Tipper.focus |> Buffer.cursor in
       let dx' = Int.clamp_exn ~min:(cx - rs + 1) ~max:cx dx
       and dy' = Int.clamp_exn ~min:(cy - cs + 1) ~max:cy dy in
       { e with cursor = (cx - dx' + 1, cy - dy' + 1); offset = (dx', dy') }
     in
     modify ~f:aux
 
-  let get_focused_buffer e = (e.buffer, e)
-  let set_focused_buffer b e = ((), { e with buffer = b })
+  let get_focused_buffer_history e = (e.buffer, e)
+
+  let set_focused_buffer_history h =
+    (fun e -> ((), { e with buffer = h })) *> update_cursor
+
+  let on_focused_buffer_history f =
+    get_focused_buffer_history >>| f >>= set_focused_buffer_history
+
+  let get_focused_buffer e = (Tipper.focus e.buffer, e)
+
+  let set_focused_buffer b e =
+    ((), { e with buffer = Tipper.set_focus b e.buffer })
 
   let on_focused_buffer f =
     let* b = get_focused_buffer in
@@ -196,7 +208,7 @@ module Action = struct
       in
       let ssize = e.status_size in
       let bufview =
-        e.buffer
+        e.buffer |> Tipper.focus
         |> limit x y (r - ssize) c
         |> Text.extend ~fill r
         |> Fn.flip Sequence.take (r - ssize)
@@ -246,6 +258,48 @@ module Action = struct
         set_message (Printf.sprintf "Pattern not found: %s" word)
     | Some (r, c) -> Buffer.Action.goto ~r ~c |> on_focused_buffer
 
+  (* History *)
+  let take_buffer_snapshot =
+    let* h = get_focused_buffer_history in
+    let buf = { (Tipper.focus h) with last_modified = Unix.gettimeofday () } in
+    let h = Tipper.(h |> push (create buf) |> down) in
+    set_focused_buffer_history h
+
+  let undo =
+    let* h = get_focused_buffer_history in
+    if Tipper.is_root h then set_message "Already at the oldest change"
+    else set_focused_buffer_history (Tipper.up h)
+
+  let redo =
+    let* h = get_focused_buffer_history in
+    if Tipper.is_leaf h then set_message "Already at the newest change"
+    else set_focused_buffer_history (Tipper.down h)
+
+  let timetravel ?(later = false) ?(_secs = 0.) =
+    let last_modified (n : Buffer.t Tipper.t) =
+      (Tipper.focus n).last_modified
+    in
+    let find ts h =
+      let f a t =
+        let tmax =
+          if later then
+            Option.(map ~f:last_modified a |> value ~default:Float.max_value)
+          else ts
+        in
+        let tmin =
+          if later then ts
+          else Option.(map ~f:last_modified a |> value ~default:0.)
+        and cur = last_modified t in
+        if Float.(tmin < cur && cur < tmax) then Some t else a
+      in
+      Tipper.fold ~a:None ~f h
+    in
+    let* h = get_focused_buffer_history in
+    let ts = last_modified h in
+    match find ts (Tipper.root h) with
+    | None -> set_message "Already at the oldest change"
+    | Some h -> set_focused_buffer_history h
+
   (* Debug *)
   let get_rendered e = (e.rendered, e)
   let set_rendered r e = ((), { e with rendered = r })
@@ -372,6 +426,7 @@ let handle_normal_command c =
     (* Change *)
     | Shortcut (r, n, Change) ->
         let n = Option.value ~default:1 n - 1 in
+        let* () = take_buffer_snapshot in
         let* out = Buffer.Action.delete_to_eol ~n |> on_focused_buffer in
         let* () = set_register ?r (Glyphwise out) in
         set_mode Insert
@@ -383,6 +438,7 @@ let handle_normal_command c =
           and* () = insert_line ~before:true *> move_up in
           return out
         in
+        let* () = take_buffer_snapshot in
         let* out = act |> on_focused_buffer in
         let* () = set_register ?r (Linewise out) in
         set_mode Insert
@@ -394,16 +450,19 @@ let handle_normal_command c =
           and* () = insert_line ~before:true *> move_up in
           return out
         in
+        let* () = take_buffer_snapshot in
         let* out = act |> on_focused_buffer in
         let* () = set_register ?r (Linewise out) in
         set_mode Insert
     | Chord (r, n1, Change, n2, Left) ->
         let n = Option.(value ~default:1 n1 * value ~default:1 n2) in
+        let* () = take_buffer_snapshot in
         let* out = Buffer.Action.delete_before ~n |> on_focused_buffer in
         let* () = set_register ?r (Glyphwise out) in
         set_mode Insert
     | Chord (r, n1, Change, n2, Right) ->
         let n = Option.(value ~default:1 n1 * value ~default:1 n2) in
+        let* () = take_buffer_snapshot in
         let* out = Buffer.Action.delete_after ~n |> on_focused_buffer in
         let* () = set_register ?r (Glyphwise out) in
         set_mode Insert
@@ -415,41 +474,50 @@ let handle_normal_command c =
           and* () = insert_line ~before:true *> move_up in
           return out
         in
+        let* () = take_buffer_snapshot in
         let* out = act |> on_focused_buffer in
         let* () = set_register ?r (Linewise out) in
         set_mode Insert
     | Chord (r, _, Change, _, To_bol) ->
+        let* () = take_buffer_snapshot in
         let* out = Buffer.Action.delete_to_bol |> on_focused_buffer in
         let* () = set_register ?r (Glyphwise out) in
         set_mode Insert
     | Chord (r, n1, Change, n2, To_eol) ->
         let n = Option.((value ~default:1 n1 * value ~default:1 n2) - 1) in
+        let* () = take_buffer_snapshot in
         let* out = Buffer.Action.delete_to_eol ~n |> on_focused_buffer in
         let* () = set_register ?r (Glyphwise out) in
         set_mode Insert
     (* Delete *)
     | Shortcut (r, n, Delete) ->
         let n = Option.value ~default:1 n - 1 in
+        let* () = take_buffer_snapshot in
         let* out = Buffer.Action.delete_to_eol ~n |> on_focused_buffer in
         set_register ?r (Glyphwise out)
     | Chord (r, n1, Delete, n2, Line) ->
         let n = Option.(value ~default:1 n1 * value ~default:1 n2) in
+        let* () = take_buffer_snapshot in
         let* out = Buffer.Action.delete_lines ~n |> on_focused_buffer in
         set_register ?r (Linewise out)
     | Chord (r, n1, Delete, n2, Down) ->
         let n = Option.((value ~default:1 n1 * value ~default:1 n2) + 1) in
+        let* () = take_buffer_snapshot in
         let* out = Buffer.Action.delete_lines ~n |> on_focused_buffer in
         set_register ?r (Linewise out)
     | Chord (r, n1, Delete, n2, Left) ->
         let n = Option.(value ~default:1 n1 * value ~default:1 n2) in
+        let* () = take_buffer_snapshot in
         let* out = Buffer.Action.delete_before ~n |> on_focused_buffer in
         set_register ?r (Glyphwise out)
     | Chord (r, n1, Delete, n2, Right) ->
         let n = Option.(value ~default:1 n1 * value ~default:1 n2) in
+        let* () = take_buffer_snapshot in
         let* out = Buffer.Action.delete_after ~n |> on_focused_buffer in
         set_register ?r (Glyphwise out)
     | Chord (r, n1, Delete, n2, Up) ->
         let n = Option.(value ~default:1 n1 * value ~default:1 n2) in
+        let* () = take_buffer_snapshot in
         let* out =
           Buffer.Action.(move_up ~n *> delete_lines ~n:(n + 1))
           |> on_focused_buffer
@@ -457,37 +525,47 @@ let handle_normal_command c =
         set_register ?r (Linewise out)
     | Shortcut (r, n, Erase_before) ->
         let n = Option.value ~default:1 n in
+        let* () = take_buffer_snapshot in
         let* out = Buffer.Action.delete_before ~n |> on_focused_buffer in
         set_register ?r (Glyphwise out)
     | Shortcut (r, n, Erase_after) ->
         let n = Option.value ~default:1 n in
+        let* () = take_buffer_snapshot in
         let* out = Buffer.Action.delete_after ~n |> on_focused_buffer in
         set_register ?r (Glyphwise out)
     | Chord (r, _, Delete, _, To_bol) ->
+        let* () = take_buffer_snapshot in
         let* out = Buffer.Action.delete_to_bol |> on_focused_buffer in
         set_register ?r (Glyphwise out)
     | Chord (r, n1, Delete, n2, To_eol) ->
         let n = Option.((value ~default:1 n1 * value ~default:1 n2) - 1) in
+        let* () = take_buffer_snapshot in
         let* out = Buffer.Action.delete_to_eol ~n |> on_focused_buffer in
         set_register ?r (Glyphwise out)
     (* Paste *)
     | Shortcut (r, n, Paste_after) -> (
         get_register ?r >>= function
         | Empty -> noop
-        | Glyphwise z -> Buffer.Action.paste ?n z |> on_focused_buffer
+        | Glyphwise z ->
+            let* () = take_buffer_snapshot in
+            Buffer.Action.paste ?n z |> on_focused_buffer
         | Linewise z ->
+            let* () = take_buffer_snapshot in
             Buffer.Action.paste ~linewise:true ?n z |> on_focused_buffer)
     | Shortcut (r, n, Paste_before) -> (
         get_register ?r >>= function
         | Empty -> noop
         | Glyphwise z ->
+            let* () = take_buffer_snapshot in
             Buffer.Action.paste ~before:true ?n z |> on_focused_buffer
         | Linewise z ->
+            let* () = take_buffer_snapshot in
             Buffer.Action.paste ~before:true ~linewise:true ?n z
             |> on_focused_buffer)
     (* Join *)
     | Shortcut (_, n, Join) ->
         let n = Option.(value ~default:2 n) in
+        let* () = take_buffer_snapshot in
         Buffer.Action.join_lines ~n |> on_focused_buffer
     (* Control *)
     | Simple (Key ':' as k) ->
@@ -512,6 +590,12 @@ let handle_normal_command c =
         | None -> set_message "No search history"
         | Some (dir, word) -> search (not dir) word |> repeat ?n)
     | Simple (Ctrl 'Q') -> quit 0
+    (* History *)
+    | Shortcut (_, n, Undo) -> repeat ?n undo
+    | Shortcut (_, n, Redo) -> repeat ?n redo
+    | Shortcut (_, n, Earlier) -> repeat ?n timetravel
+    | Shortcut (_, n, Later) -> repeat ?n (timetravel ~later:true)
+    (* | Shortcut (_, n, Redo) -> repeat ?n redo *)
     (* Misc *)
     | Simple (Key 'A') ->
         (Buffer.Action.eol |> on_focused_buffer) *> set_mode Insert