- (flet ((offer (buf start end)
-
- ;; Pass the buffer to the function, and see what it thought.
- (multiple-value-bind (donep used) (funcall func buf start end)
-
- ;; Update the position as far as the function read.
- (with-slots (line column) scanner
- (let ((l line) (c column) (limit (if donep used end)))
- (do ((i start (1+ i)))
- ((>= i limit))
- (setf (values l c)
- (update-position (char buf i) l c)))
- (setf line l column c)))
-
- ;; If the function is finished then update our state and
- ;; return.
- (when donep
- (setf index used)
- (when (>= index size)
- (charbuf-scanner-fetch scanner))
- (return-from charbuf-scanner-map (values donep t))))))
-
- ;; If there's anything in the current buffer, offer it to the function.
- (when (< index size)
- (offer buf index size))
-
- ;; Repeatedly fetch new buffers and offer them to the function.
- ;; Because the buffers are fresh, we know that we must process them
- ;; from the beginning. Note that `offer' will exit if FUNC has
- ;; finished, so we don't need to worry about that.
- (loop
- (unless (charbuf-scanner-fetch scanner)
- (return (if fail (funcall fail) (values nil nil))))
- (offer buf 0 size)))))
+ (let ((consumedp nil))
+ (flet ((offer (buf start end)
+
+ ;; Pass the buffer to the function, and see what it thought.
+ (multiple-value-bind (donep used) (funcall func buf start end)
+
+ ;; Update the position as far as the function read.
+ (with-slots (line column) scanner
+ (let ((l line) (c column) (limit (if donep used end)))
+ (do ((i start (1+ i)))
+ ((>= i limit))
+ (setf (values l c)
+ (update-position (char buf i) l c)))
+ (setf line l column c)))
+
+ ;; If the function is finished then update our state and
+ ;; return.
+ (when donep
+ (setf index used)
+ (when (>= index size)
+ (charbuf-scanner-fetch scanner))
+ (return-from charbuf-scanner-map
+ (values donep t (or consumedp (> used start)))))
+
+ ;; We've definitely used that buffer.
+ (setf consumedp t))))
+
+ ;; If there's anything in the current buffer, offer it to the
+ ;; function.
+ (when (< index size)
+ (offer buf index size))
+
+ ;; Repeatedly fetch new buffers and offer them to the function.
+ ;; Because the buffers are fresh, we know that we must process them
+ ;; from the beginning. Note that `offer' will exit if FUNC has
+ ;; finished, so we don't need to worry about that.
+ (loop
+ (unless (charbuf-scanner-fetch scanner)
+ (return (if fail
+ (multiple-value-bind (result win) (funcall fail)
+ (values result win consumedp))
+ (values nil nil consumedp))))
+ (offer buf 0 size))))))