/[flexichain]/flexichain/flexichain.lisp
ViewVC logotype

Contents of /flexichain/flexichain.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (show annotations)
Sun Jan 27 06:05:37 2008 UTC (6 years, 2 months ago) by charmon
Branch: MAIN
Changes since 1.5: +34 -32 lines
flexichain 1.4
 * replaced tabs with spaces
 * minor indentation and spacing whitespace fixes
1 ;;; Flexichain
2 ;;; Flexichain data structure definition
3 ;;;
4 ;;; Copyright (C) 2003-2004 Robert Strandh (strandh@labri.fr)
5 ;;; Copyright (C) 2003-2004 Matthieu Villeneuve (matthieu.villeneuve@free.fr)
6 ;;;
7 ;;; This library is free software; you can redistribute it and/or
8 ;;; modify it under the terms of the GNU Lesser General Public
9 ;;; License as published by the Free Software Foundation; either
10 ;;; version 2.1 of the License, or (at your option) any later version.
11 ;;;
12 ;;; This library is distributed in the hope that it will be useful,
13 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 ;;; Lesser General Public License for more details.
16 ;;;
17 ;;; You should have received a copy of the GNU Lesser General Public
18 ;;; License along with this library; if not, write to the Free Software
19 ;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20
21
22 (in-package :flexichain)
23
24 (defclass flexichain ()
25 ((element-type :initarg :element-type :initform t)
26 (fill-element :initarg :fill-element)
27 (expand-factor :initarg :expand-factor :initform 1.5)
28 (min-size :initarg :min-size :initform 5))
29 (:documentation "The protocol class for flexichains."))
30
31 (defmethod initialize-instance :after ((chain flexichain) &rest initargs
32 &key initial-contents)
33 (declare (ignore initargs initial-contents))
34 (with-slots (expand-factor min-size) chain
35 (assert (> expand-factor 1) ()
36 'flexichain-initialization-error
37 :cause "EXPAND-FACTOR should be greater than 1.")
38 (assert (> min-size 0) ()
39 'flexichain-initialization-error
40 :cause "MIN-SIZE should be greater than 0."))
41 (if (slot-boundp chain 'fill-element)
42 (with-slots (element-type fill-element) chain
43 (assert (typep fill-element element-type) ()
44 'flexichain-initialization-error
45 :cause (format nil "FILL-ELEMENT ~A not of type ~S."
46 fill-element element-type)))
47 (multiple-value-bind (element foundp)
48 (find-if-2 (lambda (x)
49 (typep x (slot-value chain 'element-type)))
50 '(nil 0 #\a))
51 (if foundp
52 (setf (slot-value chain 'fill-element) element)
53 (error 'flexichain-initialization-error
54 :cause
55 "FILL-ELEMENT not provided, no default applicable.")))))
56
57 (define-condition flexi-error (simple-error)
58 ())
59
60 (define-condition flexi-initialization-error (flexi-error)
61 ((cause :reader flexi-initialization-error-cause
62 :initarg :cause :initform ""))
63 (:report (lambda (condition stream)
64 (format stream "Error initializing FLEXICHAIN (~S)"
65 (flexi-initialization-error-cause condition)))))
66
67 (define-condition flexi-position-error (flexi-error)
68 ((chain :reader flexi-position-error-chain
69 :initarg :chain :initform nil)
70 (position :reader flexi-position-error-position
71 :initarg :position :initform nil))
72 (:report (lambda (condition stream)
73 (format stream "Position ~D out of bounds in ~A"
74 (flexi-position-error-position condition)
75 (flexi-position-error-chain condition)))))
76
77 (define-condition flexi-incompatible-type-error (flexi-error)
78 ((chain :reader flexi-incompatible-type-error-chain
79 :initarg :chain :initform nil)
80 (element :reader flexi-incompatible-type-error-element
81 :initarg :element :initform nil))
82 (:report (lambda (condition stream)
83 (let ((element (flexi-incompatible-type-error-element
84 condition)))
85 (format stream "Element ~A of type ~A cannot be inserted in ~A"
86 element
87 (type-of element)
88 (flexi-incompatible-type-error-chain condition))))))
89
90 (defgeneric nb-elements (chain)
91 (:documentation "Returns the number of elements in the flexichain."))
92
93 (defgeneric flexi-empty-p (chain)
94 (:documentation "Checks whether CHAIN is empty or not."))
95
96 (defgeneric insert* (chain position object)
97 (:documentation "Inserts an object before the element at POSITION
98 in the chain. If POSITION is out of range (less than 0 or greater
99 than the length of CHAIN, the FLEXI-POSITION-ERROR condition will be
100 signaled."))
101
102 (defgeneric insert-vector* (chain position vector)
103 (:documentation "Inserts the elements of VECTOR before the
104 element at POSITION in the chain. If POSITION is out of
105 range (less than 0 or greater than the length of CHAIN, the
106 FLEXI-POSITION-ERROR condition will be signaled."))
107
108 (defgeneric delete* (chain position)
109 (:documentation "Deletes an element at POSITION of the chain.
110 If POSITION is out of range (less than 0 or greater than or equal
111 to the length of CHAIN, the FLEXI-POSITION-ERROR condition
112 will be signaled."))
113
114 (defgeneric delete-elements* (chain position n)
115 (:documentation "Delete N elements at POSITION of the chain. If
116 POSITION+N is out of range (less than 0 or greater than or equal
117 to the length of CHAIN, the FLEXI-POSITION-ERROR condition will
118 be signaled. N can be negative, in which case elements will be
119 deleted before POSITION."))
120
121 (defgeneric element* (chain position)
122 (:documentation "Returns the element at POSITION of the chain.
123 If POSITION is out of range (less than 0 or greater than or equal
124 to the length of CHAIN, the FLEXI-POSITION-ERROR condition
125 will be signaled."))
126
127 (defgeneric (setf element*) (object chain position)
128 (:documentation "Replaces the element at POSITION of CHAIN by OBJECT.
129 If POSITION if out of range (less than 0 or greater than or equal to
130 the length of CHAIN, the FLEXI-POSITION-ERROR condition will be signaled."))
131
132 (defgeneric push-start (chain object)
133 (:documentation "Inserts an object at the beginning of CHAIN."))
134
135 (defgeneric push-end (chain object)
136 (:documentation "Inserts an object at the end of CHAIN."))
137
138 (defgeneric pop-start (chain)
139 (:documentation "Pops and returns the element at the beginning of CHAIN."))
140
141 (defgeneric pop-end (chain)
142 (:documentation "Pops and returns the element at the end of CHAIN."))
143
144 (defgeneric rotate (chain &optional n)
145 (:documentation "Rotates the elements of CHAIN so that the element
146 that used to be at position N is now at position 0. With a negative
147 value of N, rotates the elements so that the element that used to be
148 at position 0 is now at position N."))
149
150 (defclass standard-flexichain (flexichain)
151 ((buffer)
152 (gap-start)
153 (gap-end)
154 (data-start))
155 (:documentation "The standard instantiable subclass of FLEXICHAIN."))
156
157 (defun required-space (chain nb-elements)
158 (with-slots (min-size expand-factor) chain
159 (+ 2 (max (ceiling (* nb-elements expand-factor))
160 min-size))))
161
162 (defmethod initialize-instance :after ((chain standard-flexichain)
163 &rest initargs
164 &key
165 initial-contents
166 (initial-nb-elements 0)
167 (initial-element nil))
168 (declare (ignore initargs))
169 ;; Check initial-contents if provided
170 (unless (null initial-contents)
171 (with-slots (element-type) chain
172 (multiple-value-bind (offending-element foundp)
173 (find-if-2 (lambda (x)
174 (not (typep x element-type)))
175 initial-contents)
176 (assert (not foundp) ()
177 'flexi-initialization-error
178 :cause (format nil "Initial element ~A not of type ~S."
179 offending-element element-type)))))
180 ;; Initialize slots
181 (with-slots (element-type fill-element buffer) chain
182 (let* ((data-length (if (> (length initial-contents) initial-nb-elements)
183 (length initial-contents)
184 initial-nb-elements))
185 (size (required-space chain data-length))
186 (fill-size (- size data-length 2))
187 (sentinel-list (make-list 2 :initial-element fill-element))
188 (fill-list (make-list fill-size :initial-element fill-element)))
189 (setf buffer
190 (if initial-contents
191 (make-array size
192 :element-type element-type
193 :initial-contents (concatenate 'list
194 sentinel-list
195 initial-contents
196 fill-list))
197 (let ((arr (make-array size
198 :element-type element-type
199 :initial-element initial-element)))
200 (fill arr fill-element :end (length sentinel-list))
201 (fill arr fill-element
202 :start (+ (length sentinel-list) initial-nb-elements)
203 :end size))))
204 (with-slots (gap-start gap-end data-start) chain
205 (setf gap-start (+ 2 data-length)
206 gap-end 0
207 data-start 1)))))
208
209 (defmacro with-virtual-gap ((bl ds gs ge) chain &body body)
210 (let ((c (gensym)))
211 `(let* ((,c ,chain)
212 (,bl (length (slot-value ,c 'buffer)))
213 (,ds (slot-value ,c 'data-start))
214 (,gs (slot-value ,c 'gap-start))
215 (,ge (slot-value ,c 'gap-end)))
216 (declare (ignorable ,bl ,ds ,gs ,ge))
217 (when (< ,gs ,ds) (incf ,gs ,bl))
218 (when (< ,ge ,ds) (incf ,ge ,bl))
219 ,@body)))
220
221 (defmethod nb-elements ((chain standard-flexichain))
222 (with-virtual-gap (bl ds gs ge) chain
223 (- bl (- ge gs) 2)))
224
225 (defmethod flexi-empty-p ((chain standard-flexichain))
226 (zerop (nb-elements chain)))
227
228 (defun position-index (chain position)
229 "Returns the (0 indexed) index of the POSITION-th element
230 of the CHAIN in the buffer."
231 (with-virtual-gap (bl ds gs ge) chain
232 (let ((index (+ ds position 1)))
233 (when (>= index gs)
234 (incf index (- ge gs)))
235 (when (>= index bl)
236 (decf index bl))
237 index)))
238
239 (defun index-position (chain index)
240 "Returns the position corresponding to the INDEX in the CHAIN.
241 Note: the result is undefined if INDEX is not the index of a valid
242 element of the CHAIN."
243 (with-virtual-gap (bl ds gs ge) chain
244 (when (< index ds)
245 (incf index bl))
246 (when (>= index ge)
247 (decf index (- ge gs)))
248 (- index ds 1)))
249
250 (defun ensure-gap-position (chain position)
251 (move-gap chain (position-index chain position)))
252
253 (defun ensure-room (chain nb-elements)
254 (with-slots (buffer) chain
255 (when (> nb-elements (- (length buffer) 2))
256 (increase-buffer-size chain nb-elements))))
257
258 (defmethod insert* ((chain standard-flexichain) position object)
259 (with-slots (element-type buffer gap-start) chain
260 (assert (<= 0 position (nb-elements chain)) ()
261 'flexi-position-error :chain chain :position position)
262 (assert (typep object element-type) ()
263 'flexi-incompatible-type-error :element object :chain chain)
264 (ensure-gap-position chain position)
265 (ensure-room chain (1+ (nb-elements chain)))
266 (setf (aref buffer gap-start) object)
267 (incf gap-start)
268 (when (= gap-start (length buffer))
269 (setf gap-start 0))))
270
271 (defmethod insert-vector* ((chain standard-flexichain) position vector)
272 (with-slots (element-type buffer gap-start) chain
273 (assert (<= 0 position (nb-elements chain)) ()
274 'flexi-position-error :chain chain :position position)
275 (assert (subtypep (array-element-type vector) element-type) ()
276 'flexi-incompatible-type-error :element vector :chain chain)
277 (ensure-gap-position chain position)
278 (ensure-room chain (+ (nb-elements chain) (length vector)))
279 (loop for elem across vector
280 do (setf (aref buffer gap-start) elem)
281 (incf gap-start)
282 (when (= gap-start (length buffer))
283 (setf gap-start 0)))))
284
285 (defmethod delete* ((chain standard-flexichain) position)
286 (with-slots (buffer expand-factor min-size fill-element gap-end) chain
287 (assert (< -1 position (nb-elements chain)) ()
288 'flexi-position-error :chain chain :position position)
289 (ensure-gap-position chain position)
290 (setf (aref buffer gap-end) fill-element)
291 (incf gap-end)
292 (when (= gap-end (length buffer))
293 (setf gap-end 0))
294 (when (and (> (length buffer) (+ min-size 2))
295 (< (+ (nb-elements chain) 2) (/ (length buffer) (square expand-factor))))
296 (decrease-buffer-size chain))))
297
298 (defmethod delete-elements* ((chain standard-flexichain) position n)
299 (unless (zerop n)
300 (with-slots (buffer expand-factor min-size gap-end data-start) chain
301 (when (minusp n)
302 (incf position n)
303 (setf n (* -1 n)))
304 (assert (<= 0 (+ position n) (nb-elements chain)) ()
305 'flexi-position-error :chain chain :position position)
306 (ensure-gap-position chain position)
307 ;; Two cases to consider - one where position+n is wholly on
308 ;; this side of the gap in buffer, and one where part of it is
309 ;; "wrapped around" to the beginning of buffer.
310 (cond ((>= (length buffer) (+ gap-end n))
311 (fill-gap chain gap-end (+ gap-end n))
312 (incf gap-end n))
313 (t (let ((surplus-elements (- n (- (length buffer) gap-end))))
314 (fill-gap chain gap-end (length buffer))
315 (fill-gap chain 0 surplus-elements)
316 (setf gap-end surplus-elements
317 data-start (1+ gap-end)))))
318 (when (= gap-end (length buffer))
319 (setf gap-end 0))
320 (when (and (> (length buffer) (+ min-size 2))
321 (< (+ (nb-elements chain) 2) (/ (length buffer) (square expand-factor))))
322 (decrease-buffer-size chain)))))
323
324 (defmethod element* ((chain standard-flexichain) position)
325 (with-slots (buffer) chain
326 (assert (< -1 position (nb-elements chain)) ()
327 'flexi-position-error :chain chain :position position)
328 (aref buffer (position-index chain position))))
329
330 (defmethod (setf element*) (object (chain standard-flexichain) position)
331 (with-slots (buffer element-type) chain
332 (assert (< -1 position (nb-elements chain)) ()
333 'flexi-position-error :chain chain :position position)
334 (assert (typep object element-type) ()
335 'flexi-incompatible-type-error :chain chain :element object)
336 (setf (aref buffer (position-index chain position)) object)))
337
338 (defmethod push-start ((chain standard-flexichain) object)
339 (insert* chain 0 object))
340
341 (defmethod push-end ((chain standard-flexichain) object)
342 (insert* chain (nb-elements chain) object))
343
344 (defmethod pop-start ((chain standard-flexichain))
345 (prog1
346 (element* chain 0)
347 (delete* chain 0)))
348
349 (defmethod pop-end ((chain standard-flexichain))
350 (let ((position (1- (nb-elements chain))))
351 (prog1
352 (element* chain position)
353 (delete* chain position))))
354
355 (defmethod rotate ((chain standard-flexichain) &optional (n 1))
356 (when (> (nb-elements chain) 1)
357 (cond ((plusp n) (loop repeat n do (push-start chain (pop-end chain))))
358 ((minusp n) (loop repeat (- n) do (push-end chain (pop-start chain))))
359 (t nil))))
360
361 (defun move-gap (chain hot-spot)
362 "Moves the elements and gap inside the buffer so that
363 the element currently at HOT-SPOT becomes the first element following
364 the gap, or does nothing if there are no elements."
365 (with-slots (gap-start gap-end) chain
366 (unless (= hot-spot gap-end)
367 (case (gap-location chain)
368 (:gap-empty (move-empty-gap chain hot-spot))
369 (:gap-left (move-left-gap chain hot-spot))
370 (:gap-right (move-right-gap chain hot-spot))
371 (:gap-middle (move-middle-gap chain hot-spot))
372 (:gap-non-contiguous (move-non-contiguous-gap chain hot-spot))))
373 (values gap-start gap-end)))
374
375 (defun move-empty-gap (chain hot-spot)
376 "Moves the gap. Handles the case where the gap is empty."
377 (with-slots (gap-start gap-end) chain
378 (setf gap-start hot-spot
379 gap-end hot-spot)))
380
381 (defun move-left-gap (chain hot-spot)
382 "Moves the gap. Handles the case where the gap is
383 on the left of the buffer."
384 (with-slots (buffer gap-start gap-end data-start) chain
385 (let ((buffer-size (length buffer)))
386 (cond ((< (- hot-spot gap-end) (- buffer-size hot-spot))
387 (push-elements-left chain (- hot-spot gap-end)))
388 ((<= (- buffer-size hot-spot) gap-end)
389 (hop-elements-left chain (- buffer-size hot-spot)))
390 (t
391 (hop-elements-left chain (- gap-end gap-start))
392 (push-elements-right chain (- gap-start hot-spot)))))))
393
394 (defun move-right-gap (chain hot-spot)
395 "Moves the gap. Handles the case where the gap is
396 on the right of the buffer."
397 (with-slots (buffer gap-start gap-end) chain
398 (let ((buffer-size (length buffer)))
399 (cond ((< (- gap-start hot-spot) hot-spot)
400 (push-elements-right chain (- gap-start hot-spot)))
401 ((<= hot-spot (- buffer-size gap-start))
402 (hop-elements-right chain hot-spot))
403 (t
404 (hop-elements-right chain (- buffer-size gap-start))
405 (push-elements-left chain (- hot-spot gap-end)))))))
406
407 (defun move-middle-gap (chain hot-spot)
408 "Moves the gap. Handles the case where the gap is
409 in the middle of the buffer."
410 (with-slots (buffer gap-start gap-end) chain
411 (let ((buffer-size (length buffer)))
412 (cond ((< hot-spot gap-start)
413 (cond ((<= (- gap-start hot-spot)
414 (+ (- buffer-size gap-end) hot-spot))
415 (push-elements-right chain (- gap-start hot-spot)))
416 (t
417 (push-elements-left chain (- buffer-size gap-end))
418 (move-right-gap chain hot-spot))))
419 (t
420 (cond ((< (- hot-spot gap-end)
421 (+ (- buffer-size hot-spot) gap-start))
422 (push-elements-left chain (- hot-spot gap-end)))
423 (t
424 (push-elements-right chain gap-start)
425 (move-left-gap chain hot-spot))))))))
426
427 (defun move-non-contiguous-gap (chain hot-spot)
428 "Moves the gap. Handles the case where the gap is in 2 parts,
429 on both ends of the buffer."
430 (with-slots (buffer gap-start gap-end) chain
431 (let ((buffer-size (length buffer)))
432 (cond ((< (- hot-spot gap-end) (- gap-start hot-spot))
433 (hop-elements-right chain (min (- buffer-size gap-start)
434 (- hot-spot gap-end)))
435 (let ((nb-left (- hot-spot gap-end)))
436 (unless (zerop nb-left)
437 (push-elements-left chain nb-left))))
438 (t
439 (hop-elements-left chain (min gap-end (- gap-start hot-spot)))
440 (let ((nb-right (- gap-start hot-spot)))
441 (unless (zerop nb-right)
442 (push-elements-right chain nb-right))))))))
443
444 (defgeneric move-elements (standard-flexichain to from start1 start2 end2)
445 (:documentation "move elements of a flexichain and adjust data-start"))
446
447 (defmethod move-elements ((fc standard-flexichain) to from start1 start2 end2)
448 (replace to from :start1 start1 :start2 start2 :end2 end2)
449 (with-slots (data-start) fc
450 (when (and (<= start2 data-start) (< data-start end2))
451 (incf data-start (- start1 start2)))))
452
453 (defgeneric fill-gap (standard-flexichain start end)
454 (:documentation "fill part of gap with the fill element"))
455
456 (defmethod fill-gap ((fc standard-flexichain) start end)
457 (with-slots (buffer fill-element) fc
458 (fill buffer fill-element :start start :end end)))
459
460 (defun push-elements-left (chain count)
461 "Pushes the COUNT elements of CHAIN at the right of the gap,
462 to the beginning of the gap. The gap must be continuous. Example:
463 PUSH-ELEMENTS-LEFT abcd-----efghijklm 2 => abcdef-----ghijklm"
464 (with-slots (buffer gap-start gap-end) chain
465 (move-elements chain buffer buffer gap-start gap-end (+ gap-end count))
466 (fill-gap chain (max gap-end (+ gap-start count)) (+ gap-end count))
467 (incf gap-start count)
468 (incf gap-end count)
469 (normalize-indices chain)))
470
471 (defun push-elements-right (chain count)
472 "Pushes the COUNT elements of CHAIN at the left of the gap,
473 to the end of the gap. The gap must be continuous. Example:
474 PUSH-ELEMENTS-RIGHT abcd-----efghijklm 2 => ab-----cdefghijklm"
475 (with-slots (buffer gap-start gap-end) chain
476 (let* ((buffer-size (length buffer))
477 (rotated-gap-end (if (zerop gap-end) buffer-size gap-end)))
478 (move-elements chain buffer buffer
479 (- rotated-gap-end count) (- gap-start count) gap-start)
480 (fill-gap chain (- gap-start count) (min gap-start (- rotated-gap-end count)))
481 (decf gap-start count)
482 (setf gap-end (- rotated-gap-end count))
483 (normalize-indices chain))))
484
485 (defun hop-elements-left (chain count)
486 "Moves the COUNT rightmost elements to the end of the gap,
487 on the left of the data. Example:
488 HOP-ELEMENTS-LEFT ---abcdefghijklm--- 2 => -lmabcdefghijk-----"
489 (with-slots (buffer gap-start gap-end) chain
490 (let* ((buffer-size (length buffer))
491 (rotated-gap-start (if (zerop gap-start) buffer-size gap-start)))
492 (move-elements chain buffer buffer
493 (- gap-end count) (- rotated-gap-start count) rotated-gap-start)
494 (fill-gap chain (- rotated-gap-start count) rotated-gap-start)
495 (setf gap-start (- rotated-gap-start count))
496 (decf gap-end count)
497 (normalize-indices chain))))
498
499 (defun hop-elements-right (chain count)
500 "Moves the COUNT leftmost elements to the beginning of the gap,
501 on the right of the data. Example:
502 HOP-ELEMENTS-RIGHT ---abcdefghijklm--- 2 => -----cdefghijklmab-"
503 (with-slots (buffer gap-start gap-end) chain
504 (move-elements chain buffer buffer gap-start gap-end (+ gap-end count))
505 (fill-gap chain gap-end (+ gap-end count))
506 (incf gap-start count)
507 (incf gap-end count)
508 (normalize-indices chain)))
509
510 (defun increase-buffer-size (chain nb-elements)
511 (resize-buffer chain (required-space chain nb-elements)))
512
513 (defun decrease-buffer-size (chain)
514 (resize-buffer chain (required-space chain (nb-elements chain))))
515
516 (defgeneric resize-buffer (standard-flexichain new-buffer-size)
517 (:documentation "allocate a new buffer with the size indicated"))
518
519 (defmethod resize-buffer ((fc standard-flexichain) new-buffer-size)
520 (with-slots (buffer gap-start gap-end
521 fill-element element-type expand-factor) fc
522 (let ((buffer-size (length buffer))
523 (buffer-after (make-array new-buffer-size
524 :element-type element-type
525 :initial-element fill-element)))
526 (case (gap-location fc)
527 ((:gap-empty :gap-middle)
528 (move-elements fc buffer-after buffer 0 0 gap-start)
529 (let ((gap-end-after (- new-buffer-size (- buffer-size gap-end))))
530 (move-elements fc buffer-after buffer gap-end-after gap-end buffer-size)
531 (setf gap-end gap-end-after)))
532 (:gap-right
533 (move-elements fc buffer-after buffer 0 0 gap-start))
534 (:gap-left
535 (let ((gap-end-after (- new-buffer-size (+ 2 (nb-elements fc)))))
536 (move-elements fc buffer-after buffer gap-end-after gap-end buffer-size)
537 (setf gap-end gap-end-after)))
538 (:gap-non-contiguous
539 (move-elements fc buffer-after buffer 0 gap-end gap-start)
540 (decf gap-start gap-end)
541 (setf gap-end 0)))
542 (setf buffer buffer-after)))
543 (normalize-indices fc))
544
545 (defun normalize-indices (chain)
546 "Sets gap limits to 0 if they are at the end of the buffer."
547 (with-slots (buffer gap-start gap-end data-start) chain
548 (let ((buffer-size (length buffer)))
549 (when (>= data-start buffer-size)
550 (setf data-start 0))
551 (when (>= gap-start buffer-size)
552 (setf gap-start 0))
553 (when (>= gap-end buffer-size)
554 (setf gap-end 0)))))
555
556 (defun gap-location (chain)
557 "Returns a keyword indicating the general location of the gap."
558 (with-slots (buffer gap-start gap-end) chain
559 (cond ((= gap-start gap-end) :gap-empty)
560 ((and (zerop gap-start) (>= gap-end 0)) :gap-left)
561 ((and (zerop gap-end) (> gap-start 0)) :gap-right)
562 ((> gap-end gap-start) :gap-middle)
563 (t :gap-non-contiguous))))
564

  ViewVC Help
Powered by ViewVC 1.1.5