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)) ()
