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/command.ml | 17 +++++++++ lib/editor.ml | 106 ++++++++++++++++++++++++++++++++++++++++++++++------ lib/editorBuffer.ml | 17 ++++++--- 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 -- cgit v1.2.3