fixed gap-buffer and cursortree

diff --git a/extra/gap-buffer/cursortree/cursortree-tests.factor b/extra/gap-buffer/cursortree/cursortree-tests.factor
index 36b5efd7fa0cff23149d2d6d63aa064076818237..2b3ff69c974a690407ada6e61dbaeff638803691 100644 (file)
--- a/extra/gap-buffer/cursortree/cursortree-tests.factor
+++ b/extra/gap-buffer/cursortree/cursortree-tests.factor
@@ -1,4 +1,6 @@
-USING: kernel gap-buffer.cursortree tools.test sequences trees arrays strings ;
+USING: assocs kernel gap-buffer.cursortree tools.test sequences trees
+arrays strings ;
+IN: gap-buffer.cursortree.tests
 
 [ t ] [ "this is a test string" <cursortree> 0 <left-cursor> at-beginning? ] unit-test
 [ t ] [ "this is a test string" <cursortree> dup length  <left-cursor> at-end? ] unit-test
@@ -6,7 +8,8 @@ USING: kernel gap-buffer.cursortree tools.test sequences trees arrays strings ;
 [ CHAR: i ] [ "this is a test string" <cursortree> 3 <left-cursor> element< ] unit-test
 [ CHAR: s ] [ "this is a test string" <cursortree> 3 <left-cursor> element> ] unit-test
 [ t ] [ "this is a test string" <cursortree> 3 <left-cursor> CHAR: a over set-element< CHAR: t over set-element> cursor-tree "that is a test string" sequence= ] unit-test
-[ t ] [ "this is a test string" <cursortree> 3 <left-cursor> 8 over set-cursor-pos dup 1array swap cursor-tree cursortree-cursors tree-values sequence= ] unit-test
+[ 0 ] [ "this is a test string" <cursortree> dup dup 3 <left-cursor> remove-cursor cursors length ] unit-test
+[ t ] [ "this is a test string" <cursortree> 3 <left-cursor> 8 over set-cursor-pos dup 1array swap cursor-tree cursors sequence= ] unit-test
 [ "this is no longer a test string" ] [ "this is a test string" <cursortree> 8 <left-cursor> "no longer " over insert cursor-tree >string ] unit-test
 [ "refactor" ] [ "factor" <cursortree> 0 <left-cursor> CHAR: e over insert CHAR: r over insert cursor-tree >string ] unit-test
 [ "refactor" ] [ "factor" <cursortree> 0 <right-cursor> CHAR: r over insert CHAR: e over insert cursor-tree >string ] unit-test

diff --git a/extra/gap-buffer/cursortree/cursortree.factor b/extra/gap-buffer/cursortree/cursortree.factor
index e056cc8deed6c911ac407a1019e3f92bb9481284..fb2abf1c3df4d397a5d18fb1b9b82a2f130b3e2b 100644 (file)
--- a/extra/gap-buffer/cursortree/cursortree.factor
+++ b/extra/gap-buffer/cursortree/cursortree.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2007 Alex Chapman All Rights Reserved.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs kernel gap-buffer generic trees trees.avl math sequences quotations ;
+USING: assocs assocs.lib kernel gap-buffer generic trees trees.avl math
+sequences quotations ;
 IN: gap-buffer.cursortree
 
 TUPLE: cursortree cursors ;
@@ -18,13 +19,12 @@ TUPLE: cursor i tree ;
 TUPLE: left-cursor ;
 TUPLE: right-cursor ;
 
-: cursor-index ( cursor -- i ) cursor-i ; inline
+: cursor-index ( cursor -- i ) cursor-i ;
 
-: add-cursor ( cursortree cursor -- ) dup cursor-index rot avl-insert ; 
+: add-cursor ( cursortree cursor -- ) dup cursor-index rot insert-at ; 
 
 : remove-cursor ( cursortree cursor -- )
-   cursor-index swap delete-at ; 
-   ! dup [ eq? ] curry swap cursor-index rot cursortree-cursors tree-delete-if ;
+    tuck cursor-index swap cursortree-cursors at* [ delete ] [ 2drop ] if ;
 
 : set-cursor-index ( index cursor -- )
     dup cursor-tree over remove-cursor tuck set-cursor-i
@@ -49,14 +49,17 @@ M: right-cursor set-cursor-pos ( n cursor -- ) [ cursor-tree position>index ] ke
 : <right-cursor> ( cursortree pos -- right-cursor )
     right-cursor construct-empty make-cursor ;
 
+: cursors ( cursortree -- seq )
+    cursortree-cursors values concat ;
+
 : cursor-positions ( cursortree -- seq )
-    cursortree-cursors tree-values [ cursor-pos ] map ;
+    cursors [ cursor-pos ] map ;
 
 M: cursortree move-gap ( n cursortree -- )
     #! Get the position of each cursor before the move, then re-set the
     #! position afterwards. This will update any changed cursor indices.
     dup cursor-positions >r tuck cursortree-gb move-gap
-    cursortree-cursors tree-values r> swap [ set-cursor-pos ] 2each ;
+    cursors r> swap [ set-cursor-pos ] 2each ;
 
 : element@< ( cursor -- pos cursortree ) [ cursor-pos 1- ] keep cursor-tree ;
 : element@> ( cursor -- pos cursortree ) [ cursor-pos ] keep cursor-tree ;
@@ -81,7 +84,7 @@ M: right-cursor fix-cursor ( cursortree cursor -- )
     >r gb-gap-end r> set-cursor-index ;
 
 : fix-cursors ( old-gap-end cursortree -- )
-    tuck cursortree-cursors tree-get-all [ fix-cursor ] curry* each ; 
+    tuck cursortree-cursors at [ fix-cursor ] with each ;
 
 M: cursortree delete* ( pos cursortree -- )
     tuck move-gap dup gb-gap-end swap dup (delete*) fix-cursors ;

diff --git a/extra/gap-buffer/gap-buffer.factor b/extra/gap-buffer/gap-buffer.factor
index 99051ea678405a33b0cb5fb146485c1fec1e7003..3d78204d3fa842be5f32a37013b3a045d3bd47f0 100644 (file)
--- a/extra/gap-buffer/gap-buffer.factor
+++ b/extra/gap-buffer/gap-buffer.factor
@@ -44,15 +44,36 @@ M: gb like ( seq gb -- seq ) drop <gb> ;
 
 M: gb length ( gb -- n ) [ buffer-length ] keep gap-length - ;
 
+: valid-position? ( pos gb -- ? )
+    #! one element past the end of the buffer is a valid position when we're inserting
+    length -1 swap between? ;
+
+: valid-index? ( i gb -- ? )
+    buffer-length -1 swap between? ;
+
+TUPLE: position-out-of-bounds position gap-buffer ;
+C: <position-out-of-bounds> position-out-of-bounds
+
 : position>index ( pos gb -- i )
-    2dup gb-gap-start >= [
-        gap-length +
-    ] [ drop ] if ;
+    2dup valid-position? [
+        2dup gb-gap-start >= [
+            gap-length +
+        ] [ drop ] if
+    ] [
+        <position-out-of-bounds> throw
+    ] if ;
+
+TUPLE: index-out-of-bounds index gap-buffer ;
+C: <index-out-of-bounds> index-out-of-bounds
 
 : index>position ( i gb -- pos )
-    2dup gb-gap-end >= [
-        gap-length -
-    ] [ drop ] if ;
+    2dup valid-index? [
+        2dup gb-gap-end >= [
+            gap-length -
+        ] [ drop ] if
+    ] [
+        <index-out-of-bounds> throw
+    ] if ;
 
 M: gb virtual@ ( n gb -- n seq ) [ position>index ] keep gb-seq ;
     
@@ -159,6 +180,7 @@ INSTANCE: gb virtual-sequence
 : fix-gap ( n gb -- )
     2dup [ gap-length + ] keep set-gb-gap-end set-gb-gap-start ;
 
+! moving the gap to position 5 means that the element in position 5 will be immediately after the gap
 GENERIC: move-gap ( n gb -- )
 
 M: gb move-gap ( n gb -- ) 2dup [ position>index ] keep (move-gap) fix-gap ;