October 2010 - flexichain-cvs@common-lisp.net

[flexichain-cvs] CVS update: flexichain/flexichain-test.asd
by Robert Strandh 05 Oct '10

05 Oct '10

Update of /project/flexichain/cvsroot/flexichain In directory cl-net:/tmp/cvs-serv21318 Modified Files: flexichain-test.asd Log Message: Removed skiplist from the tester system, as it is no longer needed. Date: Tue Oct 5 01:07:19 2010 Author: rstrandh Index: flexichain/flexichain-test.asd diff -u flexichain/flexichain-test.asd:1.2 flexichain/flexichain-test.asd:1.3 --- flexichain/flexichain-test.asd:1.2 Mon Oct 4 02:54:30 2010 +++ flexichain/flexichain-test.asd Tue Oct 5 01:07:19 2010 @@ -27,7 +27,5 @@ :depends-on (flexichain) :components ((:file "tester-package") (:file "stupid" :depends-on ("tester-package")) - (:file "rtester" :depends-on ("tester-package" "stupid")) - (:file "skiplist-package") - (:file "skiplist" :depends-on ("skiplist-package")))) + (:file "rtester" :depends-on ("tester-package" "stupid"))))

1 0

[flexichain-cvs] CVS update: flexichain/flexichain.lisp
by Robert Strandh 05 Oct '10

05 Oct '10

Update of /project/flexichain/cvsroot/flexichain In directory cl-net:/tmp/cvs-serv21178 Modified Files: flexichain.lisp Log Message: Used REPLACE to implement insert-vector*. Thanks to Cyrus Harmon for this improvement. Date: Tue Oct 5 01:05:06 2010 Author: rstrandh Index: flexichain/flexichain.lisp diff -u flexichain/flexichain.lisp:1.9 flexichain/flexichain.lisp:1.10 --- flexichain/flexichain.lisp:1.9 Sun Oct 3 05:29:19 2010 +++ flexichain/flexichain.lisp Tue Oct 5 01:05:06 2010 @@ -247,26 +247,30 @@ (defmethod insert* ((chain standard-flexichain) position object) (with-slots (buffer gap-start) chain - (assert (<= 0 position (nb-elements chain)) () - 'flexi-position-error :chain chain :position position) - (ensure-gap-position chain position) - (ensure-room chain (1+ (nb-elements chain))) - (setf (aref buffer gap-start) object) - (incf gap-start) - (when (= gap-start (length buffer)) - (setf gap-start 0)))) + (assert (<= 0 position (nb-elements chain)) () + 'flexi-position-error :chain chain :position position) + (ensure-gap-position chain position) + (ensure-room chain (1+ (nb-elements chain))) + (setf (aref buffer gap-start) object) + (incf gap-start) + (when (= gap-start (length buffer)) + (setf gap-start 0)))) (defmethod insert-vector* ((chain standard-flexichain) position vector) (with-slots (buffer gap-start) chain - (assert (<= 0 position (nb-elements chain)) () + (assert (<= 0 position (nb-elements chain)) () 'flexi-position-error :chain chain :position position) - (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))))) + (ensure-gap-position chain position) + (ensure-room chain (+ (nb-elements chain) (length vector))) + (if (>= (+ gap-start (length vector)) (length buffer)) + (progn + (replace buffer vector :start1 gap-start :end1 (length buffer)) + (replace buffer vector + :start2 (- (length buffer) gap-start)) + (setf gap-start (- (length vector) (- (length buffer) gap-start)))) + (progn + (replace buffer vector :start1 gap-start :end1 (+ gap-start (length vector))) + (incf gap-start (length vector)))))) (defmethod delete* ((chain standard-flexichain) position) (with-slots (buffer expand-factor min-size fill-element gap-end) chain

1 0

[flexichain-cvs] CVS update: flexichain/flexichain-test.asd flexichain/rtester.lisp flexichain/tester-package.lisp flexichain/tester.lisp
by Robert Strandh 04 Oct '10

04 Oct '10

Update of /project/flexichain/cvsroot/flexichain In directory cl-net:/tmp/cvs-serv28161 Modified Files: flexichain-test.asd rtester.lisp tester-package.lisp Removed Files: tester.lisp Log Message: Removed the CLIM-based tester. Put the random tester code in the tester package. Date: Mon Oct 4 02:54:30 2010 Author: rstrandh Index: flexichain/flexichain-test.asd diff -u flexichain/flexichain-test.asd:1.1 flexichain/flexichain-test.asd:1.2 --- flexichain/flexichain-test.asd:1.1 Sun Mar 9 12:13:57 2008 +++ flexichain/flexichain-test.asd Mon Oct 4 02:54:30 2010 @@ -26,9 +26,8 @@ (read vers)) :depends-on (flexichain) :components ((:file "tester-package") - (:file "tester" :depends-on ("tester-package")) - (:file "rtester" :depends-on ("tester-package")) + (:file "stupid" :depends-on ("tester-package")) + (:file "rtester" :depends-on ("tester-package" "stupid")) (:file "skiplist-package") - (:file "skiplist" :depends-on ("skiplist-package")) - (:file "stupid"))) + (:file "skiplist" :depends-on ("skiplist-package")))) Index: flexichain/rtester.lisp diff -u flexichain/rtester.lisp:1.2 flexichain/rtester.lisp:1.3 --- flexichain/rtester.lisp:1.2 Sun Jan 27 01:05:37 2008 +++ flexichain/rtester.lisp Mon Oct 4 02:54:30 2010 @@ -1,3 +1,5 @@ +(in-package :tester) + (defparameter *instructions* '()) (defparameter *ins-del-state* t) Index: flexichain/tester-package.lisp diff -u flexichain/tester-package.lisp:1.1.1.1 flexichain/tester-package.lisp:1.2 --- flexichain/tester-package.lisp:1.1.1.1 Wed Feb 8 21:51:06 2006 +++ flexichain/tester-package.lisp Mon Oct 4 02:54:30 2010 @@ -1,2 +1,2 @@ (defpackage :tester - (:use :clim :clim-lisp :flexichain)) + (:use :common-lisp :flexichain))

1 0

[flexichain-cvs] CVS update: flexichain/flexichain.lisp flexichain/version.lisp-expr
by Robert Strandh 03 Oct '10

03 Oct '10

Update of /project/flexichain/cvsroot/flexichain In directory cl-net:/tmp/cvs-serv12760 Modified Files: flexichain.lisp version.lisp-expr Log Message: Added copyright 2010 to flexichain.lisp. Bumped the version number to 1.5.2. Date: Sun Oct 3 05:29:19 2010 Author: rstrandh Index: flexichain/flexichain.lisp diff -u flexichain/flexichain.lisp:1.8 flexichain/flexichain.lisp:1.9 --- flexichain/flexichain.lisp:1.8 Sun Oct 3 04:25:28 2010 +++ flexichain/flexichain.lisp Sun Oct 3 05:29:19 2010 @@ -3,6 +3,7 @@ ;;; ;;; Copyright (C) 2003-2004 Robert Strandh (strandh(a)labri.fr) ;;; Copyright (C) 2003-2004 Matthieu Villeneuve (matthieu.villeneuve(a)free.fr) +;;; Copyright (C) 2010 Robert Strandh (strandh(a)labri.fr) ;;; ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public Index: flexichain/version.lisp-expr diff -u flexichain/version.lisp-expr:1.3 flexichain/version.lisp-expr:1.4 --- flexichain/version.lisp-expr:1.3 Mon Mar 10 01:50:28 2008 +++ flexichain/version.lisp-expr Sun Oct 3 05:29:19 2010 @@ -1 +1 @@ -"1.5.1" +"1.5.2"

1 0

[flexichain-cvs] CVS update: flexichain/Doc/flexichain.tex
by Robert Strandh 03 Oct '10

03 Oct '10

Update of /project/flexichain/cvsroot/flexichain/Doc In directory cl-net:/tmp/cvs-serv3749 Modified Files: flexichain.tex Log Message: Fixed a few bugs in the documentation. Thanks to Sumant S. R. Oemrawsingh for finding and reporting those bugs. Date: Sun Oct 3 04:51:12 2010 Author: rstrandh Index: flexichain/Doc/flexichain.tex diff -u flexichain/Doc/flexichain.tex:1.2 flexichain/Doc/flexichain.tex:1.3 --- flexichain/Doc/flexichain.tex:1.2 Fri Jan 25 18:59:23 2008 +++ flexichain/Doc/flexichain.tex Sun Oct 3 04:51:11 2010 @@ -568,17 +568,19 @@ \Defclass {standard-flexicursor} -The standard instantiable subclass of \cl{flexicursor}. +The standard subclass of \cl{flexicursor}. This class is \emph{not} +directly instantiable. Instead use one of the instantiable subclasses +\cl{left-sticky-flexicursor} or \cl{right-sticky-flexicursor}. \Defclass {left-sticky-flexicursor} The standard instantiable class for left-sticky flexicursors. It is a -subclass of standard-flexicursor. +subclass of \cl{standard-flexicursor}. \Defclass {right-sticky-flexicursor} The standard instantiable class for right-sticky flexicursors. It is a -subclass of standard-flexicursor. +subclass of \cl{standard-flexicursor}. \Defgeneric {chain} {cursor} @@ -636,7 +638,7 @@ Insert an object at the position corresponding to that of the cursor. All cursors located at positions greater than the one corresponding to -the cursor given as argument, as well as left-sticky cursors (possibly +the cursor given as argument, as well as right-sticky cursors (possibly including the one given as argument) located at the same position as the one given as argument will have their positions incremented by one. Other cursors are unaffected. @@ -724,4 +726,4 @@ way, a \texttt{flexicursor} editing operation translates directly to a \texttt{flexichain} editing operation with no extra code. -\end{document} \ No newline at end of file +\end{document}

1 0

[flexichain-cvs] CVS update: flexichain/flexichain.lisp
by Robert Strandh 03 Oct '10

03 Oct '10

Update of /project/flexichain/cvsroot/flexichain In directory cl-net:/tmp/cvs-serv29779 Modified Files: flexichain.lisp Log Message: Removed slot indicating the element type that was asked for, because the method used for cheching this against elements to insert is not working in most cases because of array upgrading. Date: Sun Oct 3 04:25:28 2010 Author: rstrandh Index: flexichain/flexichain.lisp diff -u flexichain/flexichain.lisp:1.7 flexichain/flexichain.lisp:1.8 --- flexichain/flexichain.lisp:1.7 Thu Jan 31 12:10:58 2008 +++ flexichain/flexichain.lisp Sun Oct 3 04:25:28 2010 @@ -22,14 +22,13 @@ (in-package :flexichain) (defclass flexichain () - ((element-type :initarg :element-type :initform t) - (fill-element :initarg :fill-element) + ((fill-element :initarg :fill-element) (expand-factor :initarg :expand-factor :initform 1.5) (min-size :initarg :min-size :initform 5)) (:documentation "The protocol class for flexichains.")) (defmethod initialize-instance :after ((chain flexichain) &rest initargs - &key initial-contents) + &key initial-contents (element-type t)) (declare (ignore initargs initial-contents)) (with-slots (expand-factor min-size) chain (assert (> expand-factor 1) () @@ -39,14 +38,14 @@ 'flexichain-initialization-error :cause "MIN-SIZE should be greater than 0.")) (if (slot-boundp chain 'fill-element) - (with-slots (element-type fill-element) chain + (with-slots (fill-element) chain (assert (typep fill-element element-type) () 'flexichain-initialization-error :cause (format nil "FILL-ELEMENT ~A not of type ~S." fill-element element-type))) (multiple-value-bind (element foundp) (find-if-2 (lambda (x) - (typep x (slot-value chain 'element-type))) + (typep x element-type)) '(nil 0 #\a)) (if foundp (setf (slot-value chain 'fill-element) element) @@ -163,22 +162,12 @@ &rest initargs &key initial-contents + (element-type t) (initial-nb-elements 0) (initial-element nil)) (declare (ignore initargs)) - ;; Check initial-contents if provided - (unless (null initial-contents) - (with-slots (element-type) chain - (multiple-value-bind (offending-element foundp) - (find-if-2 (lambda (x) - (not (typep x element-type))) - initial-contents) - (assert (not foundp) () - 'flexi-initialization-error - :cause (format nil "Initial element ~A not of type ~S." - offending-element element-type))))) ;; Initialize slots - (with-slots (element-type fill-element buffer) chain + (with-slots (fill-element buffer) chain (let* ((data-length (if (> (length initial-contents) initial-nb-elements) (length initial-contents) initial-nb-elements)) @@ -256,11 +245,9 @@ (increase-buffer-size chain nb-elements)))) (defmethod insert* ((chain standard-flexichain) position object) - (with-slots (element-type buffer gap-start) chain + (with-slots (buffer gap-start) chain (assert (<= 0 position (nb-elements chain)) () 'flexi-position-error :chain chain :position position) - (assert (typep object element-type) () - 'flexi-incompatible-type-error :element object :chain chain) (ensure-gap-position chain position) (ensure-room chain (1+ (nb-elements chain))) (setf (aref buffer gap-start) object) @@ -269,11 +256,9 @@ (setf gap-start 0)))) (defmethod insert-vector* ((chain standard-flexichain) position vector) - (with-slots (element-type buffer gap-start) chain + (with-slots (buffer gap-start) chain (assert (<= 0 position (nb-elements chain)) () 'flexi-position-error :chain chain :position position) - (assert (subtypep (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 @@ -327,11 +312,9 @@ (aref buffer (position-index chain position)))) (defmethod (setf element*) (object (chain standard-flexichain) position) - (with-slots (buffer element-type) chain + (with-slots (buffer) chain (assert (< -1 position (nb-elements chain)) () 'flexi-position-error :chain chain :position position) - (assert (typep object element-type) () - 'flexi-incompatible-type-error :chain chain :element object) (setf (aref buffer (position-index chain position)) object))) (defmethod push-start ((chain standard-flexichain) object) @@ -517,10 +500,10 @@ (defmethod resize-buffer ((fc standard-flexichain) new-buffer-size) (with-slots (buffer gap-start gap-end - fill-element element-type expand-factor) fc + fill-element expand-factor) fc (let ((buffer-size (length buffer)) (buffer-after (make-array new-buffer-size - :element-type element-type + :element-type (array-element-type buffer) :initial-element fill-element))) (case (gap-location fc) ((:gap-empty :gap-middle)

1 0