Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv5683
Modified Files: base.lisp base-test.lisp buffer-test.lisp Log Message: Changes in open-line and number-of-lines-in-region, and more tests.
Date: Mon Jan 24 15:53:53 2005 Author: abakic
Index: climacs/base.lisp diff -u climacs/base.lisp:1.24 climacs/base.lisp:1.25 --- climacs/base.lisp:1.24 Thu Jan 20 15:37:38 2005 +++ climacs/base.lisp Mon Jan 24 15:53:52 2005 @@ -75,8 +75,12 @@ (beginning-of-line mark) (incf (offset mark) column)))))
-(defun open-line (mark) - "Create a new line in a buffer." +(defmethod open-line ((mark left-sticky-mark)) + "Create a new line in a buffer after the mark." + (insert-object mark #\Newline)) + +(defmethod open-line ((mark right-sticky-mark)) + "Create a new line in a buffer after the mark." (insert-object mark #\Newline) (decf (offset mark)))
@@ -132,13 +136,23 @@
(defmethod number-of-lines-in-region ((mark1 mark) (mark2 mark)) (assert (eq (buffer mark1) (buffer mark2))) - (buffer-number-of-lines-in-region (buffer mark1) (offset mark1) (offset mark2))) - -(defmethod number-of-lines-in-region ((offset integer) (mark mark)) - (buffer-number-of-lines-in-region (buffer mark) offset (offset mark))) - -(defmethod number-of-lines-in-region ((mark mark) (offset integer)) - (buffer-number-of-lines-in-region (buffer mark) (offset mark) offset)) + (let ((offset1 (offset mark1)) + (offset2 (offset mark2))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (buffer-number-of-lines-in-region (buffer mark1) offset1 offset2))) + +(defmethod number-of-lines-in-region ((offset1 integer) (mark2 mark)) + (let ((offset2 (offset mark2))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (buffer-number-of-lines-in-region (buffer mark2) offset1 offset2))) + +(defmethod number-of-lines-in-region ((mark1 mark) (offset2 integer)) + (let ((offset1 (offset mark1))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (buffer-number-of-lines-in-region (buffer mark1) offset1 offset2)))
(defun constituentp (obj) "A predicate to ensure that an object is a constituent character." @@ -153,7 +167,7 @@ #-sbcl (member obj '(#\Space #\Tab))))
(defun forward-to-word-boundary (mark) - "Forward the mark forward to the beginning of the next word." + "Move the mark forward to the beginning of the next word." (loop until (end-of-buffer-p mark) until (constituentp (object-after mark)) do (incf (offset mark))))
Index: climacs/base-test.lisp diff -u climacs/base-test.lisp:1.1 climacs/base-test.lisp:1.2 --- climacs/base-test.lisp:1.1 Thu Jan 20 15:21:53 2005 +++ climacs/base-test.lisp Mon Jan 24 15:53:52 2005 @@ -143,4 +143,482 @@ :buffer buffer :offset 0))) (next-line mark) (offset mark))) - 8) \ No newline at end of file + 8) + +(deftest standard-buffer-open-line.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((mark (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0))) + (open-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + " +climacs" 0) + +(deftest standard-buffer-open-line.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((mark (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0))) + (open-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + " +climacs" 0) + +(deftest standard-buffer-open-line.test-3 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((mark (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 7))) + (open-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + "climacs +" 7) + +(deftest standard-buffer-open-line.test-4 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((mark (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 7))) + (open-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + "climacs +" 7) + +(deftest standard-buffer-kill-line.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((mark (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0))) + (kill-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + #() 0) + +(deftest standard-buffer-kill-line.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((mark (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0))) + (kill-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + #() 0) + +(deftest standard-buffer-kill-line.test-3 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((mark (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 7))) + (kill-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + "climacs" 7) + +(deftest standard-buffer-kill-line.test-4 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((mark (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 7))) + (kill-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + "climacs" 7) + +(deftest standard-buffer-kill-line.test-5 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs +climacs") + (let ((mark (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 7))) + (kill-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + "climacsclimacs" 7) + +(deftest standard-buffer-kill-line.test-6 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs +climacs") + (let ((mark (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 7))) + (kill-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + "climacsclimacs" 7) + +(deftest standard-buffer-empty-line-p.test-1 + (let* ((buffer (make-instance 'standard-buffer)) + (m1 (make-instance 'standard-left-sticky-mark :buffer buffer)) + (m2 (make-instance 'standard-right-sticky-mark :buffer buffer))) + (values (empty-line-p m1) (empty-line-p m2))) + t t) + +(deftest standard-buffer-empty-line-p.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-object buffer 0 #\a) + (let ((m1 (make-instance 'standard-left-sticky-mark :buffer buffer)) + (m2 (make-instance 'standard-right-sticky-mark :buffer buffer))) + (values (empty-line-p m1) (empty-line-p m2)))) + nil nil) + +(deftest standard-buffer-empty-line-p.test-3 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-object buffer 0 #\a) + (let ((m1 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 1)) + (m2 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 1))) + (values (empty-line-p m1) (empty-line-p m2)))) + nil nil) + +(deftest standard-buffer-empty-line-p.test-4 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "a +b") + (let ((m1 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 1)) + (m2 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 1))) + (values (empty-line-p m1) (empty-line-p m2)))) + nil nil) + +(deftest standard-buffer-line-indentation.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " climacs") + (let ((m1 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0)) + (m2 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0)) + (m3 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 10)) + (m4 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 10))) + (values + (line-indentation m1 8) + (line-indentation m2 8) + (line-indentation m3 8) + (line-indentation m4 8) + (offset m1) + (offset m2) + (offset m3) + (offset m4)))) + 10 10 10 10 0 0 10 10) + +(deftest standard-buffer-line-indentation.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " climacs") + (let ((m1 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0)) + (m2 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0)) + (m3 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 11)) + (m4 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 11))) + (values + (line-indentation m1 8) + (line-indentation m2 8) + (line-indentation m3 8) + (line-indentation m4 8) + (offset m1) + (offset m2) + (offset m3) + (offset m4)))) + 18 18 18 18 0 0 11 11) + +(deftest standard-buffer-line-indentation.test-3 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " climacs ") + (let ((m1 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0)) + (m2 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0)) + (m3 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 11)) + (m4 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 11))) + (values + (line-indentation m1 8) + (line-indentation m2 8) + (line-indentation m3 8) + (line-indentation m4 8) + (offset m1) + (offset m2) + (offset m3) + (offset m4)))) + 10 10 10 10 0 0 11 11) + +(deftest standard-buffer-buffer-number-of-lines-in-region.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs +climacs") + (values + (climacs-base::buffer-number-of-lines-in-region buffer 0 6) + (climacs-base::buffer-number-of-lines-in-region buffer 0 7) + (climacs-base::buffer-number-of-lines-in-region buffer 0 10) + (climacs-base::buffer-number-of-lines-in-region buffer 0 13) + (climacs-base::buffer-number-of-lines-in-region buffer 0 14) + (climacs-base::buffer-number-of-lines-in-region buffer 7 10) + (climacs-base::buffer-number-of-lines-in-region buffer 8 13) + (climacs-base::buffer-number-of-lines-in-region buffer 8 14))) + 0 0 1 1 1 1 0 0) + +(deftest standard-buffer-buffer-display-column.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " cli macs") + (values + (buffer-display-column buffer 0 8) + (buffer-display-column buffer 1 8) + (buffer-display-column buffer 2 8) + (buffer-display-column buffer 5 8) + (buffer-display-column buffer 6 8))) + 0 8 16 19 24) + +(deftest standard-buffer-number-of-lines-in-region.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " +climacs +climacs +") + (let ((m1l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0)) + (m1r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0)) + (m2l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 1)) + (m2r (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 1)) + (m3l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 3)) + (m3r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 3)) + (m4l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 8)) + (m4r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 8)) + (m5l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 15)) + (m5r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 15)) + (m6l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 16)) + (m6r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 16))) + (values + (number-of-lines-in-region m1l m1r) + (number-of-lines-in-region m1r m1l) + (number-of-lines-in-region m1l m2l) + (number-of-lines-in-region m2r m1r) + (number-of-lines-in-region m1l m2r) + (number-of-lines-in-region m2r m1l) + (number-of-lines-in-region m1r m2l) + (number-of-lines-in-region m1l m3l) + (number-of-lines-in-region m1r m3r) + (number-of-lines-in-region m4r m1l) + (number-of-lines-in-region m4l m1r) + (number-of-lines-in-region m3l m5l) + (number-of-lines-in-region m5r m4r) + (number-of-lines-in-region m5l m6l) + (number-of-lines-in-region m6r m5r) + (number-of-lines-in-region m6l m6r) + (number-of-lines-in-region m1l m6r) + (number-of-lines-in-region m3r m6l)))) + 0 0 1 1 1 1 1 1 1 1 1 1 1 0 0 0 2 1) + +(deftest standard-buffer-number-of-lines-in-region.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs +climacs") + (let ((m1l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 6)) + (m1r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 6)) + (m2l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 7)) + (m2r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 7))) + (values + (number-of-lines-in-region m1l 10) + (number-of-lines-in-region 10 m1l) + (number-of-lines-in-region m1r 10) + (number-of-lines-in-region 10 m1r) + (number-of-lines-in-region m1l 3) + (number-of-lines-in-region 3 m2l) + (number-of-lines-in-region 3 m2r) + (number-of-lines-in-region m2l 10) + (number-of-lines-in-region 10 m2r)))) + 1 1 1 1 0 0 0 1 1) + +(deftest constituentp.test-1 ; NOTE: more tests may be needed for sbcl + (values + (constituentp #\a) + (constituentp #\Newline) + (constituentp #\Space) + (constituentp #\Tab) + (constituentp "a") + (constituentp #\Null)) + t nil nil nil nil nil) + +(deftest whitespacep.test-1 + (values + (not (null (whitespacep #\a))) + (not (null (whitespacep #\Newline))) + (not (null (whitespacep #\Space))) + (not (null (whitespacep #\Tab))) + (not (null (whitespacep " "))) + (not (null (whitespacep #\Null)))) + nil nil t t nil nil) + +(deftest standard-buffer-forward-to-word-boundary.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " climacs +climacs") + (let ((m0l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0)) + (m0r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0)) + (m1l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 5)) + (m1r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 5)) + (m2l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 17)) + (m2r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 17))) + (values + (progn (climacs-base::forward-to-word-boundary m0l) (offset m0l)) + (progn (climacs-base::forward-to-word-boundary m0r) (offset m0r)) + (progn (climacs-base::forward-to-word-boundary m1l) (offset m1l)) + (progn (climacs-base::forward-to-word-boundary m1r) (offset m1r)) + (progn (climacs-base::forward-to-word-boundary m2l) (offset m2l)) + (progn (climacs-base::forward-to-word-boundary m2r) (offset m2r))))) + 2 2 5 5 17 17) + +(deftest standard-buffer-backward-to-word-boundary.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs +climacs ") + (let ((m0l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 17)) + (m0r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 17)) + (m1l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 10)) + (m1r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 10)) + (m2l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0)) + (m2r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0))) + (values + (progn (climacs-base::backward-to-word-boundary m0l) (offset m0l)) + (progn (climacs-base::backward-to-word-boundary m0r) (offset m0r)) + (progn (climacs-base::backward-to-word-boundary m1l) (offset m1l)) + (progn (climacs-base::backward-to-word-boundary m1r) (offset m1r)) + (progn (climacs-base::backward-to-word-boundary m2l) (offset m2l)) + (progn (climacs-base::backward-to-word-boundary m2r) (offset m2r))))) + 15 15 10 10 0 0) + +(deftest standard-buffer-forward-word.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " climacs +climacs") + (let ((m0l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0)) + (m0r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0)) + (m1l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 5)) + (m1r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 15)) + (m2l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 17)) + (m2r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 17))) + (values + (progn (forward-word m0l) (offset m0l)) + (progn (forward-word m0r) (offset m0r)) + (progn (forward-word m1l) (offset m1l)) + (progn (forward-word m1r) (offset m1r)) + (progn (forward-word m2l) (offset m2l)) + (progn (forward-word m2r) (offset m2r))))) + 9 9 9 17 17 17) + +(deftest standard-buffer-backward-word.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs +climacs ") + (let ((m0l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 17)) + (m0r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 17)) + (m1l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 10)) + (m1r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 5)) + (m2l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0)) + (m2r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0))) + (values + (progn (backward-word m0l) (offset m0l)) + (progn (backward-word m0r) (offset m0r)) + (progn (backward-word m1l) (offset m1l)) + (progn (backward-word m1r) (offset m1r)) + (progn (backward-word m2l) (offset m2l)) + (progn (backward-word m2r) (offset m2r))))) + 8 8 8 0 0 0) + +(deftest standard-buffer-delete-word.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((m (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 3))) + (delete-word m) + (values + (buffer-sequence buffer 0 (size buffer)) + (offset m)))) + "cli" 3) + +(deftest standard-buffer-delete-word.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " climacs") + (let ((m (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0))) + (delete-word m) + (values + (buffer-sequence buffer 0 (size buffer)) + (offset m)))) + #() 0) + +(deftest standard-buffer-backward-delete-word.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((m (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 3))) + (backward-delete-word m) + (values + (buffer-sequence buffer 0 (size buffer)) + (offset m)))) + "macs" 0) + +(deftest standard-buffer-backward-delete-word.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs ") + (let ((m (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 9))) + (backward-delete-word m) + (values + (buffer-sequence buffer 0 (size buffer)) + (offset m)))) + #() 0) + +(deftest standard-buffer-previous-word.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs climacs") + (let ((m0 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 7)) + (m1 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 8)) + (m2 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 10))) + (values + (climacs-base::previous-word m0) + (climacs-base::previous-word m1) + (climacs-base::previous-word m2)))) + "climacs" #() "cl") \ No newline at end of file
Index: climacs/buffer-test.lisp diff -u climacs/buffer-test.lisp:1.8 climacs/buffer-test.lisp:1.9 --- climacs/buffer-test.lisp:1.8 Thu Jan 20 15:21:52 2005 +++ climacs/buffer-test.lisp Mon Jan 24 15:53:52 2005 @@ -526,6 +526,23 @@ (= 0 (line-number m1) (1- (line-number m2))))) t)
+(deftest standard-buffer-buffer-column-number.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " climacs") + (values + (buffer-object buffer 2) + (buffer-column-number buffer 2))) + #\c 2) + +(deftest standard-buffer-buffer-column-number.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " + climacs") + (values + (buffer-object buffer 3) + (buffer-column-number buffer 3))) + #\c 2) + (deftest standard-buffer-column-number.test-1 (let ((buffer (make-instance 'standard-buffer))) (insert-buffer-sequence buffer 0 "climacs