From: Michael D. Lowis <mike@mdlowis.com>
Date: Tue, 24 Oct 2017 02:34:04 +0000 (-0400)
Subject: implemented tab handling
X-Git-Url: https://git.mdlowis.com/?a=commitdiff_plain;h=8a57f636ac808f9b5273b51260c227aa4b9c5e09;p=archive%2Ftide-ocaml.git

implemented tab handling
---

diff --git a/edit.ml b/edit.ml
index 49f71af..6b52ece 100644
--- a/edit.ml
+++ b/edit.ml
@@ -5,6 +5,9 @@ let font_monaco = font_load "Monaco:size=10::antialias=true:autohint=true"
 let font_verdana = font_load "Verdana:size=11:antialias=true:autohint=true"
 
 let font = font_verdana
+let tabglyph = 0x30
+let tabwidth = 4
+
 let tags_buf = ref Buf.empty
 let edit_buf = ref Buf.empty
 
@@ -58,6 +61,10 @@ let draw_buffer pos width height =
     (match c with
     | 0x0A -> newline ()
     | 0x0D -> ()
+    | 0x09 ->
+        let tabsz = ((X11.get_glyph font tabglyph).xoff * tabwidth) in
+        let ntabs = (width - pos.x) / tabsz in
+        x := pos.x + (((!x - pos.x) + tabsz) / tabsz * tabsz)
     | _    -> begin
         if (!x + glyph.xoff) > width then (newline ());
         let off = X11.draw_glyph Cfg.Color.palette.(5) glyph (!x, !y) in
@@ -70,7 +77,9 @@ let draw_buffer pos width height =
 
 let draw_edit pos width height =
   draw_dark_bkg (width - pos.x) (height - pos.y) pos;
-  draw_buffer { x = pos.x + 4; y = pos.y + 2} width height
+  let pos = { x = pos.x + 2; y = pos.y + 2 } in
+  Buf.redraw !edit_buf pos.x pos.y width height;
+  draw_buffer pos width height
 
 (* Event functions
  ******************************************************************************)
diff --git a/lib/buf.ml b/lib/buf.ml
index a6be456..c45d238 100644
--- a/lib/buf.ml
+++ b/lib/buf.ml
@@ -1,15 +1,8 @@
-type cursor = {
-  start : int;
-  stop : int
-}
+type cursor = { start : int; stop : int }
 
-type buf = {
-  path : string;
-  rope : Rope.t
-}
+type buf = { path : string; rope : Rope.t }
 
-let iter_from fn buf i =
-  Rope.iter_from fn buf.rope i
+let font = X11.font_load "Verdana:size=11:antialias=true:autohint=true"
 
 let empty =
   { path = ""; rope = Rope.empty }
@@ -17,6 +10,20 @@ let empty =
 let load path =
   { path = path; rope = Rope.from_string (Misc.load_file path) }
 
+let redraw buf x y width height =
+  (*let width = (width - x) in*)
+  let nlines = ((height - y) / font.height) in
+  ()
+
+let iter_from fn buf i =
+  Rope.iter_from fn buf.rope i
+
+
+
+
+
+(*
+
 let make_cursor buf start stop =
   { start = (Rope.limit_index buf.rope start);
     stop = (Rope.limit_index buf.rope stop) }
@@ -31,7 +38,7 @@ let move_word count csr buf ext =
 
 let move_line count csr buf ext =
   ()
-
+*)
 (* Unit Tests *****************************************************************)
 
 let run_unit_tests () =
diff --git a/lib/rope.ml b/lib/rope.ml
index 333da3e..e7facc4 100644
--- a/lib/rope.ml
+++ b/lib/rope.ml
@@ -273,6 +273,13 @@ let run_unit_tests () =
     let rope = Leaf("abcd\n", 0, 5) in
     assert( (is_eol rope 2) == false );
   );
+
+  (* to_bol() tests *)
+  test "to_bol : should return index of first char on the line" (fun () ->
+    let rope = Leaf("\nabc\n", 0, 5) in
+    assert( (to_bol rope 2) == 1 );
+  );
+
   ()
 
 (*
diff --git a/lib/rope.sync-conflict-20171023-192447-NVTQWLE.ml b/lib/rope.sync-conflict-20171023-192447-NVTQWLE.ml
new file mode 100644
index 0000000..333da3e
--- /dev/null
+++ b/lib/rope.sync-conflict-20171023-192447-NVTQWLE.ml
@@ -0,0 +1,294 @@
+exception Out_of_bounds of string
+
+type rope =
+  | Leaf of string * int * int
+  | Node of rope * rope * int
+
+type t = rope
+
+let empty = Leaf ("", 0, 0)
+
+let length = function
+  | Leaf (_,_,l) -> l
+  | Node (_,_,l) -> l
+
+let from_string s =
+  Leaf (s, 0, (String.length s))
+
+let check_index rope i =
+  if i < 0 || i >= (length rope) then
+    raise (Out_of_bounds "Rope.check_index")
+
+let limit_index rope i =
+  if i < 0 then 0
+  else if i > 0 && i >= (length rope) then
+    ((length rope) - 1)
+  else i
+
+let join left right =
+  let left_len = (length left) in
+  let right_len = (length right) in
+  if left_len == 0 then right
+  else if right_len == 0 then left
+  else Node (left, right, (length left) + (length right))
+
+let rec split rope i =
+  if i < 0 || i > (length rope) then
+    raise (Out_of_bounds "Rope.split");
+  match rope with
+  | Leaf (s,off,len) ->
+      (Leaf (s, off,  i), Leaf (s, (off + i), len - (i)))
+  | Node (l,r,len) ->
+      let left_len = (length l) in
+      if i < left_len then
+        let (sl,sr) = (split l i) in
+        (sl, (join sr r))
+      else
+        let (sl,sr) = (split r i) in
+        ((join l sl), sr)
+
+let rec getc rope i =
+  check_index rope i;
+  match rope with
+  | Leaf (s,off,_) -> (Char.code s.[off + i])
+  | Node (l,r,len) ->
+      let left_len = (length l) in
+      if i < left_len then
+        getc l i
+      else
+        getc r (i - left_len)
+
+let last rope =
+  limit_index rope ((length rope) - 1)
+
+let is_bol rope pos =
+  if pos == 0 then true
+  else ((getc rope (pos-1)) == 0x0A)
+
+let is_eol rope pos =
+  if pos >= (last rope) then true
+  else let c = (getc rope (pos+1)) in
+    (c == 0x0A || c == 0x0D)
+
+let is_bow rope pos = false
+
+let is_eow rope pos = false
+
+let rec move_till step testfn rope pos =
+  if (testfn rope pos) then pos
+  else (move_till step testfn rope (pos + step))
+
+let to_bol rope pos =
+  move_till (-1) is_bol rope pos
+
+let to_eol rope pos =
+  move_till (+1) is_eol rope pos
+
+let to_bow rope pos =
+  move_till (-1) is_bow rope pos
+
+let to_eow rope pos =
+  move_till (+1) is_eow rope pos
+
+let rec puts rope s i =
+  let (left,right) = split rope i in
+  let middle = from_string s in
+  (join (join left middle) right)
+
+let del rope i j =
+  let (l_left,l_right) = split rope i in
+  let (r_left,r_right) = split l_right (j - i) in
+  (join l_left r_right)
+
+let rec iter_from fn rope pos =
+  if pos < (length rope) && (fn (getc rope pos)) then
+    iter_from fn rope (pos + 1)
+
+let rec iteri_from fn rope pos =
+  if pos < (length rope) && (fn pos (getc rope pos)) then
+    iteri_from fn rope (pos + 1)
+
+let iteri fn rope =
+  iteri_from (fun i c -> (fn i c); true) rope 0
+
+let iter fn rope =
+  iter_from (fun c -> (fn c); true) rope 0
+
+let map fn rope =
+  let buf = Bytes.create (length rope) in
+  iteri (fun i c -> Bytes.set buf i (fn c)) rope;
+  from_string (Bytes.unsafe_to_string buf)
+
+let mapi fn rope =
+  let buf = Bytes.create (length rope) in
+  iteri (fun i c -> Bytes.set buf i (fn i c)) rope;
+  from_string (Bytes.unsafe_to_string buf)
+
+let gets rope i j =
+  let buf = Bytes.create (j - i) in
+  iteri_from
+    (fun n c ->
+      Bytes.set buf (n - i) (Char.chr (getc rope i));
+      (n <= j))
+    rope i;
+  Bytes.unsafe_to_string buf
+
+let to_string rope =
+  gets rope 0 (length rope)
+
+(* Unit Tests *****************************************************************)
+
+let run_unit_tests () =
+  let open Test in
+  (* length() tests *)
+  test "length : 0 for empty string" (fun () ->
+    let rope = Leaf("", 0, 0) in
+    assert( length rope == 0 )
+  );
+  test "length : equal to length of leaf" (fun () ->
+    let rope = Leaf("a", 0, 1) in
+    assert( length rope == 1 )
+  );
+  test "length : equal to sum of leaf lengths" (fun () ->
+    let rope = (join (Leaf("a", 0, 1)) (Leaf("a", 0, 1))) in
+    assert( length rope == 2 )
+  );
+
+  (* join() tests *)
+  test "join : join two leaves into rope" (fun () ->
+    let left  = Leaf("a", 0, 1) in
+    let right =  Leaf("a", 0, 1) in
+    let rope  = (join left right) in
+    assert( match rope with
+    | Node (l,r,2) -> (l == left && r == right)
+    | _ -> false)
+  );
+  test "join : join a rope with a leaf (l to r)" (fun () ->
+    let left  = join (Leaf("a", 0, 1)) (Leaf("a", 0, 1)) in
+    let right =  Leaf("a", 0, 1) in
+    let rope  = (join left right) in
+    assert( match rope with
+    | Node (l,r,3) -> (l == left && r == right)
+    | _ -> false)
+  );
+  test "join : join a rope with a leaf (r to l)" (fun () ->
+    let left  =  Leaf("a", 0, 1) in
+    let right = join (Leaf("a", 0, 1)) (Leaf("a", 0, 1)) in
+    let rope  = (join left right) in
+    assert( match rope with
+    | Node (l,r,3) -> (l == left && r == right)
+    | _ -> false)
+  );
+
+  (* getc() tests *)
+  test "getc : raise Out_of_bounds on negative index" (fun () ->
+    let rope = Leaf("a", 0, 1) in
+    try getc rope (-1); assert false
+    with Out_of_bounds _ -> assert true
+  );
+  test "getc : raise Out_of_bounds on out of bounds index" (fun () ->
+    let rope = Leaf("a", 0, 1) in
+    try getc rope (2); assert false
+    with Out_of_bounds _ -> assert true
+  );
+  test "getc : return index 0 of leaf" (fun () ->
+    let rope = Leaf("abc", 0, 3) in
+    assert( (getc rope (0)) == Char.code 'a' );
+  );
+  test "getc : return index 1 of leaf" (fun () ->
+    let rope = Leaf("abc", 0, 3) in
+    assert( (getc rope (1)) == Char.code 'b' );
+  );
+  test "getc : return index 2 of leaf" (fun () ->
+    let rope = Leaf("abc", 0, 3) in
+    assert( (getc rope (2)) == Char.code 'c' );
+  );
+  test "getc : return index 0 of rope" (fun () ->
+    let rope = Node((Leaf("a", 0, 1)), (Leaf("b", 0, 1)), 2) in
+    assert( (getc rope (0)) == Char.code 'a' );
+  );
+  test "getc : return index 1 of rope" (fun () ->
+    let rope = Node((Leaf("a", 0, 1)), (Leaf("b", 0, 1)), 2) in
+    assert( (getc rope (1)) == Char.code 'b' );
+  );
+
+  (* puts() tests *)
+  test "puts : insert at index 0" (fun () ->
+    let rope = Leaf("bc", 0, 2) in
+    let rope = (puts rope "a" 0) in
+    assert( (length rope) == 3 );
+    assert( (getc rope (0)) == Char.code 'a' );
+    assert( (getc rope (1)) == Char.code 'b' );
+    assert( (getc rope (2)) == Char.code 'c' );
+  );
+  test "puts : insert at index 1" (fun () ->
+    let rope = Leaf("ac", 0, 2) in
+    let rope = (puts rope "b" 1) in
+    assert( (length rope) == 3 );
+    assert( (getc rope (0)) == Char.code 'a' );
+    assert( (getc rope (1)) == Char.code 'b' );
+    assert( (getc rope (2)) == Char.code 'c' );
+  );
+  test "puts : insert index at 2" (fun () ->
+    let rope = Leaf("ab", 0, 2) in
+    let rope = (puts rope "c" 2) in
+    assert( (length rope) == 3 );
+    assert( (getc rope (0)) == Char.code 'a' );
+    assert( (getc rope (1)) == Char.code 'b' );
+    assert( (getc rope (2)) == Char.code 'c' );
+  );
+
+  (* is_bol() tests *)
+  test "is_bol : should return true if pos is 0" (fun () ->
+    let rope = Leaf("abc", 0, 3) in
+    assert( is_bol rope 0 );
+  );
+  test "is_bol : should return true if pos is first char of line" (fun () ->
+    let rope = Leaf("\nabc", 0, 3) in
+    assert( is_bol rope 1 );
+  );
+  test "is_bol : should return false if pos is not first char of line" (fun () ->
+    let rope = Leaf("\nabc", 0, 3) in
+    assert( (is_bol rope 2) == false );
+  );
+  test "is_bol : should return false if previous char is not \n" (fun () ->
+    let rope = Leaf("\rabc", 0, 3) in
+    assert( (is_bol rope 1) == false );
+  );
+
+  (* is_eol() tests *)
+  test "is_eol : should return true if pos is Rope.last" (fun () ->
+    let rope = Leaf("abc", 0, 3) in
+    assert( is_eol rope 2 );
+  );
+  test "is_eol : should return true if pos is last char of line with \n ending" (fun () ->
+    let rope = Leaf("abc\n", 0, 4) in
+    assert( is_eol rope 2 );
+  );
+  test "is_eol : should return true if pos is last char of line with \r\n ending" (fun () ->
+    let rope = Leaf("abc\r\n", 0, 5) in
+    assert( is_eol rope 2 );
+  );
+  test "is_eol : should return false if pos is not last char of line" (fun () ->
+    let rope = Leaf("abcd\n", 0, 5) in
+    assert( (is_eol rope 2) == false );
+  );
+  ()
+
+(*
+
+size_t buf_lscan(Buf* buf, size_t pos, Rune r);
+size_t buf_rscan(Buf* buf, size_t pos, Rune r);
+void buf_getword(Buf* buf, bool ( *isword)(Rune), Sel* sel);
+void buf_getblock(Buf* buf, Rune beg, Rune end, Sel* sel);
+size_t buf_byrune(Buf* buf, size_t pos, int count);
+size_t buf_byword(Buf* buf, size_t pos, int count);
+size_t buf_byline(Buf* buf, size_t pos, int count);
+void buf_find(Buf* buf, int dir, size_t* beg, size_t* end);
+void buf_findstr(Buf* buf, int dir, char* str, size_t* beg, size_t* end);
+void buf_lastins(Buf* buf, size_t* beg, size_t* end);
+size_t buf_setln(Buf* buf, size_t line);
+size_t buf_getcol(Buf* buf, size_t pos);
+size_t buf_setcol(Buf* buf, size_t pos, size_t col);
+
+*)