From f5c33507a74d83692c028d1e1659d3506399138e Mon Sep 17 00:00:00 2001 From: Federico Igne Date: Sun, 28 Jan 2024 23:42:12 +0100 Subject: feat: add non-linear change history with undo/redo --- lib/editor.ml | 106 ++++++++++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 95 insertions(+), 11 deletions(-) (limited to 'lib/editor.ml') 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 -- cgit v1.2.3