[flexichain-cvs] CVS update: flexichain/flexichain-package.lisp flexichain/flexichain.asd flexichain/flexichain.lisp flexichain/flexicursor.lisp flexichain/flexirank.lisp flexichain/rtester.lisp flexichain/skiplist.lisp flexichain/stupid.lisp flexichain/tester.lisp
Cyrus Harmon
charmon at common-lisp.net
Sun Jan 27 06:05:41 UTC 2008
Update of /project/flexichain/cvsroot/flexichain
In directory clnet:/tmp/cvs-serv19460
Modified Files:
flexichain-package.lisp flexichain.asd flexichain.lisp
flexicursor.lisp flexirank.lisp rtester.lisp skiplist.lisp
stupid.lisp tester.lisp
Log Message:
flexichain 1.4
* replaced tabs with spaces
* minor indentation and spacing whitespace fixes
Date: Sun Jan 27 01:05:37 2008
Author: charmon
Index: flexichain/flexichain-package.lisp
diff -u flexichain/flexichain-package.lisp:1.2 flexichain/flexichain-package.lisp:1.3
--- flexichain/flexichain-package.lisp:1.2 Fri Jan 25 18:59:21 2008
+++ flexichain/flexichain-package.lisp Sun Jan 27 01:05:37 2008
@@ -22,22 +22,22 @@
(defpackage :flexichain
(:use :common-lisp)
(:export #:flexichain #:standard-flexichain
- #:flexi-error #:flexi-initialization-error
- #:flexi-position-error #:flexi-incompatible-type-error
- #:nb-elements #:flexi-empty-p
- #:insert* #:insert-vector* #:element* #:delete* #:delete-elements*
- #:push-start #:pop-start #:push-end #:pop-end #:rotate
+ #:flexi-error #:flexi-initialization-error
+ #:flexi-position-error #:flexi-incompatible-type-error
+ #:nb-elements #:flexi-empty-p
+ #:insert* #:insert-vector* #:element* #:delete* #:delete-elements*
+ #:push-start #:pop-start #:push-end #:pop-end #:rotate
#:cursorchain #:standard-cursorchain
- #:flexicursor #:standard-flexicursor
- #:left-sticky-flexicursor #:right-sticky-flexicursor
- #:chain
+ #:flexicursor #:standard-flexicursor
+ #:left-sticky-flexicursor #:right-sticky-flexicursor
+ #:chain
#:clone-cursor #:cursor-pos
#:at-beginning-error #:at-end-error
- #:at-beginning-p #:at-end-p
- #:move> #:move<
- #:insert #:insert-sequence
- #:element< #:element> #:delete< #:delete>
- #:flexirank-mixin #:element-rank-mixin #:rank
- #:flexi-first-p #:flexi-last-p
- #:flexi-next #:flexi-prev))
+ #:at-beginning-p #:at-end-p
+ #:move> #:move<
+ #:insert #:insert-sequence
+ #:element< #:element> #:delete< #:delete>
+ #:flexirank-mixin #:element-rank-mixin #:rank
+ #:flexi-first-p #:flexi-last-p
+ #:flexi-next #:flexi-prev))
Index: flexichain/flexichain.asd
diff -u flexichain/flexichain.asd:1.5 flexichain/flexichain.asd:1.6
--- flexichain/flexichain.asd:1.5 Fri Jan 25 18:59:21 2008
+++ flexichain/flexichain.asd Sun Jan 27 01:05:37 2008
@@ -23,7 +23,7 @@
;; for testing.
(asdf:defsystem :flexichain
:name "flexichain"
- :version "1.3"
+ :version "1.4"
:components ((:file "flexichain-package")
(:file "utilities" :depends-on ("flexichain-package"))
(:file "flexichain" :depends-on ("utilities" "flexichain-package"))
Index: flexichain/flexichain.lisp
diff -u flexichain/flexichain.lisp:1.5 flexichain/flexichain.lisp:1.6
--- flexichain/flexichain.lisp:1.5 Sat Jan 26 06:23:09 2008
+++ flexichain/flexichain.lisp Sun Jan 27 01:05:37 2008
@@ -157,7 +157,7 @@
(defun required-space (chain nb-elements)
(with-slots (min-size expand-factor) chain
(+ 2 (max (ceiling (* nb-elements expand-factor))
- min-size))))
+ min-size))))
(defmethod initialize-instance :after ((chain standard-flexichain)
&rest initargs
@@ -182,10 +182,10 @@
(let* ((data-length (if (> (length initial-contents) initial-nb-elements)
(length initial-contents)
initial-nb-elements))
- (size (required-space chain data-length))
- (fill-size (- size data-length 2))
- (sentinel-list (make-list 2 :initial-element fill-element))
- (fill-list (make-list fill-size :initial-element fill-element)))
+ (size (required-space chain data-length))
+ (fill-size (- size data-length 2))
+ (sentinel-list (make-list 2 :initial-element fill-element))
+ (fill-list (make-list fill-size :initial-element fill-element)))
(setf buffer
(if initial-contents
(make-array size
@@ -209,10 +209,10 @@
(defmacro with-virtual-gap ((bl ds gs ge) chain &body body)
(let ((c (gensym)))
`(let* ((,c ,chain)
- (,bl (length (slot-value ,c 'buffer)))
- (,ds (slot-value ,c 'data-start))
- (,gs (slot-value ,c 'gap-start))
- (,ge (slot-value ,c 'gap-end)))
+ (,bl (length (slot-value ,c 'buffer)))
+ (,ds (slot-value ,c 'data-start))
+ (,gs (slot-value ,c 'gap-start))
+ (,ge (slot-value ,c 'gap-end)))
(declare (ignorable ,bl ,ds ,gs ,ge))
(when (< ,gs ,ds) (incf ,gs ,bl))
(when (< ,ge ,ds) (incf ,ge ,bl))
@@ -231,9 +231,9 @@
(with-virtual-gap (bl ds gs ge) chain
(let ((index (+ ds position 1)))
(when (>= index gs)
- (incf index (- ge gs)))
+ (incf index (- ge gs)))
(when (>= index bl)
- (decf index bl))
+ (decf index bl))
index)))
(defun index-position (chain index)
@@ -258,9 +258,9 @@
(defmethod insert* ((chain standard-flexichain) position object)
(with-slots (element-type buffer gap-start) chain
(assert (<= 0 position (nb-elements chain)) ()
- 'flexi-position-error :chain chain :position position)
+ 'flexi-position-error :chain chain :position position)
(assert (typep object element-type) ()
- 'flexi-incompatible-type-error :element object :chain chain)
+ '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)
@@ -271,16 +271,16 @@
(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 (subtypep (array-element-type vector) element-type) ()
- 'flexi-incompatible-type-error :element vector :chain 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
- do (setf (aref buffer gap-start) elem)
- (incf gap-start)
- (when (= gap-start (length buffer))
- (setf gap-start 0)))))
+ 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
@@ -292,7 +292,7 @@
(when (= gap-end (length buffer))
(setf gap-end 0))
(when (and (> (length buffer) (+ min-size 2))
- (< (+ (nb-elements chain) 2) (/ (length buffer) (square expand-factor))))
+ (< (+ (nb-elements chain) 2) (/ (length buffer) (square expand-factor))))
(decrease-buffer-size chain))))
(defmethod delete-elements* ((chain standard-flexichain) position n)
@@ -324,15 +324,15 @@
(defmethod element* ((chain standard-flexichain) position)
(with-slots (buffer) chain
(assert (< -1 position (nb-elements chain)) ()
- 'flexi-position-error :chain chain :position position)
+ 'flexi-position-error :chain chain :position position)
(aref buffer (position-index chain position))))
(defmethod (setf element*) (object (chain standard-flexichain) position)
(with-slots (buffer element-type) chain
(assert (< -1 position (nb-elements chain)) ()
- 'flexi-position-error :chain chain :position position)
+ 'flexi-position-error :chain chain :position position)
(assert (typep object element-type) ()
- 'flexi-incompatible-type-error :chain chain :element object)
+ 'flexi-incompatible-type-error :chain chain :element object)
(setf (aref buffer (position-index chain position)) object)))
(defmethod push-start ((chain standard-flexichain) object)
@@ -342,19 +342,21 @@
(insert* chain (nb-elements chain) object))
(defmethod pop-start ((chain standard-flexichain))
- (prog1 (element* chain 0)
- (delete* chain 0)))
+ (prog1
+ (element* chain 0)
+ (delete* chain 0)))
(defmethod pop-end ((chain standard-flexichain))
(let ((position (1- (nb-elements chain))))
- (prog1 (element* chain position)
- (delete* chain position))))
+ (prog1
+ (element* chain position)
+ (delete* chain position))))
(defmethod rotate ((chain standard-flexichain) &optional (n 1))
(when (> (nb-elements chain) 1)
(cond ((plusp n) (loop repeat n do (push-start chain (pop-end chain))))
- ((minusp n) (loop repeat (- n) do (push-end chain (pop-start chain))))
- (t nil))))
+ ((minusp n) (loop repeat (- n) do (push-end chain (pop-start chain))))
+ (t nil))))
(defun move-gap (chain hot-spot)
"Moves the elements and gap inside the buffer so that
@@ -474,7 +476,7 @@
(let* ((buffer-size (length buffer))
(rotated-gap-end (if (zerop gap-end) buffer-size gap-end)))
(move-elements chain buffer buffer
- (- rotated-gap-end count) (- gap-start count) gap-start)
+ (- rotated-gap-end count) (- gap-start count) gap-start)
(fill-gap chain (- gap-start count) (min gap-start (- rotated-gap-end count)))
(decf gap-start count)
(setf gap-end (- rotated-gap-end count))
@@ -488,7 +490,7 @@
(let* ((buffer-size (length buffer))
(rotated-gap-start (if (zerop gap-start) buffer-size gap-start)))
(move-elements chain buffer buffer
- (- gap-end count) (- rotated-gap-start count) rotated-gap-start)
+ (- gap-end count) (- rotated-gap-start count) rotated-gap-start)
(fill-gap chain (- rotated-gap-start count) rotated-gap-start)
(setf gap-start (- rotated-gap-start count))
(decf gap-end count)
Index: flexichain/flexicursor.lisp
diff -u flexichain/flexicursor.lisp:1.4 flexichain/flexicursor.lisp:1.5
--- flexichain/flexicursor.lisp:1.4 Sat Jan 26 06:23:09 2008
+++ flexichain/flexicursor.lisp Sun Jan 27 01:05:37 2008
@@ -110,20 +110,20 @@
(defclass right-sticky-flexicursor (standard-flexicursor) ())
(defmethod initialize-instance :after ((cursor left-sticky-flexicursor)
- &rest initargs &key (position 0))
+ &rest initargs &key (position 0))
(declare (ignore initargs))
(with-slots (index chain) cursor
(setf index (position-index chain (1- position)))
(with-slots (cursors) chain
- (push (make-weak-pointer cursor) cursors))))
+ (push (make-weak-pointer cursor) cursors))))
(defmethod initialize-instance :after ((cursor right-sticky-flexicursor)
- &rest initargs &key (position 0))
+ &rest initargs &key (position 0))
(declare (ignore initargs))
(with-slots (index chain) cursor
(setf index (position-index chain position))
(with-slots (cursors) chain
- (push (make-weak-pointer cursor) cursors))))
+ (push (make-weak-pointer cursor) cursors))))
(defun adjust-cursors (cursors start end increment)
(let ((acc '()))
@@ -131,18 +131,18 @@
for cursor = (and cursors (weak-pointer-value (car cursors)))
while cursors
do (cond ((null cursor)
- (pop cursors))
- ((<= start (flexicursor-index cursor) end)
- (incf (flexicursor-index cursor) increment)
- (let ((rest (cdr cursors)))
- (setf (cdr cursors) acc
- acc cursors
- cursors rest)))
- (t
- (let ((rest (cdr cursors)))
- (setf (cdr cursors) acc
- acc cursors
- cursors rest)))))
+ (pop cursors))
+ ((<= start (flexicursor-index cursor) end)
+ (incf (flexicursor-index cursor) increment)
+ (let ((rest (cdr cursors)))
+ (setf (cdr cursors) acc
+ acc cursors
+ cursors rest)))
+ (t
+ (let ((rest (cdr cursors)))
+ (setf (cdr cursors) acc
+ acc cursors
+ cursors rest)))))
acc))
(defmethod move-elements :after ((cc standard-cursorchain) to from start1 start2 end2)
@@ -160,7 +160,7 @@
(defmethod (setf cursor-pos) (position (cursor left-sticky-flexicursor))
(assert (<= 0 position (nb-elements (chain cursor))) ()
- 'flexi-position-error :chain (chain cursor) :position position)
+ 'flexi-position-error :chain (chain cursor) :position position)
(with-slots (chain) cursor
(setf (flexicursor-index cursor) (position-index chain (1- position)))))
@@ -169,7 +169,7 @@
(defmethod (setf cursor-pos) (position (cursor right-sticky-flexicursor))
(assert (<= 0 position (nb-elements (chain cursor))) ()
- 'flexi-position-error :chain (chain cursor) :position position)
+ 'flexi-position-error :chain (chain cursor) :position position)
(with-slots (chain) cursor
(setf (flexicursor-index cursor) (position-index chain position))))
@@ -185,18 +185,18 @@
(defmethod insert-sequence ((cursor standard-flexicursor) sequence)
(map nil
(lambda (object)
- (insert cursor object))
+ (insert cursor object))
sequence))
(defmethod delete* :before ((chain standard-cursorchain) position)
(with-slots (cursors) chain
(let* ((old-index (position-index chain position)))
(loop for cursor-wp in cursors
- as cursor = (weak-pointer-value cursor-wp)
- when (and cursor (= old-index (flexicursor-index cursor)))
- do (typecase cursor
- (right-sticky-flexicursor (incf (cursor-pos cursor)))
- (left-sticky-flexicursor (decf (cursor-pos cursor))))))))
+ as cursor = (weak-pointer-value cursor-wp)
+ when (and cursor (= old-index (flexicursor-index cursor)))
+ do (typecase cursor
+ (right-sticky-flexicursor (incf (cursor-pos cursor)))
+ (left-sticky-flexicursor (decf (cursor-pos cursor))))))))
(defmethod delete-elements* :before ((chain standard-cursorchain) position n)
(with-slots (cursors) chain
@@ -218,17 +218,17 @@
(let ((chain (chain cursor))
(position (cursor-pos cursor)))
(assert (plusp n) ()
- 'flexi-position-error :chain chain :position n)
+ 'flexi-position-error :chain chain :position n)
(loop repeat n
do (delete* chain position))))
(defmethod delete< ((cursor standard-flexicursor) &optional (n 1))
(let ((chain (chain cursor))
- (position (cursor-pos cursor)))
+ (position (cursor-pos cursor)))
(assert (plusp n) ()
- 'flexi-position-error :chain chain :position n)
+ 'flexi-position-error :chain chain :position n)
(loop repeat n
- do (delete* chain (- position n)))))
+ do (delete* chain (- position n)))))
(defmethod element> ((cursor standard-flexicursor))
(assert (not (at-end-p cursor)) ()
Index: flexichain/flexirank.lisp
diff -u flexichain/flexirank.lisp:1.3 flexichain/flexirank.lisp:1.4
--- flexichain/flexirank.lisp:1.3 Tue Oct 17 12:02:02 2006
+++ flexichain/flexirank.lisp Sun Jan 27 01:05:37 2008
@@ -60,21 +60,21 @@
(defmethod move-elements :before ((chain flexirank-mixin) to from start1 start2 end2)
(declare (ignore to))
(loop for old from start2 below end2
- for new from start1
- do (let ((element (aref from old)))
- (when (typep element 'element-rank-mixin)
- (setf (index element) new)))))
+ for new from start1
+ do (let ((element (aref from old)))
+ (when (typep element 'element-rank-mixin)
+ (setf (index element) new)))))
(defmethod insert* :after ((chain flexirank-mixin) position (object element-rank-mixin))
(setf (index object) (position-index chain position)
- (chain object) chain))
+ (chain object) chain))
(defmethod (setf element*) :after ((object element-rank-mixin) (chain flexirank-mixin) position)
(setf (index object) (position-index chain position)
- (chain object) chain))
+ (chain object) chain))
(defmethod insert-vector* :after ((chain flexirank-mixin) position vector)
(loop for elem across vector
- for pos from position
- do (setf (index elem) (position-index chain pos)
- (chain elem) chain)))
+ for pos from position
+ do (setf (index elem) (position-index chain pos)
+ (chain elem) chain)))
Index: flexichain/rtester.lisp
diff -u flexichain/rtester.lisp:1.1.1.1 flexichain/rtester.lisp:1.2
--- flexichain/rtester.lisp:1.1.1.1 Wed Feb 8 21:51:06 2006
+++ flexichain/rtester.lisp Sun Jan 27 01:05:37 2008
@@ -40,30 +40,30 @@
(defun compare ()
;; check that they are the same length
(assert (= (flexichain:nb-elements *fc-real*)
- (stupid:nb-elements *fc-fake*)))
+ (stupid:nb-elements *fc-fake*)))
;; check that they have the same elements in the same places
(loop for pos from 0 below (flexichain:nb-elements *fc-real*)
- do (assert (= (flexichain:element* *fc-real* pos)
- (stupid:element* *fc-fake* pos))))
+ do (assert (= (flexichain:element* *fc-real* pos)
+ (stupid:element* *fc-fake* pos))))
;; check all the cursors
(loop for x in *cursors-real*
- for y in *cursors-fake*
- do (assert (= (flexichain:cursor-pos x)
- (stupid:cursor-pos y)))
- (unless (zerop (flexichain:cursor-pos x))
- (assert (= (flexichain:element< x)
- (stupid:element< y))))
- (unless (= (flexichain:cursor-pos x)
- (flexichain:nb-elements *fc-real*))
- (assert (= (flexichain:element> x)
- (stupid:element> y))))))
+ for y in *cursors-fake*
+ do (assert (= (flexichain:cursor-pos x)
+ (stupid:cursor-pos y)))
+ (unless (zerop (flexichain:cursor-pos x))
+ (assert (= (flexichain:element< x)
+ (stupid:element< y))))
+ (unless (= (flexichain:cursor-pos x)
+ (flexichain:nb-elements *fc-real*))
+ (assert (= (flexichain:element> x)
+ (stupid:element> y))))))
(defun add-inst (inst)
(push inst *instructions*))
(defun i* (&optional
- (pos (random (1+ (stupid:nb-elements *fc-fake*))))
- (elem (random 1000000)))
+ (pos (random (1+ (stupid:nb-elements *fc-fake*))))
+ (elem (random 1000000)))
(add-inst `(i* ,pos ,elem))
(flexichain:insert* *fc-real* pos elem)
(stupid:insert* *fc-fake* pos elem))
@@ -80,7 +80,7 @@
(unless (zerop (stupid:nb-elements *fc-fake*))
(unless pos
(setf pos (random (stupid:nb-elements *fc-fake*))
- elem (random 1000000)))
+ elem (random 1000000)))
(add-inst `(se* ,pos ,elem))
(setf (flexichain:element* *fc-real* pos) elem)
(setf (stupid:element* *fc-fake* pos) elem)))
@@ -88,16 +88,16 @@
(defun mlc ()
(add-inst `(mlc))
(push (make-instance 'flexichain:left-sticky-flexicursor :chain *fc-real*)
- *cursors-real*)
+ *cursors-real*)
(push (make-instance 'stupid:left-sticky-flexicursor :chain *fc-fake*)
- *cursors-fake*))
+ *cursors-fake*))
(defun mrc ()
(add-inst `(mrc))
(push (make-instance 'flexichain:right-sticky-flexicursor :chain *fc-real*)
- *cursors-real*)
+ *cursors-real*)
(push (make-instance 'stupid:right-sticky-flexicursor :chain *fc-fake*)
- *cursors-fake*))
+ *cursors-fake*))
(defun cc (&optional (elt (random (length *cursors-real*))))
@@ -106,15 +106,15 @@
(push (stupid:clone-cursor (elt *cursors-fake* elt)) *cursors-fake*))
(defun scp (&optional
- (elt (random (length *cursors-real*)))
- (pos (random (1+ (flexichain:nb-elements *fc-real*)))))
+ (elt (random (length *cursors-real*)))
+ (pos (random (1+ (flexichain:nb-elements *fc-real*)))))
(add-inst `(scp ,elt ,pos))
(setf (flexichain:cursor-pos (elt *cursors-real* elt)) pos)
(setf (stupid:cursor-pos (elt *cursors-fake* elt)) pos))
(defun ii (&optional
- (elt (random (length *cursors-fake*)))
- (elem (random 1000000)))
+ (elt (random (length *cursors-fake*)))
+ (elem (random 1000000)))
(add-inst `(ii ,elt ,elem))
(flexichain:insert (elt *cursors-real* elt) elem)
(stupid:insert (elt *cursors-fake* elt) elem))
@@ -127,24 +127,24 @@
(defun d> (&optional (elt (random (length *cursors-fake*))))
(unless (= (stupid:cursor-pos (elt *cursors-fake* elt))
- (stupid:nb-elements (stupid:chain (elt *cursors-fake* elt))))
+ (stupid:nb-elements (stupid:chain (elt *cursors-fake* elt))))
(add-inst `(d> ,elt))
(flexichain:delete> (elt *cursors-real* elt))
(stupid:delete> (elt *cursors-fake* elt))))
(defun s< (&optional
- (elt (random (length *cursors-real*)))
- (elem (random 1000000)))
+ (elt (random (length *cursors-real*)))
+ (elem (random 1000000)))
(unless (zerop (stupid:cursor-pos (elt *cursors-fake* elt)))
(add-inst `(s< ,elt ,elem))
(setf (flexichain:element< (elt *cursors-real* elt)) elem)
(setf (stupid:element< (elt *cursors-fake* elt)) elem)))
(defun s> (&optional
- (elt (random (length *cursors-real*)))
- (elem (random 1000000)))
+ (elt (random (length *cursors-real*)))
+ (elem (random 1000000)))
(unless (= (stupid:cursor-pos (elt *cursors-fake* elt))
- (stupid:nb-elements (stupid:chain (elt *cursors-fake* elt))))
+ (stupid:nb-elements (stupid:chain (elt *cursors-fake* elt))))
(add-inst `(s> ,elt ,elem))
(setf (flexichain:element> (elt *cursors-real* elt)) elem)
(setf (stupid:element> (elt *cursors-fake* elt)) elem)))
@@ -152,8 +152,8 @@
(defmacro randomcase (&body clauses)
`(ecase (random ,(length clauses))
,@(loop for clause in clauses
- for i from 0
- collect `(,i ,clause))))
+ for i from 0
+ collect `(,i ,clause))))
(defun i-or-d ()
(if *ins-del-state*
@@ -185,11 +185,11 @@
(mlc)
(mrc)
(loop repeat n
- do (test-step)))
+ do (test-step)))
(defun replay (instructions)
(let ((*instructions* '()))
(reset-all)
(loop for inst in (reverse instructions)
- do (apply (car inst) (cdr inst))
- (compare))))
+ do (apply (car inst) (cdr inst))
+ (compare))))
Index: flexichain/skiplist.lisp
diff -u flexichain/skiplist.lisp:1.1.1.1 flexichain/skiplist.lisp:1.2
--- flexichain/skiplist.lisp:1.1.1.1 Wed Feb 8 21:51:06 2006
+++ flexichain/skiplist.lisp Sun Jan 27 01:05:37 2008
@@ -35,11 +35,11 @@
(print-unreadable-object (s stream :type t)
(with-slots (start) s
(when (entry-next start 0)
- (loop for entry = (entry-next start 0) then (entry-next entry 0)
- do (format stream "(~W ~W) "
- (entry-key entry)
- (entry-obj entry))
- until (last-entry-p start entry 0))))))
+ (loop for entry = (entry-next start 0) then (entry-next entry 0)
+ do (format stream "(~W ~W) "
+ (entry-key entry)
+ (entry-obj entry))
+ until (last-entry-p start entry 0))))))
(defun entry-obj (entry)
(aref entry 0))
@@ -88,18 +88,18 @@
(defun find-entry-level (skiplist entry level key)
(with-slots (start) skiplist
(loop until (or (key-= skiplist (entry-key (entry-next entry level)) key)
- (and (key-< skiplist (entry-key entry) key)
- (key-> skiplist (entry-key (entry-next entry level)) key))
- (and (key-< skiplist (entry-key entry) key)
- (key-< skiplist (entry-key (entry-next entry level)) key)
- (last-entry-p start entry level)
- (eq (entry-next entry level) (entry-next start level)))
- (and (key-> skiplist (entry-key entry) key)
- (key-> skiplist (entry-key (entry-next entry level)) key)
- (last-entry-p start entry level)))
- do (setf entry (entry-next entry level))))
+ (and (key-< skiplist (entry-key entry) key)
+ (key-> skiplist (entry-key (entry-next entry level)) key))
+ (and (key-< skiplist (entry-key entry) key)
+ (key-< skiplist (entry-key (entry-next entry level)) key)
+ (last-entry-p start entry level)
+ (eq (entry-next entry level) (entry-next start level)))
+ (and (key-> skiplist (entry-key entry) key)
+ (key-> skiplist (entry-key (entry-next entry level)) key)
+ (last-entry-p start entry level)))
+ do (setf entry (entry-next entry level))))
entry)
-
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -111,10 +111,10 @@
(with-slots (current-maxlevel start) skiplist
(let ((entry (entry-next start current-maxlevel)))
(loop for l downfrom current-maxlevel to 0
- do (setf entry (find-entry-level skiplist entry l key)))
+ do (setf entry (find-entry-level skiplist entry l key)))
(if (key-= skiplist (entry-key (entry-next entry 0)) key)
- (values (entry-obj (entry-next entry 0)) t)
- (values nil nil)))))
+ (values (entry-obj (entry-next entry 0)) t)
+ (values nil nil)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -124,7 +124,7 @@
(assert (not (skiplist-empty-p skiplist)))
(with-slots (start) skiplist
(values (entry-obj (entry-next start 0))
- (entry-key (entry-next start 0)))))
+ (entry-key (entry-next start 0)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -132,37 +132,37 @@
(defun pick-a-level (maxlevel)
(loop for level from 0 to maxlevel
- while (zerop (random 2))
- finally (return level)))
+ while (zerop (random 2))
+ finally (return level)))
(defun make-entry (level key obj)
(let ((entry (make-array (+ level 3) :initial-element nil)))
(setf (aref entry 0) obj
- (aref entry 1) key)
+ (aref entry 1) key)
entry))
(defun (setf skiplist-find) (obj skiplist key)
(with-slots (current-maxlevel start) skiplist
(if (second (multiple-value-list (skiplist-find skiplist key)))
- (let ((entry (entry-next start current-maxlevel)))
- (loop for l downfrom current-maxlevel to 0
- do (setf entry (find-entry-level skiplist entry l key)))
- (setf (entry-obj (entry-next entry 0)) obj))
- (let* ((level (pick-a-level (maxlevel skiplist)))
- (new-entry (make-entry level key obj)))
- (loop for l downfrom level above current-maxlevel
- do (setf (entry-next start l) new-entry
- (entry-next new-entry l) new-entry))
- (let ((entry (entry-next start current-maxlevel)))
- (loop for l downfrom current-maxlevel above level
- do (setf entry (find-entry-level skiplist entry l key)))
- (loop for l downfrom (min level current-maxlevel) to 0
- do (setf entry (find-entry-level skiplist entry l key))
- (setf (entry-next new-entry l) (entry-next entry l)
- (entry-next entry l) new-entry)
- (when (key-< skiplist key (entry-key entry))
- (setf (entry-next start l) new-entry))))
- (setf current-maxlevel (max current-maxlevel level)))))
+ (let ((entry (entry-next start current-maxlevel)))
+ (loop for l downfrom current-maxlevel to 0
+ do (setf entry (find-entry-level skiplist entry l key)))
+ (setf (entry-obj (entry-next entry 0)) obj))
+ (let* ((level (pick-a-level (maxlevel skiplist)))
+ (new-entry (make-entry level key obj)))
+ (loop for l downfrom level above current-maxlevel
+ do (setf (entry-next start l) new-entry
+ (entry-next new-entry l) new-entry))
+ (let ((entry (entry-next start current-maxlevel)))
+ (loop for l downfrom current-maxlevel above level
+ do (setf entry (find-entry-level skiplist entry l key)))
+ (loop for l downfrom (min level current-maxlevel) to 0
+ do (setf entry (find-entry-level skiplist entry l key))
+ (setf (entry-next new-entry l) (entry-next entry l)
+ (entry-next entry l) new-entry)
+ (when (key-< skiplist key (entry-key entry))
+ (setf (entry-next start l) new-entry))))
+ (setf current-maxlevel (max current-maxlevel level)))))
skiplist)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -174,20 +174,20 @@
(with-slots (current-maxlevel start) skiplist
(let ((entry (entry-next start current-maxlevel)))
(loop for l downfrom current-maxlevel to 0
- do (setf entry (find-entry-level skiplist entry l key))
- when (key-= skiplist (entry-key (entry-next entry l)) key)
- do (cond ((key-= skiplist (entry-key entry) key)
- (setf (entry-next start l) nil))
- ((key-< skiplist (entry-key entry) key)
- (setf (entry-next entry l)
- (entry-next (entry-next entry l) l)))
- (t (setf (entry-next entry l)
- (entry-next (entry-next entry l) l))
- (setf (entry-next start l)
- (entry-next entry l)))))
+ do (setf entry (find-entry-level skiplist entry l key))
+ when (key-= skiplist (entry-key (entry-next entry l)) key)
+ do (cond ((key-= skiplist (entry-key entry) key)
+ (setf (entry-next start l) nil))
+ ((key-< skiplist (entry-key entry) key)
+ (setf (entry-next entry l)
+ (entry-next (entry-next entry l) l)))
+ (t (setf (entry-next entry l)
+ (entry-next (entry-next entry l) l))
+ (setf (entry-next start l)
+ (entry-next entry l)))))
(loop while (and (null (entry-next start current-maxlevel))
- (>= current-maxlevel 0))
- do (decf current-maxlevel))))
+ (>= current-maxlevel 0))
+ do (decf current-maxlevel))))
skiplist)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -197,21 +197,21 @@
(defun update-interval (skiplist entry to update-key)
(with-slots (start) skiplist
(flet ((update-entry (entry)
- (setf (entry-key entry)
- (funcall update-key (entry-key entry) (entry-obj entry)))))
+ (setf (entry-key entry)
+ (funcall update-key (entry-key entry) (entry-obj entry)))))
(loop while (key-<= skiplist (entry-key entry) to)
- do (update-entry entry)
- until (last-entry-p start entry 0)
- do (setf entry (entry-next entry 0))))))
+ do (update-entry entry)
+ until (last-entry-p start entry 0)
+ do (setf entry (entry-next entry 0))))))
(defun skiplist-slide-keys (skiplist from to update-key)
(unless (skiplist-empty-p skiplist)
(with-slots (current-maxlevel start) skiplist
(let ((entry (entry-next start current-maxlevel)))
- (loop for l downfrom current-maxlevel to 0
- do (setf entry (find-entry-level skiplist entry l from)))
- (when (key->= skiplist (entry-key (entry-next entry 0)) from)
- (update-interval skiplist (entry-next entry 0) to update-key)))))
+ (loop for l downfrom current-maxlevel to 0
+ do (setf entry (find-entry-level skiplist entry l from)))
+ (when (key->= skiplist (entry-key (entry-next entry 0)) from)
+ (update-interval skiplist (entry-next entry 0) to update-key)))))
skiplist)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -222,22 +222,22 @@
(unless (skiplist-empty-p skiplist)
(with-slots (current-maxlevel start) skiplist
(let ((entry (entry-next start current-maxlevel)))
- (loop for l downfrom current-maxlevel to 0
- do (setf entry (find-entry-level skiplist entry l to)))
- (when (key-= skiplist (entry-key (entry-next entry 0)) to)
- (setf entry (entry-next entry 0)))
- (cond ((and (key-> skiplist (entry-key entry) to)
- (key-> skiplist (entry-key (entry-next entry 0)) to))
- nil)
- ((and (key-<= skiplist (entry-key entry) to)
- (key-<= skiplist (entry-key (entry-next entry 0)) to))
- (update-interval skiplist (entry-next entry 0) to update-key))
- (t (update-interval skiplist (entry-next start 0) to update-key)
- (loop with entry = (entry-next entry 0)
- for level from 0 to current-maxlevel
- do (loop until (>= (length entry) (+ 3 level))
- do (setf entry (entry-next entry (1- level))))
- (setf (entry-next start level) entry)))))))
+ (loop for l downfrom current-maxlevel to 0
+ do (setf entry (find-entry-level skiplist entry l to)))
+ (when (key-= skiplist (entry-key (entry-next entry 0)) to)
+ (setf entry (entry-next entry 0)))
+ (cond ((and (key-> skiplist (entry-key entry) to)
+ (key-> skiplist (entry-key (entry-next entry 0)) to))
+ nil)
+ ((and (key-<= skiplist (entry-key entry) to)
+ (key-<= skiplist (entry-key (entry-next entry 0)) to))
+ (update-interval skiplist (entry-next entry 0) to update-key))
+ (t (update-interval skiplist (entry-next start 0) to update-key)
+ (loop with entry = (entry-next entry 0)
+ for level from 0 to current-maxlevel
+ do (loop until (>= (length entry) (+ 3 level))
+ do (setf entry (entry-next entry (1- level))))
+ (setf (entry-next start level) entry)))))))
skiplist)
@@ -248,28 +248,28 @@
(defun update-interval-to-end (skiplist entry update-key)
(with-slots (start) skiplist
(flet ((update-entry (entry)
- (setf (entry-key entry)
- (funcall update-key (entry-key entry) (entry-obj entry)))))
+ (setf (entry-key entry)
+ (funcall update-key (entry-key entry) (entry-obj entry)))))
(loop do (update-entry entry)
- until (last-entry-p start entry 0)
- do (setf entry (entry-next entry 0))))))
+ until (last-entry-p start entry 0)
+ do (setf entry (entry-next entry 0))))))
(defun skiplist-rotate-suffix (skiplist from update-key)
(unless (skiplist-empty-p skiplist)
(with-slots (current-maxlevel start) skiplist
(let ((entry (entry-next start current-maxlevel)))
- (loop for l downfrom current-maxlevel to 0
- do (setf entry (find-entry-level skiplist entry l from)))
- (cond ((and (key-< skiplist (entry-key entry) from)
- (key-< skiplist (entry-key (entry-next entry 0)) from))
- nil)
- ((and (key->= skiplist (entry-key entry) from)
- (key->= skiplist (entry-key (entry-next entry 0)) from))
- (update-interval-to-end skiplist (entry-next entry 0) update-key))
- (t (update-interval-to-end skiplist (entry-next entry 0) update-key)
- (loop with entry = (entry-next entry 0)
- for level from 0 to current-maxlevel
- do (loop until (>= (length entry) (+ 3 level))
- do (setf entry (entry-next entry (1- level))))
- (setf (entry-next start level) entry)))))))
+ (loop for l downfrom current-maxlevel to 0
+ do (setf entry (find-entry-level skiplist entry l from)))
+ (cond ((and (key-< skiplist (entry-key entry) from)
+ (key-< skiplist (entry-key (entry-next entry 0)) from))
+ nil)
+ ((and (key->= skiplist (entry-key entry) from)
+ (key->= skiplist (entry-key (entry-next entry 0)) from))
+ (update-interval-to-end skiplist (entry-next entry 0) update-key))
+ (t (update-interval-to-end skiplist (entry-next entry 0) update-key)
+ (loop with entry = (entry-next entry 0)
+ for level from 0 to current-maxlevel
+ do (loop until (>= (length entry) (+ 3 level))
+ do (setf entry (entry-next entry (1- level))))
+ (setf (entry-next start level) entry)))))))
skiplist)
Index: flexichain/stupid.lisp
diff -u flexichain/stupid.lisp:1.1.1.1 flexichain/stupid.lisp:1.2
--- flexichain/stupid.lisp:1.1.1.1 Wed Feb 8 21:51:06 2006
+++ flexichain/stupid.lisp Sun Jan 27 01:05:37 2008
@@ -6,21 +6,21 @@
(defpackage :stupid
(:use :common-lisp)
(:export #:flexichain #:standard-flexichain
- #:flexi-error #:flexi-initialization-error
- #:flexi-position-error #:flexi-incompatible-type-error
- #:nb-elements #:flexi-empty-p
- #:insert* #:element* #:delete*
- #:push-start #:pop-start #:push-end #:pop-end #:rotate
+ #:flexi-error #:flexi-initialization-error
+ #:flexi-position-error #:flexi-incompatible-type-error
+ #:nb-elements #:flexi-empty-p
+ #:insert* #:element* #:delete*
+ #:push-start #:pop-start #:push-end #:pop-end #:rotate
#:cursorchain #:standard-cursorchain
- #:flexicursor #:standard-flexicursor
- #:left-sticky-flexicursor #:right-sticky-flexicursor
- #:chain
+ #:flexicursor #:standard-flexicursor
+ #:left-sticky-flexicursor #:right-sticky-flexicursor
+ #:chain
#:clone-cursor #:cursor-pos
#:at-beginning-error #:at-end-error
- #:at-beginning-p #:at-end-p
- #:move> #:move<
- #:insert #:insert-sequence
- #:element< #:element> #:delete< #:delete>))
+ #:at-beginning-p #:at-end-p
+ #:move> #:move<
+ #:insert #:insert-sequence
+ #:element< #:element> #:delete< #:delete>))
(in-package :stupid)
@@ -118,17 +118,17 @@
(defmethod insert* ((chain standard-flexichain) position object)
(assert (<= 0 position (nb-elements chain)) ()
- 'flexi-position-error :chain chain :position position)
+ 'flexi-position-error :chain chain :position position)
(let* ((remainder (nthcdr (* 2 position) (elements chain))))
(push (remove-if-not (lambda (x) (typep x 'right-sticky-flexicursor)) (car remainder))
- (cdr remainder))
+ (cdr remainder))
(push object (cdr remainder))
(setf (car remainder)
- (remove-if (lambda (x) (typep x 'right-sticky-flexicursor)) (car remainder)))))
+ (remove-if (lambda (x) (typep x 'right-sticky-flexicursor)) (car remainder)))))
(defmethod delete* ((chain standard-flexichain) position)
(assert (< -1 position (nb-elements chain)) ()
- 'flexi-position-error :chain chain :position position)
+ 'flexi-position-error :chain chain :position position)
(let* ((remainder (nthcdr (* 2 position) (elements chain))))
(pop (cdr remainder))
(setf (car remainder) (append (cadr remainder) (car remainder)))
@@ -136,12 +136,12 @@
(defmethod element* ((chain standard-flexichain) position)
(assert (< -1 position (nb-elements chain)) ()
- 'flexi-position-error :chain chain :position position)
+ 'flexi-position-error :chain chain :position position)
(nth (1+ (* 2 position)) (elements chain)))
(defmethod (setf element*) (object (chain standard-flexichain) position)
(assert (< -1 position (nb-elements chain)) ()
- 'flexi-position-error :chain chain :position position)
+ 'flexi-position-error :chain chain :position position)
(setf (nth (1+ (* 2 position)) (elements chain)) object))
(defmethod push-start ((chain standard-flexichain) object)
@@ -152,18 +152,18 @@
(defmethod pop-start ((chain standard-flexichain))
(prog1 (element* chain 0)
- (delete* chain 0)))
+ (delete* chain 0)))
(defmethod pop-end ((chain standard-flexichain))
(let ((position (1- (nb-elements chain))))
(prog1 (element* chain position)
- (delete* chain position))))
+ (delete* chain position))))
(defmethod rotate ((chain standard-flexichain) &optional (n 1))
(when (> (nb-elements chain) 1)
(cond ((plusp n) (loop repeat n do (push-start chain (pop-end chain))))
- ((minusp n) (loop repeat (- n) do (push-end chain (pop-start chain))))
- (t nil))))
+ ((minusp n) (loop repeat (- n) do (push-end chain (pop-start chain))))
+ (t nil))))
(defclass cursorchain (flexichain)
()
@@ -249,7 +249,7 @@
(:documentation "The standard instantiable subclass of FLEXICURSOR"))
(defmethod initialize-instance :after ((cursor standard-flexicursor)
- &rest args &key (position 0))
+ &rest args &key (position 0))
(declare (ignore args))
(push cursor (car (nthcdr (* 2 position) (elements (chain cursor))))))
@@ -259,9 +259,9 @@
(defmethod cursor-pos ((cursor standard-flexicursor))
(loop for sublist on (elements (chain cursor)) by #'cddr
- for pos from 0
- when (member cursor (car sublist) :test #'eq)
- do (return pos)))
+ for pos from 0
+ when (member cursor (car sublist) :test #'eq)
+ do (return pos)))
(defun sublist-of-cursor (cursor)
(nthcdr (* 2 (cursor-pos cursor)) (elements (chain cursor))))
@@ -273,9 +273,9 @@
(defmethod (setf cursor-pos) (position (cursor standard-flexicursor))
(assert (<= 0 position (nb-elements (chain cursor))) ()
- 'flexi-position-error :chain (chain cursor) :position position)
+ 'flexi-position-error :chain (chain cursor) :position position)
(let ((sublist1 (sublist-of-cursor cursor))
- (sublist2 (nthcdr (* 2 position) (elements (chain cursor)))))
+ (sublist2 (nthcdr (* 2 position) (elements (chain cursor)))))
(setf (car sublist1) (remove cursor (car sublist1) :test #'eq))
(push cursor (car sublist2))))
@@ -297,24 +297,24 @@
(defmethod insert-sequence ((cursor standard-flexicursor) sequence)
(map nil
(lambda (object)
- (insert cursor object))
+ (insert cursor object))
sequence))
(defmethod delete> ((cursor standard-flexicursor) &optional (n 1))
(let ((chain (chain cursor))
(position (cursor-pos cursor)))
(assert (plusp n) ()
- 'flexi-position-error :chain chain :position n)
+ 'flexi-position-error :chain chain :position n)
(loop repeat n
do (delete* chain position))))
(defmethod delete< ((cursor standard-flexicursor) &optional (n 1))
(let ((chain (chain cursor))
- (position (cursor-pos cursor)))
+ (position (cursor-pos cursor)))
(assert (plusp n) ()
- 'flexi-position-error :chain chain :position n)
+ 'flexi-position-error :chain chain :position n)
(loop repeat n
- do (delete* chain (- position n)))))
+ do (delete* chain (- position n)))))
(defmethod element> ((cursor standard-flexicursor))
(assert (not (at-end-p cursor)) ()
Index: flexichain/tester.lisp
diff -u flexichain/tester.lisp:1.1.1.1 flexichain/tester.lisp:1.2
--- flexichain/tester.lisp:1.1.1.1 Wed Feb 8 21:51:06 2006
+++ flexichain/tester.lisp Sun Jan 27 01:05:37 2008
@@ -2,9 +2,9 @@
(define-application-frame tester ()
((chain :initform (make-instance 'standard-cursorchain
- :element-type 'character
- :fill-element #\_)
- :reader chain)
+ :element-type 'character
+ :fill-element #\_)
+ :reader chain)
(cursors :initform (make-array 2) :reader cursors))
(:panes
(app :application :width 800 :height 300 :display-function 'display-app)
@@ -15,67 +15,67 @@
(declare (ignore args))
(with-slots (chain cursors) frame
(setf (aref cursors 0)
- (make-instance 'left-sticky-flexicursor :chain chain))
+ (make-instance 'left-sticky-flexicursor :chain chain))
(setf (aref cursors 1)
- (make-instance 'right-sticky-flexicursor :chain chain))))
+ (make-instance 'right-sticky-flexicursor :chain chain))))
(defun run-tester ()
(loop for port in climi::*all-ports*
- do (destroy-port port))
+ do (destroy-port port))
(setq climi::*all-ports* nil)
(run-frame-top-level (make-application-frame 'tester)))
(defun display-app (frame pane)
(let* ((chain (chain frame))
- (buffer (slot-value chain 'flexichain::buffer))
- (length (length buffer))
- (cursors (cursors frame)))
+ (buffer (slot-value chain 'flexichain::buffer))
+ (length (length buffer))
+ (cursors (cursors frame)))
(format pane "nb elments: ~a~%~%" (nb-elements chain))
(loop for i from 0 below (nb-elements chain)
- do (format pane " ~a" (element* chain i)))
+ do (format pane " ~a" (element* chain i)))
(format pane "~%")
(loop for i from 0 below 2
- do (format pane (if (minusp (cursor-pos (aref cursors i)))
- (make-string (* -2 (cursor-pos (aref cursors i)))
- :initial-element #\?)
- (make-string (* 2 (cursor-pos (aref cursors i)))
- :initial-element #\space)))
- (format pane "~a~%" i))
+ do (format pane (if (minusp (cursor-pos (aref cursors i)))
+ (make-string (* -2 (cursor-pos (aref cursors i)))
+ :initial-element #\?)
+ (make-string (* 2 (cursor-pos (aref cursors i)))
+ :initial-element #\space)))
+ (format pane "~a~%" i))
(format pane "~%~%")
(format pane (if (minusp (slot-value chain 'flexichain::gap-start))
- (make-string (* -2 (slot-value chain 'flexichain::gap-start))
- :initial-element #\?)
- (make-string (* 2 (slot-value chain 'flexichain::gap-start))
- :initial-element #\space)))
+ (make-string (* -2 (slot-value chain 'flexichain::gap-start))
+ :initial-element #\?)
+ (make-string (* 2 (slot-value chain 'flexichain::gap-start))
+ :initial-element #\space)))
(format pane ">~%")
(format pane (if (minusp (slot-value chain 'flexichain::gap-end))
- (make-string (* -2 (slot-value chain 'flexichain::gap-end))
- :initial-element #\?)
- (make-string (* 2 (slot-value chain 'flexichain::gap-end))
- :initial-element #\space)))
+ (make-string (* -2 (slot-value chain 'flexichain::gap-end))
+ :initial-element #\?)
+ (make-string (* 2 (slot-value chain 'flexichain::gap-end))
+ :initial-element #\space)))
(format pane "<~%")
(loop for i from 0 below length
- do (format pane "~a~a"
- (if (= i (slot-value chain 'flexichain::data-start))
- #\* #\Space)
- (aref buffer i)))
+ do (format pane "~a~a"
+ (if (= i (slot-value chain 'flexichain::data-start))
+ #\* #\Space)
+ (aref buffer i)))
(format pane "~%")
(loop for i from 0 below 2
- do (format pane (make-string (1+ (* 2 (slot-value (aref cursors i)
- 'flexichain::index)))
- :initial-element #\space))
- (format pane "~a~a~%" i (at-end-p (aref cursors i))))
+ do (format pane (make-string (1+ (* 2 (slot-value (aref cursors i)
+ 'flexichain::index)))
+ :initial-element #\space))
+ (format pane "~a~a~%" i (at-end-p (aref cursors i))))
(format pane "~%~%")))
(defmethod execute-frame-command :around ((frame tester) command)
(declare (ignore command))
(handler-case (call-next-method)
(flexi-error (condition) (format (frame-standard-input *application-frame*)
- "~a~%" condition))))
+ "~a~%" condition))))
(define-tester-command (com-empty :name t) ()
(format (frame-standard-input *application-frame*)
- "~a~%" (flexi-empty-p (chain *application-frame*))))
+ "~a~%" (flexi-empty-p (chain *application-frame*))))
(defun to-char (symbol)
(char-downcase (aref (symbol-name symbol) 0)))
@@ -85,7 +85,7 @@
(define-tester-command (com-element* :name t) ((pos 'integer))
(format (frame-standard-input *application-frame*)
- "~a~%" (element* (chain *application-frame*) pos)))
+ "~a~%" (element* (chain *application-frame*) pos)))
(define-tester-command (com-set-element* :name t) ((pos 'integer) (object 'symbol))
(setf (element* (chain *application-frame*) pos) (to-char object)))
@@ -101,11 +101,11 @@
(define-tester-command (com-pop-start :name t) ()
(format (frame-standard-input *application-frame*)
- "~a~%" (pop-start (chain *application-frame*))))
+ "~a~%" (pop-start (chain *application-frame*))))
(define-tester-command (com-pop-end :name t) ()
(format (frame-standard-input *application-frame*)
- "~a~%" (pop-end (chain *application-frame*))))
+ "~a~%" (pop-end (chain *application-frame*))))
(define-tester-command (com-rotate :name t) ((amount 'integer))
(rotate (chain *application-frame*) amount))
@@ -128,11 +128,11 @@
(define-tester-command (com-clear :name t) ()
(with-slots (chain cursors) *application-frame*
(setf chain (make-instance 'standard-cursorchain
- :element-type 'character :fill-element #\_))
+ :element-type 'character :fill-element #\_))
(setf (aref cursors 0)
- (make-instance 'left-sticky-flexicursor :chain chain))
+ (make-instance 'left-sticky-flexicursor :chain chain))
(setf (aref cursors 1)
- (make-instance 'right-sticky-flexicursor :chain chain))))
+ (make-instance 'right-sticky-flexicursor :chain chain))))
(define-tester-command (com-quit :name t) ()
(frame-exit *application-frame*))
More information about the Flexichain-cvs
mailing list