[gsharp-cvs] CVS update: gsharp/Flexichain/flexichain-package.lisp gsharp/Flexichain/flexichain.lisp

[Robert Strandh]

Update of /project/gsharp/cvsroot/gsharp/Flexichain
In directory common-lisp.net:/tmp/cvs-serv7097

Modified Files:
	flexichain-package.lisp flexichain.lisp 
Log Message:
added an "insert-vector*" function.

Date: Tue Dec 28 07:57:00 2004
Author: rstrandh

Index: gsharp/Flexichain/flexichain-package.lisp
diff -u gsharp/Flexichain/flexichain-package.lisp:1.1 gsharp/Flexichain/flexichain-package.lisp:1.2
--- gsharp/Flexichain/flexichain-package.lisp:1.1	Mon Aug 16 10:12:45 2004
+++ gsharp/Flexichain/flexichain-package.lisp	Tue Dec 28 07:57:00 2004
@@ -25,7 +25,7 @@
 	   #:flexi-error #:flexi-initialization-error
 	   #:flexi-position-error #:flexi-incompatible-type-error
 	   #:nb-elements #:flexi-empty-p
-	   #:insert* #:element* #:delete*
+	   #:insert* #:insert-vector* #:element* #:delete*
 	   #:push-start #:pop-start #:push-end #:pop-end #:rotate
            #:cursorchain #:standard-cursorchain 
 	   #:flexicursor #:standard-flexicursor


Index: gsharp/Flexichain/flexichain.lisp
diff -u gsharp/Flexichain/flexichain.lisp:1.5 gsharp/Flexichain/flexichain.lisp:1.6
--- gsharp/Flexichain/flexichain.lisp:1.5	Mon Sep  6 13:23:16 2004
+++ gsharp/Flexichain/flexichain.lisp	Tue Dec 28 07:57:00 2004
@@ -245,6 +245,20 @@
      (when (= gap-start (length buffer))
        (setf gap-start 0))))
   
+(defmethod insert-vector* ((chain standard-flexichain) position vector)
+  (with-slots (element-type buffer gap-start) chain
+     (assert (<= 0 position (nb-elements chain)) ()
+	     'flexi-position-error :chain chain :position position)
+     (assert (typep (array-element-type  vector) element-type) ()
+	     'flexi-incompatible-type-error :element vector :chain chain)
+     (ensure-gap-position chain position)
+     (ensure-room chain (+ (nb-elements chain) (length vector)))
+     (loop for elem across vector
+	   do (setf (aref buffer gap-start) elem)
+	      (incf gap-start)
+	      (when (= gap-start (length buffer))
+		(setf gap-start 0)))))
+  
 (defmethod delete* ((chain standard-flexichain) position)
   (with-slots (buffer expand-factor min-size fill-element gap-end) chain
     (assert (< -1 position (nb-elements chain)) ()