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

3 files changed, 123 insertions, 17 deletions

diff --git a/lib/command.ml b/lib/command.ml
index 2d7b51b..6439165 100644
--- a/lib/command.ml
+++ b/lib/command.ml
@@ -17,6 +17,10 @@ type operation =
   | Search
   | Search_rev
   | Goto
+  | Undo
+  | Redo
+  | Earlier
+  | Later
 
 type scope = Line | To_bol | To_eol | Down | Left | Right | Up
 
@@ -85,6 +89,8 @@ let instant_operation =
     Key 'X';
     Key 'p';
     Key 'x';
+    Key 'u';
+    Ctrl 'R';
   ]
 
 let chord_operation = [ Key 'c'; Key 'd'; Key 'y' ]
@@ -101,6 +107,8 @@ let to_op = function
   | Key 'P' -> Paste_before
   | Key 'x' -> Erase_after
   | Key 'X' -> Erase_before
+  | Key 'u' -> Undo
+  | Ctrl 'R' -> Redo
   | _ -> failwith "Invalid operation in chord."
 
 let is_chord_operation k = List.mem ~equal:Poly.equal chord_operation k
@@ -129,6 +137,15 @@ let n_stream =
         (`start, shortcut ~r (to_op k))
     | `chord_fst_n (r, n), k when is_instant_operation k ->
         (`start, shortcut ?r ~n (to_op k))
+    (* Special operations *)
+    | `start, Key 'g' -> (`special (None, None), Partial k)
+    | `chord_reg r, Key 'g' -> (`special (Some r, None), Partial k)
+    | `chord_fst_n (r, n), Key 'g' -> (`special (r, Some n), Partial k)
+    | `special (r, n), Key 'g' ->
+        let n = Option.value ~default:0 n in
+        (`start, shortcut ?r ~n Goto)
+    | `special (r, n), Key '-' -> (`start, shortcut ?r ?n Earlier)
+    | `special (r, n), Key '+' -> (`start, shortcut ?r ?n Later)
     (* Chord operation (first) *)
     | `start, k when is_chord_operation k ->
         (`chord_cmd (None, None, to_op k), Partial k)
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
diff --git a/lib/editorBuffer.ml b/lib/editorBuffer.ml
index 959c04a..8aacd71 100644
--- a/lib/editorBuffer.ml
+++ b/lib/editorBuffer.ml
@@ -10,15 +10,17 @@ type buffer = {
   kind : kind;
   content : (char zipper zipper, error) Result.t;
   rendered : char Sequence.t zipper;
+  last_modified : float;
 }
 
 type t = buffer
 
-let empty =
+let empty () =
   {
     kind = No_name;
     content = empty |> push empty |> Result.return;
     rendered = push Sequence.empty empty;
+    last_modified = Unix.gettimeofday ();
   }
 
 let kind b = b.kind
@@ -106,13 +108,14 @@ module Action = struct
     match b.content with
     | Error _ -> ((), b)
     | Ok c ->
-        let step = if before then left else right in
+        let rstep = if before then left else right ~by_one:false in
+        let cstep = if before then left else right ~by_one:false in
         let rec aux i r c =
           if i = 0 then r
           else
             let default = Sequence.empty in
             let l = apply_focus_or ~default (to_seq &> render) c in
-            let c' = step c and r' = swap_focus l r |> step in
+            let c' = cstep c and r' = swap_focus l r |> rstep in
             aux (i - 1) r' c'
         in
         ((), { b with rendered = aux n b.rendered c |> goto (left_length c) })
@@ -444,9 +447,11 @@ let from_file f =
       Sequence.(of_list lines |> map ~f:line_to_seq)
     with Unix.Unix_error (ENOENT, _, _) -> Sequence.empty
   in
-  let rendered = Sequence.map ~f:render lines |> of_seq in
-  let content = Sequence.map ~f:of_seq lines |> of_seq in
-  { kind = File f; content = Ok content; rendered }
+  let kind = File f
+  and content = Sequence.map ~f:of_seq lines |> of_seq |> Result.return
+  and rendered = Sequence.map ~f:render lines |> of_seq
+  and last_modified = Unix.gettimeofday () in
+  { kind; content; rendered; last_modified }
 
 let unrendered_view x y h w b =
   match b.content with