From: Michael D. Lowis Date: Mon, 23 Oct 2017 16:21:45 +0000 (-0400) Subject: added some basic functions for navigating a rope X-Git-Url: https://git.mdlowis.com/?a=commitdiff_plain;h=136c13e0c0948f0491fb50310dfe38ebee26d0bf;p=archive%2Ftide-ocaml.git added some basic functions for navigating a rope --- diff --git a/lib/rope.ml b/lib/rope.ml index 8acfbed..333da3e 100644 --- a/lib/rope.ml +++ b/lib/rope.ml @@ -50,7 +50,7 @@ let rec split rope i = let rec getc rope i = check_index rope i; match rope with - | Leaf (s,off,_) -> s.[off + i] + | Leaf (s,off,_) -> (Char.code s.[off + i]) | Node (l,r,len) -> let left_len = (length l) in if i < left_len then @@ -58,6 +58,38 @@ let rec getc rope 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 @@ -69,7 +101,7 @@ let del rope i j = (join l_left r_right) let rec iter_from fn rope pos = - if pos < (length rope) && (fn (Char.code (getc rope pos))) then + if pos < (length rope) && (fn (getc rope pos)) then iter_from fn rope (pos + 1) let rec iteri_from fn rope pos = @@ -96,7 +128,7 @@ let gets rope i j = let buf = Bytes.create (j - i) in iteri_from (fun n c -> - Bytes.set buf (n - i) (getc rope i); + Bytes.set buf (n - i) (Char.chr (getc rope i)); (n <= j)) rope i; Bytes.unsafe_to_string buf @@ -161,23 +193,23 @@ let run_unit_tests () = ); test "getc : return index 0 of leaf" (fun () -> let rope = Leaf("abc", 0, 3) in - assert( (getc rope (0)) == 'a' ); + 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)) == 'b' ); + 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)) == 'c' ); + 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)) == 'a' ); + 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)) == 'b' ); + assert( (getc rope (1)) == Char.code 'b' ); ); (* puts() tests *) @@ -185,24 +217,78 @@ let run_unit_tests () = let rope = Leaf("bc", 0, 2) in let rope = (puts rope "a" 0) in assert( (length rope) == 3 ); - assert( (getc rope (0)) == 'a' ); - assert( (getc rope (1)) == 'b' ); - assert( (getc rope (2)) == 'c' ); + 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)) == 'a' ); - assert( (getc rope (1)) == 'b' ); - assert( (getc rope (2)) == 'c' ); + 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)) == 'a' ); - assert( (getc rope (1)) == 'b' ); - assert( (getc rope (2)) == 'c' ); + 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); + +*)