Commit ab8660dd authored by Aleksandar Bakic's avatar Aleksandar Bakic

Improvements and fixes to fill-line and buffer-search-word* functions,

and the remaining base tests.
parent bc248a9a
......@@ -953,13 +953,228 @@ climacs ")
(defmultitest fill-line.test-1
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs climacs climacs")
(insert-buffer-sequence buffer 0 "climacs climacs climacs climacs")
(let ((m (make-instance %%right-sticky-mark
:buffer buffer :offset 25)))
(fill-line m #'(lambda (m) (declare (ignore m)) 8) 10 8)
(values
(offset m)
(buffer-sequence buffer 0 (size buffer)))))
25 "climacs
climacs
climacs climacs")
(defmultitest fill-line.test-1a
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs climacs climacs climacs")
(let ((m (make-instance %%right-sticky-mark
:buffer buffer :offset 25)))
(fill-line m #'(lambda (m) (declare (ignore m)) 8) 10 8 nil)
(values
(offset m)
(buffer-sequence buffer 0 (size buffer)))))
27 "climacs
climacs
climacs")
climacs climacs")
(defmultitest fill-line.test-2
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs climacs climacs climacs")
(let ((m (make-instance %%left-sticky-mark
:buffer buffer :offset 25)))
(fill-line m #'(lambda (m) (declare (ignore m)) 8) 10 8)
(values
(offset m)
(buffer-sequence buffer 0 (size buffer)))))
27 "climacs
climacs
climacs climacs")
(defmultitest fill-line.test-2a
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs climacs climacs climacs")
(let ((m (make-instance %%left-sticky-mark
:buffer buffer :offset 25)))
(fill-line m #'(lambda (m) (declare (ignore m)) 8) 10 8 nil)
(values
(offset m)
(buffer-sequence buffer 0 (size buffer)))))
27 "climacs
climacs
climacs climacs")
(defmultitest fill-line.test-3
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "c l i m a c s")
(let ((m (make-instance %%right-sticky-mark
:buffer buffer :offset 1)))
(fill-line m #'(lambda (m) (declare (ignore m)) 8) 0 8)
(values
(offset m)
(buffer-sequence buffer 0 (size buffer)))))
1 "c l i m a c s")
(defmultitest fill-line.test-3a
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "c l i m a c s")
(let ((m (make-instance %%right-sticky-mark
:buffer buffer :offset 1)))
(fill-line m #'(lambda (m) (declare (ignore m)) 8) 0 8 nil)
(values
(offset m)
(buffer-sequence buffer 0 (size buffer)))))
1 "c l i m a c s")
(defmultitest buffer-looking-at.test-1
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs ")
(values
(buffer-looking-at buffer 0 "climacs")
(buffer-looking-at buffer 0 "CLIMACS" :test #'char-equal)
(buffer-looking-at buffer 0 "")
(buffer-looking-at buffer 8 "")
(buffer-looking-at buffer 9 "")
(buffer-looking-at buffer 10 "")))
t t t t nil nil)
(defmultitest buffer-looking-at.test-2
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 " climacs")
(buffer-looking-at buffer 0 "climacs"))
nil)
(defmultitest buffer-looking-at.test-3
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climac")
(buffer-looking-at buffer 0 "climacs"))
nil)
(defmultitest looking-at.test-1
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs")
(let ((m1 (make-instance %%left-sticky-mark
:buffer buffer :offset 1))
(m2 (make-instance %%right-sticky-mark
:buffer buffer :offset 3)))
(values
(looking-at m1 "lima")
(looking-at m2 "mac")
(looking-at m1 "lIMa" :test #'char-equal)
(looking-at m2 "Mac" :test #'char-equal)
(looking-at m1 "climacs")
(looking-at m2 "climacs")
(looking-at m1 "")
(looking-at m2 "")
(offset m1)
(offset m2))))
t t t t nil nil t t 1 3)
(defmultitest buffer-search-forward.test-1
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "
climacs")
(values
(buffer-search-forward buffer 0 "clim")
(buffer-search-forward buffer 0 "CLIM" :test #'char-equal)
(buffer-search-forward buffer 0 "macs")
(buffer-search-forward buffer 0 "")
(buffer-search-forward buffer 2 "clim")
(buffer-search-forward buffer 8 "")
(buffer-search-forward buffer 9 "")
(buffer-search-forward buffer 10 "")))
1 1 4 0 nil 8 nil nil)
(defmultitest buffer-search-backward.test-1
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs
")
(values
(buffer-search-backward buffer 8 "macs")
(buffer-search-backward buffer 8 "MACS" :test #'char-equal)
(buffer-search-backward buffer 4 "clim")
(buffer-search-backward buffer 8 "")
(buffer-search-backward buffer 6 "macs")
(buffer-search-backward buffer -1 "")
(buffer-search-backward buffer 0 "")
(buffer-search-backward buffer 1 "")))
3 3 0 8 nil nil 0 1)
(defmultitest search-forward.test-1
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "
climacs")
(let ((m (make-instance %%left-sticky-mark
:buffer buffer :offset 0)))
(search-forward m "Mac" :test #'char-equal)
(offset m)))
7)
(defmultitest search-forward.test-2
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs")
(let ((m (make-instance %%right-sticky-mark
:buffer buffer :offset 3)))
(search-forward m "Mac" :test #'char-equal)
(offset m)))
6)
(defmultitest search-forward.test-3
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs")
(let ((m (make-instance %%right-sticky-mark
:buffer buffer :offset 3)))
(search-forward m "klimaks")
(offset m)))
3)
(defmultitest search-backward.test-1
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs
")
(let ((m (make-instance %%left-sticky-mark
:buffer buffer :offset 8)))
(search-backward m "Mac" :test #'char-equal)
(offset m)))
3)
(defmultitest search-backward.test-2
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs")
(let ((m (make-instance %%right-sticky-mark
:buffer buffer :offset 6)))
(search-backward m "Mac" :test #'char-equal)
(offset m)))
3)
(defmultitest search-backward.test-3
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs")
(let ((m (make-instance %%right-sticky-mark
:buffer buffer :offset 3)))
(search-backward m "klimaks")
(offset m)))
3)
(defmultitest buffer-search-word-forward.test-1
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "
climacs")
(values
(climacs-base::buffer-search-word-forward buffer 0 "climacs")
(climacs-base::buffer-search-word-forward buffer 3 "climacs")
(climacs-base::buffer-search-word-forward buffer 0 "clim")
(climacs-base::buffer-search-word-forward buffer 5 "macs")
(climacs-base::buffer-search-word-forward buffer 0 "")))
2 nil nil nil 0)
(defmultitest buffer-search-word-backward.test-1
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs
")
(values
(climacs-base::buffer-search-word-backward buffer 8 "climacs")
(climacs-base::buffer-search-word-backward buffer 5 "climacs")
(climacs-base::buffer-search-word-backward buffer 4 "clim")
(climacs-base::buffer-search-word-backward buffer 8 "macs")
(climacs-base::buffer-search-word-backward buffer 8 "")))
0 nil nil nil 8)
......@@ -490,7 +490,13 @@ spaces only."))
;;;
;;; Auto fill
(defun fill-line (mark syntax-line-indentation-function fill-column tab-width)
(defun fill-line (mark syntax-line-indentation-function fill-column tab-width
&optional (compress-whitespaces t))
"Breaks the contents of line pointed to by MARK up to MARK into
multiple lines such that none of them is longer than FILL-COLUMN. If
COMPRESS-WHITESPACES is non-nil, whitespaces are compressed after the
decision is made to break the line at a point. For now, the
compression means just the deletion of trailing whitespaces."
(let ((begin-mark (clone-mark mark)))
(beginning-of-line begin-mark)
(loop with column = 0
......@@ -509,6 +515,16 @@ spaces only."))
(incf column)))
(when (and (>= column fill-column)
(/= (offset begin-mark) line-beginning-offset))
(when compress-whitespaces
(let ((offset (buffer-search-backward
(buffer begin-mark)
(offset begin-mark)
#(nil)
:test #'(lambda (o1 o2)
(declare (ignore o2))
(not (whitespacep o1))))))
(when offset
(delete-region begin-mark (1+ offset)))))
(insert-object begin-mark #\Newline)
(incf (offset begin-mark))
(let ((indentation
......@@ -546,7 +562,6 @@ spaces only."))
"return true if and only if BUFFER contains VECTOR after MARK"
(buffer-looking-at (buffer mark) (offset mark) vector :test test))
(defun buffer-search-forward (buffer offset vector &key (test #'eql))
"return the smallest offset of BUFFER >= OFFSET containing VECTOR
or NIL if no such offset exists"
......@@ -554,7 +569,6 @@ or NIL if no such offset exists"
when (buffer-looking-at buffer i vector :test test)
return i
finally (return nil)))
(defun buffer-search-backward (buffer offset vector &key (test #'eql))
"return the largest offset of BUFFER <= (- OFFSET (length VECTOR))
......@@ -581,17 +595,29 @@ containing VECTOR or NIL if no such offset exists"
(defun buffer-search-word-backward (buffer offset word &key (test #'eql))
"return the largest offset of BUFFER <= (- OFFSET (length WORD))
containing WORD as a word or NIL if no such offset exists"
(loop for i downfrom (- offset (length word)) to 0
when (and (or (zerop i) (whitespacep (buffer-object buffer (1- i))))
(buffer-looking-at buffer i word :test test))
return i
finally (return nil)))
(let ((wlen (length word))
(blen (size buffer)))
(loop
for i downfrom (- offset wlen) to 0
for j = (+ i wlen)
when (and (or (zerop i) (whitespacep (buffer-object buffer (1- i))))
(buffer-looking-at buffer i word :test test)
(not (and (< (+ i wlen) blen)
(constituentp (buffer-object buffer (+ i wlen))))))
return i
finally (return nil))))
(defun buffer-search-word-forward (buffer offset word &key (test #'eql))
"Return the smallest offset of BUFFER >= (+ OFFSET (length WORD))
containing WORD as a word or NIL if no such offset exists"
(loop for i upfrom (+ offset (length word)) to (- (size buffer) (max (length word) 1))
when (and (whitespacep (buffer-object buffer (1- i)))
(buffer-looking-at buffer i word :test test))
return i
finally (return nil)))
"Return the smallest offset of BUFFER >= OFFSET containing WORD as a
word or NIL if no such offset exists"
(let ((wlen (length word))
(blen (size buffer)))
(loop
for i upfrom offset to (- blen (max wlen 1))
for j = (+ i wlen)
when (and (or (zerop i) (whitespacep (buffer-object buffer (1- i))))
(buffer-looking-at buffer i word :test test)
(not (and (< j blen)
(constituentp (buffer-object buffer j)))))
return i
finally (return nil))))
......@@ -70,7 +70,7 @@
#:fill-line
#:input-from-stream #:output-to-stream
#:name-mixin #:name
#:buffer-lookin-at #:looking-at
#:buffer-looking-at #:looking-at
#:buffer-search-forward #:buffer-search-backward
#:search-forward #:search-backward))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment