feat: add ability to paste text from a register

Register are simplier than Vim register, in particular no register is
local to buffers.

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])]. *)