From 7d009e0ca4a1af10cc6d31fb5982e38dcab9ee71 Mon Sep 17 00:00:00 2001
From: Federico Igne <undyamon@disroot.org>
Date: Mon, 22 Jan 2024 23:46:37 +0100
Subject: feat: add support for rendering text (i.e. tabs)

This allows to have differences between the "raw" content of the buffer
and its visualization on screen. At the time of writing this handles the
rendering of tabs (i.e. '\t') as a fixed amount of spaces, but will be
useful for syntax highlighting as well.
---
 lib/editor.ml       |  16 +++-
 lib/editorBuffer.ml | 257 +++++++++++++++++++++++++++++++++++++++-------------
 lib/key.ml          |   2 +
 3 files changed, 211 insertions(+), 64 deletions(-)

diff --git a/lib/editor.ml b/lib/editor.ml
index f91e66d..69dc666 100644
--- a/lib/editor.ml
+++ b/lib/editor.ml
@@ -11,6 +11,7 @@ type editor = {
   offset : int * int;
   cursor : cursor;
   buffer : Buffer.t option;
+  rendered : bool;
   pending : Key.t Sequence.t;
   i_pending : Command.t Sequence.t;
   n_pending : Command.t Sequence.t;
@@ -25,6 +26,7 @@ let init (c : Config.t) : editor =
     offset = (0, 0);
     cursor = (1, 1);
     buffer = List.hd c.files |> Option.map ~f:Buffer.from_file;
+    rendered = true;
     pending = Key.stream;
     i_pending = Command.i_stream;
     n_pending = Command.n_stream;
@@ -104,10 +106,13 @@ module Action = struct
     let aux e =
       let x, y = e.offset
       and ((r, c) as size) = e.term.size
-      and fill = Sequence.singleton '~' in
+      and fill = Sequence.singleton '~'
+      and limit =
+        Buffer.(if e.rendered then rendered_view else unrendered_view)
+      in
       let view =
         Option.(
-          e.buffer >>| Buffer.view x y r c
+          e.buffer >>| limit x y r c
           |> value ~default:(welcome size)
           |> Text.extend ~fill r)
       in
@@ -117,6 +122,11 @@ module Action = struct
 
   (* TODO: save logic *)
   let quit n = Stdlib.exit n
+
+  (* Debug *)
+  let get_rendered e = (e.rendered, e)
+  let set_rendered r e = ((), { e with rendered = r })
+  let toggle_rendered = get_rendered >>| not >>= set_rendered
   let noop = return ()
 end
 
@@ -352,6 +362,8 @@ let handle_normal_command =
   (* | Key 's' -> *)
   (*     (Buffer.Action.delete_after |> on_focused_buffer_or_new) *)
   (* *> set_mode Insert *)
+  (* Debug *)
+  | Simple (Ctrl 'R') -> toggle_rendered
   | _ -> noop
 
 let handle_next_command m e =
diff --git a/lib/editorBuffer.ml b/lib/editorBuffer.ml
index ea89fb9..e1706dd 100644
--- a/lib/editorBuffer.ml
+++ b/lib/editorBuffer.ml
@@ -5,104 +5,237 @@ open Util
 
 type kind = File of string | No_name | Scratch
 type error = No_such_file | Other
-type buffer = { kind : kind; content : (char zipper zipper, error) Result.t }
+
+type buffer = {
+  kind : kind;
+  content : (char zipper zipper, error) Result.t;
+  rendered : char Sequence.t zipper;
+}
+
 type t = buffer
 
 let empty =
-  { kind = No_name; content = empty |> push_after empty |> Result.return }
+  {
+    kind = No_name;
+    content = empty |> push empty |> Result.return;
+    rendered = push Sequence.empty empty;
+  }
+
+let render =
+  let open Sequence in
+  let tabsize = 8 in
+  let f i = function
+    | '\t' ->
+        let width = tabsize - (i % tabsize) in
+        (i + width, take (repeat '.') width)
+    | c -> (i + 1, singleton c)
+  in
+  folding_map ~init:0 ~f &> join
+
+let cursor ?(rendered = true) b =
+  match b.content with
+  | Error _ -> (0, 0)
+  | Ok c ->
+      let hlen z =
+        if rendered then
+          Sequence.(length (before z |> to_list_rev |> of_list |> render))
+        else left_length z
+      in
+      (left_length c, apply_focus_or ~default:0 hlen c)
 
 module Action = struct
   let on_content f b = { b with content = Result.map ~f b.content }
+  let on_rendered f b = { b with rendered = f b.rendered }
+
+  (* let on_content_stored ?(register = '"') ?(append = false) f b = ... *)
 
-  let move_up, move_down, move_left, move_right =
-    let vertical f ?(n = 1) =
+  let update_render_at_cursor 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 move_up ?(n = 1) =
+    let change_content =
+      on_content (fun z ->
+          let col = apply_focus_or ~default:0 left_length z in
+          Fn.apply_n_times ~n left z |> map_focus (goto col))
+    and change_rendered = on_rendered (Fn.apply_n_times ~n left) in
+    change_content &> change_rendered
+
+  let move_down ?(n = 1) =
+    let change_content =
       on_content (fun z ->
-          let col = focus_or ~default:Zipper.empty z |> left_length in
-          Fn.apply_n_times ~n f z |> map_focus (goto col))
-    and horizontal f ?(n = 1) =
-      Fn.apply_n_times ~n (map_focus f) |> on_content
+          let col = apply_focus_or ~default:0 left_length z in
+          Fn.apply_n_times ~n right z |> map_focus (goto col))
+    and change_rendered = on_rendered (Fn.apply_n_times ~n right) in
+    change_content &> change_rendered
+
+  let move_left, move_right =
+    let horizontal f ?(n = 1) =
+      let change_content = map_focus (Fn.apply_n_times ~n f) |> on_content in
+      change_content &> update_render_at_cursor
     in
-    (vertical left, vertical right, horizontal left, horizontal right)
+    (horizontal left, horizontal right)
 
   let bol = map_focus far_left |> on_content
   let eol = map_focus far_right |> on_content
-  let bof = far_left |> on_content
-  let eof = far_right |> on_content
-  let insert k = map_focus (push k) |> on_content
+
+  let bof =
+    let change_content = far_left |> on_content
+    and change_rendered = far_left |> on_rendered in
+    change_content &> change_rendered
+
+  let eof =
+    let change_content = far_right |> on_content
+    and change_rendered = far_right |> on_rendered in
+    change_content &> change_rendered
+
+  let insert k =
+    let change_content = map_focus (push_before k) |> on_content in
+    change_content &> update_render_at_cursor
+
   (* let replace k = () *)
 
-  let delete_after ?(cross_lines = false) ~n =
-    let aux z =
-      let line = focus_or ~default:Zipper.empty z in
-      if cross_lines && is_far_right line && not (is_far_right z) then
-        pop_after z |> map_focus_or ~default:line (far_left &> join line)
-      else map_focus pop_after z
+  let join_lines ?(n = 2) =
+    let change_content =
+      let join_2_lines z =
+        if right_length z < 2 then z
+        else
+          let to_join = right z |> focus_or ~default:Zipper.empty in
+          map_focus (join ~z2:to_join) z |> pop_after
+      in
+      Fn.apply_n_times ~n:(n - 1) join_2_lines |> on_content
+    and change_rendered = pop_after ~n:(n - 1) |> on_rendered in
+    change_content &> change_rendered &> update_render_at_cursor
+
+  let delete_after ?(cross_lines = false) ~n b =
+    let lines_to_delete =
+      match b.content with
+      | Error _ -> 0
+      | Ok z -> (
+          match Sequence.next (after z) with
+          | None -> 0
+          | Some (h, t) ->
+              let init = right_length h
+              and f acc z =
+                let acc' = acc + length z + 1 in
+                (acc', acc')
+              in
+              Sequence.shift_right (Sequence.folding_map t ~init ~f) init
+              |> Sequence.findi ~f:(fun _ a -> n <= a)
+              |> Option.map ~f:fst
+              |> Option.value ~default:(Sequence.length t))
     in
-    Fn.apply_n_times ~n aux |> on_content
-
-  let delete_before ?(cross_lines = false) ~n =
-    let aux z =
-      let line = focus_or ~default:Zipper.empty z in
-      if cross_lines && is_far_left line && not (is_far_left z) then
-        pop_after z |> left |> map_focus (far_right &> Fn.flip join line)
-      else map_focus pop z
+    let change_content =
+      let delete_1_after z =
+        let line = focus_or ~default:Zipper.empty z in
+        if cross_lines && is_far_right line && not (is_far_right z) then
+          let to_join = right z |> focus_or ~default:Zipper.empty in
+          map_focus (join ~z2:to_join) z |> pop_after
+        else map_focus pop z
+      in
+      Fn.apply_n_times ~n delete_1_after |> on_content
+    and change_rendered =
+      if cross_lines then pop_after ~n:lines_to_delete |> on_rendered else Fn.id
     in
-    Fn.apply_n_times ~n aux |> on_content
+    b |> change_content |> change_rendered |> update_render_at_cursor
+
+  let delete_before ?(cross_lines = false) ~n b =
+    let lines_to_delete =
+      match b.content with
+      | Error _ -> 0
+      | Ok z ->
+          let init = apply_focus_or ~default:0 left_length z
+          and f acc z =
+            let acc' = acc + length z + 1 in
+            (acc', acc')
+          in
+          Sequence.shift_right (Sequence.folding_map (before z) ~init ~f) init
+          |> Sequence.findi ~f:(fun _ a -> n <= a)
+          |> Option.map ~f:fst
+          |> Option.value ~default:(left_length z)
+    in
+    let change_content =
+      let delete_1_before z =
+        let line = focus_or ~default:Zipper.empty z in
+        if cross_lines && is_far_left line && not (is_far_left z) then
+          left z |> map_focus (join ~z2:line) |> pop_after
+        else map_focus pop_before z
+      in
+      Fn.apply_n_times ~n delete_1_before |> on_content
+    and change_rendered =
+      if cross_lines then pop_before ~n:lines_to_delete |> on_rendered
+      else Fn.id
+    in
+    b |> change_content |> change_rendered |> update_render_at_cursor
+
+  let delete_to_eol =
+    map_focus (split &> fst) |> on_content &> update_render_at_cursor
 
-  let delete_to_eol = map_focus (split &> fst) |> on_content
-  let delete_to_bol = map_focus (split &> snd) |> on_content
-  let delete_lines ~n = Fn.apply_n_times ~n pop_after |> on_content
-  let delete_lines_before ~n = Fn.apply_n_times ~n pop_before |> on_content
+  let delete_to_bol =
+    map_focus (split &> snd) |> on_content &> update_render_at_cursor
+
+  let delete_lines ~n =
+    let change_content = pop ~n |> on_content
+    and change_rendered = pop ~n |> on_rendered in
+    change_content &> change_rendered
+
+  let delete_lines_before ~n =
+    let change_content = pop_before ~n |> on_content
+    and change_rendered = pop_before ~n |> on_rendered in
+    change_content &> change_rendered
 
   let newline =
-    let aux z =
-      let l1, l2 = focus_or ~default:Zipper.empty z |> split in
-      push_before l1 z |> map_focus (Fn.const l2)
-    in
-    on_content aux
-
-  let join_lines ~n =
-    let aux z =
-      if is_far_right z || is_far_right (right z) then z
-      else
-        let line = focus_or ~default:Zipper.empty z |> far_right in
-        pop_after z |> map_focus (far_left &> join line)
+    let change_content =
+      let aux z =
+        let default = (Zipper.empty, Zipper.empty) in
+        let l1, l2 = apply_focus_or ~default split z in
+        push_before l1 z |> swap_focus l2
+      in
+      on_content aux
+    and change_rendered b =
+      match b.content with
+      | Error _ -> b
+      | Ok c -> (
+          match Sequence.next (before c) with
+          | None -> failwith "newline > change_rendered: unreachable"
+          | Some (h, _) ->
+              { b with rendered = push_before (to_seq h |> render) b.rendered })
     in
-    Fn.apply_n_times ~n aux |> on_content
+    change_content &> change_rendered &> update_render_at_cursor
 
   (* let save_history_to ?(clear = true) r = () *)
 end
 
 let from_file f =
   let lines =
+    let line_to_seq l = String.to_list l |> Sequence.of_list in
     try
       let fd = Unix.(openfile f [ O_RDONLY ] 0o640) in
       let ic = Unix.in_channel_of_descr fd in
       let lines = In_channel.input_lines ic in
       In_channel.close ic;
-      lines
-    with Unix.Unix_error (ENOENT, _, _) -> []
+      Sequence.(of_list lines |> map ~f:line_to_seq)
+    with Unix.Unix_error (ENOENT, _, _) -> Sequence.empty
   in
-  let content =
-    let line_to_zipper l = String.to_list l |> Sequence.of_list |> of_seq in
-    Sequence.(of_list lines |> map ~f:line_to_zipper) |> of_seq
-  in
-  { kind = File f; content = Ok content }
-
-let cursor b =
-  let open Option in
-  let x = Result.(map ~f:left_length b.content |> ok |> value ~default:0)
-  and y =
-    Result.(map ~f:focus b.content |> ok)
-    |> join |> map ~f:left_length |> value ~default:0
-  in
-  (x, y)
+  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 view x y h w b =
+let unrendered_view x y h w b =
   match b.content with
   | Error _ -> Sequence.empty
   | Ok z ->
       let cx, _ = cursor b in
-      context ~b:(cx - x) ~a:(x + h - cx) z
+      context ~l:(cx - x) ~r:(x + h - cx) z
       |> to_seq
       |> Sequence.map ~f:(window ~from:y ~len:w)
+
+let rendered_view x y h w b =
+  let window from len seq = Sequence.(take (drop_eagerly seq from) len) in
+  let cx, _ = cursor b in
+  context ~l:(cx - x) ~r:(x + h - cx) b.rendered
+  |> to_seq
+  |> Sequence.map ~f:(window y w)
diff --git a/lib/key.ml b/lib/key.ml
index 85aa282..d6656c5 100644
--- a/lib/key.ml
+++ b/lib/key.ml
@@ -16,6 +16,7 @@ type key =
   | Nul
   | Page_down
   | Page_up
+  | Tab
 
 type t = key
 
@@ -24,6 +25,7 @@ let key c = Key c
 
 let of_char = function
   | '\000' -> Nul
+  | '\009' -> Tab
   | '\013' -> Enter
   | '\027' -> Esc
   | '\127' -> Backspace
-- 
cgit v1.2.3