From af0cd851fec5038faff5a8133cadad6c65568374 Mon Sep 17 00:00:00 2001 From: Federico Igne Date: Wed, 24 Jan 2024 21:14:11 +0100 Subject: feat: add ability to paste text from a register Register are simplier than Vim register, in particular no register is local to buffers. --- lib/command.ml | 3 +- lib/editor.ml | 98 ++++++++++++++++++++++------------------------------- lib/editorBuffer.ml | 55 ++++++++++++++++++++++++++++-- lib/zipper.ml | 12 ++++++- lib/zipper.mli | 12 +++++++ 5 files changed, 117 insertions(+), 63 deletions(-) diff --git a/lib/command.ml b/lib/command.ml index 74b616a..a55fb9e 100644 --- a/lib/command.ml +++ b/lib/command.ml @@ -93,7 +93,8 @@ let n_stream = match (s, k) with | `start, Key '"' -> (`chord_reg_pre, Partial k) (* Register *) - | `chord_reg_pre, Key c -> (`chord_reg c, Partial k) + | `chord_reg_pre, Key c when Char.('!' <= c && c <= '~') -> + (`chord_reg c, Partial k) (* Count (first) *) | `start, Key n when Char.('1' <= n && n <= '9') -> let n = Char.to_int n - 48 in diff --git a/lib/editor.ml b/lib/editor.ml index f8091b8..0ed2229 100644 --- a/lib/editor.ml +++ b/lib/editor.ml @@ -3,6 +3,12 @@ module Buffer = EditorBuffer open Util type mode = Normal | Insert | Control + +type selection = + | Empty + | Glyphwise of char Sequence.t Sequence.t + | Linewise of char Sequence.t Sequence.t + type cursor = int * int type editor = { @@ -19,6 +25,7 @@ type editor = { message_timestamp : float; message_duration : float; pending_command : string; + registers : selection Array.t; } type t = editor @@ -38,6 +45,7 @@ let init (c : Config.t) : editor = message_timestamp = Unix.time (); message_duration = 5.; pending_command = ""; + registers = Array.create ~len:128 Empty; } let string_of_mode = function @@ -142,6 +150,16 @@ module Action = struct let set_focused_buffer b e = ((), { e with buffer = Some b }) let get_terminal_size e = (e.term.size, e) + let get_register r e = + assert (Char.('!' <= r && r <= '~')); + (e.registers.(Char.to_int r), e) + + let set_register r z e = + assert (Char.('!' <= r && r <= '~')); + e.registers.(Char.to_int '"') <- z; + e.registers.(Char.to_int r) <- z; + ((), e) + let on_focused_buffer f = let f e = { e with buffer = Option.map ~f e.buffer } in modify ~f *> update_cursor @@ -218,64 +236,6 @@ let move ?(up = 0) ?(down = 0) ?(left = 0) ?(right = 0) (x, y) = let move_to ?x ?y (sx, sy) = Option.(value x ~default:sx, value y ~default:sy) -(* let get_next_command s = *) -(* match Sequence.next s.pending with *) -(* | None -> (None, s) *) -(* | Some (h, t) -> (Some h, { s with pending = t }) *) - -(* let handle_insert_key = *) -(* let open Action in *) -(* let open Key in *) -(* function *) -(* | Arrow_down -> Buffer.Action.down |> on_focused_buffer *) -(* | Arrow_left -> Buffer.Action.left |> on_focused_buffer *) -(* | Arrow_right -> Buffer.Action.right |> on_focused_buffer *) -(* | Arrow_up -> Buffer.Action.up |> on_focused_buffer *) -(* | Backspace -> Buffer.Action.delete_before |> on_focused_buffer *) -(* | Ctrl 'Q' -> quit 0 *) -(* | Delete -> Buffer.Action.delete_after |> on_focused_buffer *) -(* | Enter -> Buffer.Action.newline |> on_focused_buffer *) -(* | Esc -> (Buffer.Action.left |> on_focused_buffer) *> set_mode Normal *) -(* | Key k -> Buffer.Action.insert k |> on_focused_buffer *) -(* | _ -> noop *) - -(* let handle_normal_key = *) -(* let open Action in *) -(* let open Key in *) -(* function *) -(* | Arrow_down | Key 'j' -> Buffer.Action.down |> on_focused_buffer *) -(* | Arrow_left | Backspace | Key 'h' -> Buffer.Action.left |> on_focused_buffer *) -(* | Arrow_right | Key ' ' | Key 'l' -> Buffer.Action.right |> on_focused_buffer *) -(* | Arrow_up | Key 'k' -> Buffer.Action.up |> on_focused_buffer *) -(* | Ctrl 'Q' -> quit 0 *) -(* | Key '0' -> Buffer.Action.bol |> on_focused_buffer_or_new *) -(* | Key 'A' -> *) -(* (Buffer.Action.eol |> on_focused_buffer_or_new) *> set_mode Insert *) -(* | Key 'a' -> *) -(* (Buffer.Action.right |> on_focused_buffer_or_new) *> set_mode Insert *) -(* | Key 'G' -> Buffer.Action.eof |> on_focused_buffer_or_new *) -(* | Key 'I' -> *) -(* noop *) -(* (1* (Buffer.Action.bol |> on_focused_buffer_or_new) *> set_mode Insert *1) *) -(* | Key 'i' -> (Fn.id |> on_focused_buffer_or_new) *> set_mode Insert *) -(* | Key 's' -> *) -(* (Buffer.Action.delete_after |> on_focused_buffer_or_new) *) -(* *> set_mode Insert *) -(* | Key 'x' -> Buffer.Action.delete_after |> on_focused_buffer_or_new *) -(* | Key 'X' -> Buffer.Action.delete_before |> on_focused_buffer_or_new *) -(* | Key '$' -> Buffer.Action.eol |> on_focused_buffer_or_new *) -(* | _ -> noop *) - -(* let handle_next_command = *) -(* let f m = function *) -(* | None -> Action.return () *) -(* | Some k -> ( *) -(* match m with *) -(* | Insert -> handle_insert_key k *) -(* | Normal -> handle_normal_key k) *) -(* in *) -(* Action.(map2 ~f get_mode get_next_command |> join) *) - let handle_insert_command = let open Command in let open Action in @@ -434,6 +394,28 @@ let handle_normal_command c = Buffer.Action.( delete_to_eol &> move_down &> delete_lines ~n &> move_up &> eol) |> on_focused_buffer_or_new + (* Paste *) + | Shortcut (r, n, Paste_after) -> + let r = Option.value ~default:'"' r in + let paste = function + | Empty -> noop + | Glyphwise z -> Buffer.Action.paste ?n z |> on_focused_buffer_or_new + | Linewise z -> + Buffer.Action.paste ~linewise:true ?n z + |> on_focused_buffer_or_new + in + get_register r >>= paste + | Shortcut (r, n, Paste_before) -> + let r = Option.value ~default:'"' r in + let paste = function + | Empty -> noop + | Glyphwise z -> + Buffer.Action.paste ~before:true ?n z |> on_focused_buffer_or_new + | Linewise z -> + Buffer.Action.paste ~before:true ~linewise:true ?n z + |> on_focused_buffer_or_new + in + get_register r >>= paste (* Join *) | Shortcut (_, n, Join) -> let n = Option.(value ~default:1 n) in diff --git a/lib/editorBuffer.ml b/lib/editorBuffer.ml index c492b8b..295e6e7 100644 --- a/lib/editorBuffer.ml +++ b/lib/editorBuffer.ml @@ -61,12 +61,22 @@ module Action = struct (* let on_content_stored ?(register = '"') ?(append = false) f b = ... *) - let update_render_at_cursor b = + let update_render ?(before = false) ~n b = match b.content with | Error _ -> b | Ok c -> - let l = apply_focus_or ~default:Sequence.empty (to_seq &> render) c in - { b with rendered = swap_focus l b.rendered } + let step = if before then left else right 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 + aux (i - 1) r' c' + in + { b with rendered = aux n b.rendered c |> goto (left_length c) } + + let update_render_at_cursor = update_render ~n:1 let move_up ?(n = 1) = let change_content = @@ -218,6 +228,45 @@ module Action = struct in change_content &> change_rendered &> update_render_at_cursor + let paste ?(before = false) ?(linewise = false) ?(n = 1) s = + let change_content = + if linewise then + let push = if before then push_before_seq else push_after_seq in + push (Sequence.map ~f:of_seq s) |> on_content + else + let aux z = + match Sequence.next s with + | None -> z + | Some (h, t) -> + let init = + let default = Zipper.(of_seq h |> far_right) in + map_focus_or ~default (push_before_seq h) z + and f z l = + let default = (Zipper.empty, Zipper.empty) in + let z1, z2 = apply_focus_or ~default split z in + z |> push_before z1 |> swap_focus z2 + |> map_focus (push_before_seq l) + in + let folded = Sequence.fold ~init ~f t in + if before then folded + else + folded + |> Fn.apply_n_times ~n:(Sequence.length t) left + |> map_focus (Fn.apply_n_times ~n:(Sequence.length h) left) + in + on_content aux + and change_rendered = + if linewise then + let push = if before then push_before_seq else push_after_seq in + push (Sequence.map ~f:render s) |> on_rendered + else + let len = Sequence.length s in + let push = if before then push_before else push in + let aux z = Fn.apply_n_times ~n:(len - 1) (push Sequence.empty) z in + on_rendered aux &> update_render ~before ~n:len + in + Fn.apply_n_times ~n (change_content &> change_rendered) + (* let save_history_to ?(clear = true) r = () *) end diff --git a/lib/zipper.ml b/lib/zipper.ml index 202f6d4..413f365 100644 --- a/lib/zipper.ml +++ b/lib/zipper.ml @@ -61,11 +61,21 @@ let pop_after ?(n = 1) z = if right_length z < 2 then z else right z |> pop ~n |> left let push x z = { z with after = Sequence.shift_right z.after x } +let push_seq s z = { z with after = Sequence.append s z.after } let push_after x z = right z |> push x |> left +let push_after_seq s z = right z |> push_seq s |> left let push_before x z = { z with pos = z.pos + 1; before = Sequence.shift_right z.before x } +let push_before_seq s z = + let f a e = Sequence.shift_right a e in + { + z with + pos = z.pos + Sequence.length s; + before = Sequence.fold ~init:z.before ~f s; + } + let split z = ( { z with after = Sequence.empty }, { z with pos = 0; before = Sequence.empty } ) @@ -119,7 +129,7 @@ let filter p z = z |> filter_left p |> filter_right p let context_left n z = { z with before = Sequence.take z.before n } let context_right n z = { z with after = Sequence.take z.after n } let context ~l ?(r = l) z = z |> context_left l |> context_right r -let swap_focus a = map_focus (Fn.const a) +let swap_focus a = map_focus_or ~default:a (Fn.const a) let of_seq s = { empty with after = s } let to_seq z = z |> far_left |> after let window ~from ~len z = goto from z |> context_right len |> after diff --git a/lib/zipper.mli b/lib/zipper.mli index d79604e..0bbdf27 100644 --- a/lib/zipper.mli +++ b/lib/zipper.mli @@ -136,17 +136,29 @@ val push : 'a -> 'a zipper -> 'a zipper Calling [push 0 z], if [z] is [([3; 2; 1], [4; 5])], the result is [([3; 2; 1], [0; 4; 5]))], *) +val push_seq : 'a Sequence.t -> 'a zipper -> 'a zipper +(** Like {!Zipper.push}, but inserts a sequence of elements at the cursor + position. *) + val push_after : 'a -> 'a zipper -> 'a zipper (** Insert an element after the cursor. Behaves like {!Zipper.push} if the cursor is at the far right of the zipper. Calling [push_after 0 z], if [z] is [([3; 2; 1], [4; 5])], the result is [([3; 2; 1], [4; 0; 5]))], *) +val push_after_seq : 'a Sequence.t -> 'a zipper -> 'a zipper +(** Like {!Zipper.push_after}, but inserts a sequence of elements after + the cursor. *) + val push_before : 'a -> 'a zipper -> 'a zipper (** Insert an element before the cursor. Return the modified zipper. Calling [push_before 0 z], if [z] is [([3; 2; 1], [4; 5])], the result is [([0; 3; 2; 1], [4; 5]))]. *) +val push_before_seq : 'a Sequence.t -> 'a zipper -> 'a zipper +(** Like {!Zipper.push_before}, but inserts a sequence of elements + before the cursor. *) + val split : 'a zipper -> 'a zipper * 'a zipper (** [split z] splits the zipper in two. [([3; 2; 1], [4; 5])] becomes [([3; 2; 1], []), ([], [4; 5])]. *) -- cgit v1.2.3