- climacs-cvs@common-lisp.net - mailman3.common-lisp.net

[climacs-cvs] CVS update: climacs/base-test.lisp climacs/base.lisp
by abakic＠common-lisp.net 06 Feb '05

06 Feb '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv31702 Modified Files: base-test.lisp base.lisp Log Message: Changes to indent-line, copyrights. Tests for indent-line. Date: Sun Feb 6 17:33:50 2005 Author: abakic Index: climacs/base-test.lisp diff -u climacs/base-test.lisp:1.5 climacs/base-test.lisp:1.6 --- climacs/base-test.lisp:1.5 Sun Feb 6 01:03:26 2005 +++ climacs/base-test.lisp Sun Feb 6 17:33:50 2005 @@ -869,6 +869,15 @@ (deftest standard-buffer-indent-line.test-2 (let ((buffer (make-instance 'standard-buffer))) (insert-buffer-sequence buffer 0 " climacs ") + (let ((m (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0))) + (indent-line m 5 4) + (buffer-sequence buffer 0 (size buffer)))) + " climacs ") + +(deftest standard-buffer-indent-line.test-3 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " climacs ") (let ((m (make-instance 'standard-right-sticky-mark :buffer buffer :offset 0))) (indent-line m 5 4) Index: climacs/base.lisp diff -u climacs/base.lisp:1.32 climacs/base.lisp:1.33 --- climacs/base.lisp:1.32 Sun Feb 6 01:03:26 2005 +++ climacs/base.lisp Sun Feb 6 17:33:50 2005 @@ -6,6 +6,8 @@ ;;; Elliott Johnson (ejohnson(a)fasl.info) ;;; (c) copyright 2005 by ;;; Matthieu Villeneuve (matthieu.villeneuve(a)free.fr) +;;; (c) copyright 2005 by +;;; Aleksandar Bakic (a_bakic(a)yahoo.com) ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public @@ -442,22 +444,33 @@ ;;; ;;; Indentation -(defun indent-line (mark indentation tab-width) - "Indent the line containing mark with indentation spaces. Use tabs and spaces -if tab-width is not nil, otherwise use spaces only." +(defgeneric indent-line (mark indentation tab-width) + (:documentation "Indent the line containing mark with indentation +spaces. Use tabs and spaces if tab-width is not nil, otherwise use +spaces only.")) + +(defun indent-line* (mark indentation tab-width left) (let ((mark2 (clone-mark mark))) (beginning-of-line mark2) (loop until (end-of-buffer-p mark2) - as object = (object-after mark2) - while (or (eql object #\Space) (eql object #\Tab)) - do (delete-range mark2 1)) + as object = (object-after mark2) + while (or (eql object #\Space) (eql object #\Tab)) + do (delete-range mark2 1)) (loop until (zerop indentation) - do (cond ((and tab-width (>= indentation tab-width)) - (insert-object mark2 #\Tab) - (decf indentation tab-width)) - (t - (insert-object mark2 #\Space) - (decf indentation)))))) + do (cond ((and tab-width (>= indentation tab-width)) + (insert-object mark2 #\Tab) + (when left ; spaces must follow tabs + (forward-object mark2)) + (decf indentation tab-width)) + (t + (insert-object mark2 #\Space) + (decf indentation)))))) + +(defmethod indent-line ((mark left-sticky-mark) indentation tab-width) + (indent-line* mark indentation tab-width t)) + +(defmethod indent-line ((mark right-sticky-mark) indentation tab-width) + (indent-line* mark indentation tab-width nil)) (defun delete-indentation (mark) (beginning-of-line mark)

1 0

[climacs-cvs] CVS update: climacs/Persistent/persistent-base-test.lisp climacs/Persistent/persistent-buffer-test.lisp climacs/Persistent/persistent-buffer.lisp
by abakic＠common-lisp.net 06 Feb '05

06 Feb '05

Update of /project/climacs/cvsroot/climacs/Persistent In directory common-lisp.net:/tmp/cvs-serv12175/Persistent Modified Files: persistent-base-test.lisp persistent-buffer-test.lisp persistent-buffer.lisp Log Message: Changes to (un)tabify-*region methods, and corresponding tests. Initial tests for indent-line. Date: Sun Feb 6 01:03:30 2005 Author: abakic Index: climacs/Persistent/persistent-base-test.lisp diff -u climacs/Persistent/persistent-base-test.lisp:1.4 climacs/Persistent/persistent-base-test.lisp:1.5 --- climacs/Persistent/persistent-base-test.lisp:1.4 Sat Jan 29 23:23:14 2005 +++ climacs/Persistent/persistent-base-test.lisp Sun Feb 6 01:03:29 2005 @@ -768,6 +768,110 @@ (offset m)))) "Cli Ma Cs climacs" 9) +(deftest binseq-buffer-tabify-buffer-region.test-1 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "c l im acs") + (climacs-base::tabify-buffer-region buffer 0 (size buffer) 8) + (buffer-sequence buffer 0 (size buffer))) + "c l im acs") + +(deftest binseq-buffer-tabify-buffer-region.test-2 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "c l im acs") + (climacs-base::tabify-buffer-region buffer 0 (size buffer) 8) + (buffer-sequence buffer 0 (size buffer))) + "c l im acs") + +(deftest binseq-buffer-tabify-region.test-1 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "clim acs") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 3)) + (m2 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 7))) + (tabify-region m2 m1 4) + (buffer-sequence buffer 0 (size buffer)))) + "clim acs") + +(deftest binseq-buffer-tabify-region.test-2 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "clim acs") + (let ((m1 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 3))) + (tabify-region 7 m1 4) + (buffer-sequence buffer 0 (size buffer)))) + "clim acs") + +(deftest binseq-buffer-tabify-region.test-3 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "clim acs") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 7))) + (tabify-region 3 m1 4) + (buffer-sequence buffer 0 (size buffer)))) + "clim acs") + +(deftest binseq-buffer-untabify-buffer-region.test-1 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "c l im acs") + (climacs-base::untabify-buffer-region buffer 0 (size buffer) 8) + (buffer-sequence buffer 0 (size buffer))) + "c l im acs") + +(deftest binseq-buffer-untabify-buffer-region.test-2 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "c l im acs") + (climacs-base::untabify-buffer-region buffer 0 (size buffer) 8) + (buffer-sequence buffer 0 (size buffer))) + "c l im acs") + +(deftest binseq-buffer-untabify-region.test-1 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "clim acs") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 3)) + (m2 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 5))) + (untabify-region m2 m1 4) + (buffer-sequence buffer 0 (size buffer)))) + "clim acs") + +(deftest binseq-buffer-untabify-region.test-2 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "clim acs") + (let ((m1 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 3))) + (untabify-region 5 m1 4) + (buffer-sequence buffer 0 (size buffer)))) + "clim acs") + +(deftest binseq-buffer-untabify-region.test-3 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "clim acs") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 5))) + (untabify-region 3 m1 4) + (buffer-sequence buffer 0 (size buffer)))) + "clim acs") + +(deftest binseq-buffer-indent-line.test-1 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 " climacs ") + (let ((m (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 0))) + (indent-line m 4 nil) + (buffer-sequence buffer 0 (size buffer)))) + " climacs ") + +(deftest binseq-buffer-indent-line.test-2 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 " climacs ") + (let ((m (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 0))) + (indent-line m 5 4) + (buffer-sequence buffer 0 (size buffer)))) + " climacs ") + ;;; obinseq tests (deftest obinseq-buffer-previous-line.test-1 @@ -1514,4 +1618,108 @@ (values (buffer-sequence buffer 0 (size buffer)) (offset m)))) - "Cli Ma Cs" 9) \ No newline at end of file + "Cli Ma Cs" 9) + +(deftest obinseq-buffer-tabify-buffer-region.test-1 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "c l im acs") + (climacs-base::tabify-buffer-region buffer 0 (size buffer) 8) + (buffer-sequence buffer 0 (size buffer))) + "c l im acs") + +(deftest obinseq-buffer-tabify-buffer-region.test-2 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "c l im acs") + (climacs-base::tabify-buffer-region buffer 0 (size buffer) 8) + (buffer-sequence buffer 0 (size buffer))) + "c l im acs") + +(deftest obinseq-buffer-tabify-region.test-1 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "clim acs") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 3)) + (m2 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 7))) + (tabify-region m2 m1 4) + (buffer-sequence buffer 0 (size buffer)))) + "clim acs") + +(deftest obinseq-buffer-tabify-region.test-2 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "clim acs") + (let ((m1 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 3))) + (tabify-region 7 m1 4) + (buffer-sequence buffer 0 (size buffer)))) + "clim acs") + +(deftest obinseq-buffer-tabify-region.test-3 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "clim acs") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 7))) + (tabify-region 3 m1 4) + (buffer-sequence buffer 0 (size buffer)))) + "clim acs") + +(deftest obinseq-buffer-untabify-buffer-region.test-1 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "c l im acs") + (climacs-base::untabify-buffer-region buffer 0 (size buffer) 8) + (buffer-sequence buffer 0 (size buffer))) + "c l im acs") + +(deftest obinseq-buffer-untabify-buffer-region.test-2 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "c l im acs") + (climacs-base::untabify-buffer-region buffer 0 (size buffer) 8) + (buffer-sequence buffer 0 (size buffer))) + "c l im acs") + +(deftest obinseq-buffer-untabify-region.test-1 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "clim acs") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 3)) + (m2 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 5))) + (untabify-region m2 m1 4) + (buffer-sequence buffer 0 (size buffer)))) + "clim acs") + +(deftest obinseq-buffer-untabify-region.test-2 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "clim acs") + (let ((m1 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 3))) + (untabify-region 5 m1 4) + (buffer-sequence buffer 0 (size buffer)))) + "clim acs") + +(deftest obinseq-buffer-untabify-region.test-3 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "clim acs") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 5))) + (untabify-region 3 m1 4) + (buffer-sequence buffer 0 (size buffer)))) + "clim acs") + +(deftest obinseq-buffer-indent-line.test-1 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 " climacs ") + (let ((m (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 0))) + (indent-line m 4 nil) + (buffer-sequence buffer 0 (size buffer)))) + " climacs ") + +(deftest obinseq-buffer-indent-line.test-2 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 " climacs ") + (let ((m (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 0))) + (indent-line m 5 4) + (buffer-sequence buffer 0 (size buffer)))) + " climacs ") Index: climacs/Persistent/persistent-buffer-test.lisp diff -u climacs/Persistent/persistent-buffer-test.lisp:1.6 climacs/Persistent/persistent-buffer-test.lisp:1.7 --- climacs/Persistent/persistent-buffer-test.lisp:1.6 Sat Feb 5 22:34:44 2005 +++ climacs/Persistent/persistent-buffer-test.lisp Sun Feb 6 01:03:29 2005 @@ -248,11 +248,14 @@ (let ((buffer (make-instance 'binseq-buffer))) (insert-buffer-sequence buffer 0 "climacs") (let ((m (make-instance 'persistent-left-sticky-mark - :buffer buffer :offset 3))) + :buffer buffer :offset 3)) + (m2 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 5))) (insert-sequence m "ClimacS") (and (= (size buffer) 14) (eq (buffer m) buffer) (= (offset m) 3) + (= (offset m2) 12) (buffer-sequence buffer 0 14)))) "cliClimacSmacs") @@ -260,11 +263,14 @@ (let ((buffer (make-instance 'binseq-buffer))) (insert-buffer-sequence buffer 0 "climacs") (let ((m (make-instance 'persistent-right-sticky-mark - :buffer buffer :offset 3))) + :buffer buffer :offset 3)) + (m2 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 5))) (insert-sequence m "ClimacS") (and (= (size buffer) 14) (eq (buffer m) buffer) (= (offset m) 10) + (= (offset m2) 12) (buffer-sequence buffer 0 14)))) "cliClimacSmacs") @@ -1062,11 +1068,14 @@ (let ((buffer (make-instance 'obinseq-buffer))) (insert-buffer-sequence buffer 0 "climacs") (let ((m (make-instance 'persistent-left-sticky-mark - :buffer buffer :offset 3))) + :buffer buffer :offset 3)) + (m2 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 5))) (insert-sequence m "ClimacS") (and (= (size buffer) 14) (eq (buffer m) buffer) (= (offset m) 3) + (= (offset m2) 12) (buffer-sequence buffer 0 14)))) "cliClimacSmacs") @@ -1074,11 +1083,14 @@ (let ((buffer (make-instance 'obinseq-buffer))) (insert-buffer-sequence buffer 0 "climacs") (let ((m (make-instance 'persistent-right-sticky-mark - :buffer buffer :offset 3))) + :buffer buffer :offset 3)) + (m2 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 5))) (insert-sequence m "ClimacS") (and (= (size buffer) 14) (eq (buffer m) buffer) (= (offset m) 10) + (= (offset m2) 12) (buffer-sequence buffer 0 14)))) "cliClimacSmacs") Index: climacs/Persistent/persistent-buffer.lisp diff -u climacs/Persistent/persistent-buffer.lisp:1.4 climacs/Persistent/persistent-buffer.lisp:1.5 --- climacs/Persistent/persistent-buffer.lisp:1.4 Sat Feb 5 21:59:51 2005 +++ climacs/Persistent/persistent-buffer.lisp Sun Feb 6 01:03:29 2005 @@ -145,15 +145,15 @@ (setf high-mark (make-instance 'persistent-right-sticky-mark :buffer buffer)))) -(defmethod clone-mark ((mark persistent-left-sticky-mark) &optional type) - (unless type - (setf type 'persistent-left-sticky-mark)) - (make-instance type :buffer (buffer mark) :offset (offset mark))) +;; (defmethod clone-mark ((mark persistent-left-sticky-mark) &optional type) +;; (unless type +;; (setf type 'persistent-left-sticky-mark)) +;; (make-instance type :buffer (buffer mark) :offset (offset mark))) -(defmethod clone-mark ((mark persistent-right-sticky-mark) &optional type) - (unless type - (setf type 'persistent-right-sticky-mark)) - (make-instance type :buffer (buffer mark) :offset (offset mark))) +;; (defmethod clone-mark ((mark persistent-right-sticky-mark) &optional type) +;; (unless type +;; (setf type 'persistent-right-sticky-mark)) +;; (make-instance type :buffer (buffer mark) :offset (offset mark))) (defmethod size ((buffer binseq-buffer)) (binseq-length (slot-value buffer 'contents)))

1 0

[climacs-cvs] CVS update: climacs/base-test.lisp climacs/base.lisp climacs/buffer-test.lisp
by abakic＠common-lisp.net 06 Feb '05

06 Feb '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv12175 Modified Files: base-test.lisp base.lisp buffer-test.lisp Log Message: Changes to (un)tabify-*region methods, and corresponding tests. Initial tests for indent-line. Date: Sun Feb 6 01:03:26 2005 Author: abakic Index: climacs/base-test.lisp diff -u climacs/base-test.lisp:1.4 climacs/base-test.lisp:1.5 --- climacs/base-test.lisp:1.4 Sat Jan 29 23:23:08 2005 +++ climacs/base-test.lisp Sun Feb 6 01:03:26 2005 @@ -770,3 +770,107 @@ (buffer-sequence buffer 0 (size buffer)) (offset m)))) "Cli Ma Cs climacs" 9) + +(deftest standard-buffer-tabify-buffer-region.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "c l im acs") + (climacs-base::tabify-buffer-region buffer 0 (size buffer) 8) + (buffer-sequence buffer 0 (size buffer))) + "c l im acs") + +(deftest standard-buffer-tabify-buffer-region.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "c l im acs") + (climacs-base::tabify-buffer-region buffer 0 (size buffer) 8) + (buffer-sequence buffer 0 (size buffer))) + "c l im acs") + +(deftest standard-buffer-tabify-region.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "clim acs") + (let ((m1 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 3)) + (m2 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 7))) + (tabify-region m2 m1 4) + (buffer-sequence buffer 0 (size buffer)))) + "clim acs") + +(deftest standard-buffer-tabify-region.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "clim acs") + (let ((m1 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 3))) + (tabify-region 7 m1 4) + (buffer-sequence buffer 0 (size buffer)))) + "clim acs") + +(deftest standard-buffer-tabify-region.test-3 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "clim acs") + (let ((m1 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 7))) + (tabify-region 3 m1 4) + (buffer-sequence buffer 0 (size buffer)))) + "clim acs") + +(deftest standard-buffer-untabify-buffer-region.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "c l im acs") + (climacs-base::untabify-buffer-region buffer 0 (size buffer) 8) + (buffer-sequence buffer 0 (size buffer))) + "c l im acs") + +(deftest standard-buffer-untabify-buffer-region.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "c l im acs") + (climacs-base::untabify-buffer-region buffer 0 (size buffer) 8) + (buffer-sequence buffer 0 (size buffer))) + "c l im acs") + +(deftest standard-buffer-untabify-region.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "clim acs") + (let ((m1 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 3)) + (m2 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 5))) + (untabify-region m2 m1 4) + (buffer-sequence buffer 0 (size buffer)))) + "clim acs") + +(deftest standard-buffer-untabify-region.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "clim acs") + (let ((m1 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 3))) + (untabify-region 5 m1 4) + (buffer-sequence buffer 0 (size buffer)))) + "clim acs") + +(deftest standard-buffer-untabify-region.test-3 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "clim acs") + (let ((m1 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 5))) + (untabify-region 3 m1 4) + (buffer-sequence buffer 0 (size buffer)))) + "clim acs") + +(deftest standard-buffer-indent-line.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 0))) + (indent-line m 4 nil) + (buffer-sequence buffer 0 (size buffer)))) + " climacs ") + +(deftest standard-buffer-indent-line.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))) + (indent-line m 5 4) + (buffer-sequence buffer 0 (size buffer)))) + " climacs ") Index: climacs/base.lisp diff -u climacs/base.lisp:1.31 climacs/base.lisp:1.32 --- climacs/base.lisp:1.31 Sat Feb 5 08:04:03 2005 +++ climacs/base.lisp Sun Feb 6 01:03:26 2005 @@ -382,14 +382,23 @@ (defmethod tabify-region ((mark1 mark) (mark2 mark) tab-width) (assert (eq (buffer mark1) (buffer mark2))) - (tabify-buffer-region (buffer mark1) (offset mark1) (offset mark2) - tab-width)) - -(defmethod tabify-region ((offset integer) (mark mark) tab-width) - (tabify-buffer-region (buffer mark) offset (offset mark) tab-width)) - -(defmethod tabify-region ((mark mark) (offset integer) tab-width) - (tabify-buffer-region (buffer mark) (offset mark) offset tab-width)) + (let ((offset1 (offset mark1)) + (offset2 (offset mark2))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (tabify-buffer-region (buffer mark1) offset1 offset2 tab-width))) + +(defmethod tabify-region ((offset1 integer) (mark2 mark) tab-width) + (let ((offset2 (offset mark2))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (tabify-buffer-region (buffer mark2) offset1 offset2 tab-width))) + +(defmethod tabify-region ((mark1 mark) (offset2 integer) tab-width) + (let ((offset1 (offset mark1))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (tabify-buffer-region (buffer mark1) offset1 offset2 tab-width))) (defun untabify-buffer-region (buffer offset1 offset2 tab-width) (loop for offset = offset1 then (1+ offset) @@ -411,14 +420,23 @@ (defmethod untabify-region ((mark1 mark) (mark2 mark) tab-width) (assert (eq (buffer mark1) (buffer mark2))) - (untabify-buffer-region (buffer mark1) (offset mark1) (offset mark2) - tab-width)) - -(defmethod untabify-region ((offset integer) (mark mark) tab-width) - (untabify-buffer-region (buffer mark) offset (offset mark) tab-width)) - -(defmethod untabify-region ((mark mark) (offset integer) tab-width) - (untabify-buffer-region (buffer mark) (offset mark) offset tab-width)) + (let ((offset1 (offset mark1)) + (offset2 (offset mark2))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (untabify-buffer-region (buffer mark1) offset1 offset2 tab-width))) + +(defmethod untabify-region ((offset1 integer) (mark2 mark) tab-width) + (let ((offset2 (offset mark2))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (untabify-buffer-region (buffer mark2) offset1 offset2 tab-width))) + +(defmethod untabify-region ((mark1 mark) (offset2 integer) tab-width) + (let ((offset1 (offset mark1))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (untabify-buffer-region (buffer mark1) offset1 offset2 tab-width))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Index: climacs/buffer-test.lisp diff -u climacs/buffer-test.lisp:1.13 climacs/buffer-test.lisp:1.14 --- climacs/buffer-test.lisp:1.13 Sat Feb 5 22:34:43 2005 +++ climacs/buffer-test.lisp Sun Feb 6 01:03:26 2005 @@ -234,11 +234,14 @@ (let ((buffer (make-instance 'standard-buffer))) (insert-buffer-sequence buffer 0 "climacs") (let ((m (make-instance 'standard-left-sticky-mark - :buffer buffer :offset 3))) + :buffer buffer :offset 3)) + (m2 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 5))) (insert-sequence m "ClimacS") (and (= (size buffer) 14) (eq (buffer m) buffer) (= (offset m) 3) + (= (offset m2) 12) (buffer-sequence buffer 0 14)))) "cliClimacSmacs") @@ -246,11 +249,14 @@ (let ((buffer (make-instance 'standard-buffer))) (insert-buffer-sequence buffer 0 "climacs") (let ((m (make-instance 'standard-right-sticky-mark - :buffer buffer :offset 3))) + :buffer buffer :offset 3)) + (m2 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 5))) (insert-sequence m "ClimacS") (and (= (size buffer) 14) (eq (buffer m) buffer) (= (offset m) 10) + (= (offset m2) 12) (buffer-sequence buffer 0 14)))) "cliClimacSmacs")

1 0

[climacs-cvs] CVS update: climacs/Persistent/persistent-buffer-test.lisp
by abakic＠common-lisp.net 05 Feb '05

05 Feb '05

Update of /project/climacs/cvsroot/climacs/Persistent In directory common-lisp.net:/tmp/cvs-serv3430/Persistent Modified Files: persistent-buffer-test.lisp Log Message: Added a few tests for forward/backward-object. Date: Sat Feb 5 22:34:44 2005 Author: abakic Index: climacs/Persistent/persistent-buffer-test.lisp diff -u climacs/Persistent/persistent-buffer-test.lisp:1.5 climacs/Persistent/persistent-buffer-test.lisp:1.6 --- climacs/Persistent/persistent-buffer-test.lisp:1.5 Sat Feb 5 21:59:51 2005 +++ climacs/Persistent/persistent-buffer-test.lisp Sat Feb 5 22:34:44 2005 @@ -496,6 +496,52 @@ (= (climacs-buffer::condition-offset c) -1))) t) +(deftest binseq-buffer-backward-object.test-1 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let* ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 4)) + (m2 (clone-mark m1))) + (backward-object m1 2) + (region-to-sequence m1 m2))) + "im") + +(deftest binseq-buffer-backward-object.test-2 + (handler-case + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let* ((m1 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 2)) + (m2 (clone-mark m1))) + (backward-object m1 3) + (region-to-sequence m1 m2))) + (climacs-buffer::no-such-offset (c) + (= (climacs-buffer::condition-offset c) -1))) + t) + +(deftest binseq-buffer-forward-object.test-1 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let* ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 4)) + (m2 (clone-mark m1))) + (forward-object m1 2) + (region-to-sequence m1 m2))) + "ac") + +(deftest binseq-buffer-forward-object.test-2 + (handler-case + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let* ((m1 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 6)) + (m2 (clone-mark m1))) + (forward-object m1 3) + (region-to-sequence m1 m2))) + (climacs-buffer::no-such-offset (c) + (= (climacs-buffer::condition-offset c) 9))) + t) + (deftest binseq-buffer-mark<.test-1 (handler-case (let ((buffer (make-instance 'binseq-buffer)) @@ -1262,6 +1308,52 @@ (setf (buffer-object buffer -1) #\a)) (climacs-buffer::no-such-offset (c) (= (climacs-buffer::condition-offset c) -1))) + t) + +(deftest obinseq-buffer-backward-object.test-1 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let* ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 4)) + (m2 (clone-mark m1))) + (backward-object m1 2) + (region-to-sequence m1 m2))) + "im") + +(deftest obinseq-buffer-backward-object.test-2 + (handler-case + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let* ((m1 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 2)) + (m2 (clone-mark m1))) + (backward-object m1 3) + (region-to-sequence m1 m2))) + (climacs-buffer::no-such-offset (c) + (= (climacs-buffer::condition-offset c) -1))) + t) + +(deftest obinseq-buffer-forward-object.test-1 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let* ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 4)) + (m2 (clone-mark m1))) + (forward-object m1 2) + (region-to-sequence m1 m2))) + "ac") + +(deftest obinseq-buffer-forward-object.test-2 + (handler-case + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let* ((m1 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 6)) + (m2 (clone-mark m1))) + (forward-object m1 3) + (region-to-sequence m1 m2))) + (climacs-buffer::no-such-offset (c) + (= (climacs-buffer::condition-offset c) 9))) t) (deftest obinseq-buffer-mark<.test-1

1 0

[climacs-cvs] CVS update: climacs/buffer-test.lisp
by abakic＠common-lisp.net 05 Feb '05

05 Feb '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv3430 Modified Files: buffer-test.lisp Log Message: Added a few tests for forward/backward-object. Date: Sat Feb 5 22:34:43 2005 Author: abakic Index: climacs/buffer-test.lisp diff -u climacs/buffer-test.lisp:1.12 climacs/buffer-test.lisp:1.13 --- climacs/buffer-test.lisp:1.12 Sat Feb 5 21:59:49 2005 +++ climacs/buffer-test.lisp Sat Feb 5 22:34:43 2005 @@ -459,6 +459,52 @@ (= (climacs-buffer::condition-offset c) 8))) t) +(deftest standard-buffer-backward-object.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 4)) + (m2 (clone-mark m1))) + (backward-object m1 2) + (region-to-sequence m1 m2))) + "im") + +(deftest standard-buffer-backward-object.test-2 + (handler-case + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let* ((m1 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 2)) + (m2 (clone-mark m1))) + (backward-object m1 3) + (region-to-sequence m1 m2))) + (climacs-buffer::no-such-offset (c) + (= (climacs-buffer::condition-offset c) -1))) + t) + +(deftest standard-buffer-forward-object.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 4)) + (m2 (clone-mark m1))) + (forward-object m1 2) + (region-to-sequence m1 m2))) + "ac") + +(deftest standard-buffer-forward-object.test-2 + (handler-case + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let* ((m1 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 6)) + (m2 (clone-mark m1))) + (forward-object m1 3) + (region-to-sequence m1 m2))) + (climacs-buffer::no-such-offset (c) + (= (climacs-buffer::condition-offset c) 9))) + t) + (deftest standard-buffer-setf-buffer-object.test-1 (let ((buffer (make-instance 'standard-buffer))) (insert-buffer-sequence buffer 0 "climacs")

1 0

[climacs-cvs] CVS update: climacs/Persistent/README climacs/Persistent/persistent-buffer-test.lisp climacs/Persistent/persistent-buffer.lisp
by abakic＠common-lisp.net 05 Feb '05

05 Feb '05

Update of /project/climacs/cvsroot/climacs/Persistent In directory common-lisp.net:/tmp/cvs-serv1016/Persistent Modified Files: README persistent-buffer-test.lisp persistent-buffer.lisp Log Message: Introduced p-mark-mixin class to separate methods related to the standard-buffer and its marks, from those related to the persistent buffers and their marks. Also added a few tests for (setf buffer-object). Date: Sat Feb 5 21:59:52 2005 Author: abakic Index: climacs/Persistent/README diff -u climacs/Persistent/README:1.2 climacs/Persistent/README:1.3 --- climacs/Persistent/README:1.2 Fri Jan 28 19:47:34 2005 +++ climacs/Persistent/README Sat Feb 5 21:59:51 2005 @@ -8,21 +8,6 @@ all other places marked with "PB" comments, substitute "standard" for "persistent" in order to use the corresponding mark classes. -Also, end-of-line method in buffer.lisp has to be fixed and look like: - -(defmethod end-of-line ((mark mark-mixin)) - (let* ((offset (offset mark)) - (buffer (buffer mark)) - (size (size buffer))) - (loop until (or (= offset size) - (eql (buffer-object buffer offset) #\Newline)) - do (incf offset)) - (setf (offset mark) offset))) - -(It is currently "broken" for performance reasons.) Until then, -(o)binseq-end-of-line, (o)binseq-next-line and (o)binseq-kill-line -tests will fail (20 of them). - NOTE: There is a dependency of Persistent/persistent-buffer.lisp on Flexichain/utilities.lisp (the weak pointer handling). Index: climacs/Persistent/persistent-buffer-test.lisp diff -u climacs/Persistent/persistent-buffer-test.lisp:1.4 climacs/Persistent/persistent-buffer-test.lisp:1.5 --- climacs/Persistent/persistent-buffer-test.lisp:1.4 Sat Feb 5 14:49:23 2005 +++ climacs/Persistent/persistent-buffer-test.lisp Sat Feb 5 21:59:51 2005 @@ -473,6 +473,29 @@ (= (climacs-buffer::condition-offset c) 8))) t) +(deftest binseq-buffer-setf-buffer-object.test-1 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (setf (buffer-object buffer 0) #\C) + (buffer-sequence buffer 0 (size buffer))) + "Climacs") + +(deftest binseq-buffer-setf-buffer-object.test-2 + (handler-case + (let ((buffer (make-instance 'binseq-buffer))) + (setf (buffer-object buffer 0) #\a)) + (climacs-buffer::no-such-offset (c) + (= (climacs-buffer::condition-offset c) 0))) + t) + +(deftest binseq-buffer-setf-buffer-object.test-3 + (handler-case + (let ((buffer (make-instance 'binseq-buffer))) + (setf (buffer-object buffer -1) #\a)) + (climacs-buffer::no-such-offset (c) + (= (climacs-buffer::condition-offset c) -1))) + t) + (deftest binseq-buffer-mark<.test-1 (handler-case (let ((buffer (make-instance 'binseq-buffer)) @@ -1216,6 +1239,29 @@ (setf (offset m) 8))) (climacs-buffer::no-such-offset (c) (= (climacs-buffer::condition-offset c) 8))) + t) + +(deftest obinseq-buffer-setf-buffer-object.test-1 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (setf (buffer-object buffer 0) #\C) + (buffer-sequence buffer 0 (size buffer))) + "Climacs") + +(deftest obinseq-buffer-setf-buffer-object.test-2 + (handler-case + (let ((buffer (make-instance 'obinseq-buffer))) + (setf (buffer-object buffer 0) #\a)) + (climacs-buffer::no-such-offset (c) + (= (climacs-buffer::condition-offset c) 0))) + t) + +(deftest obinseq-buffer-setf-buffer-object.test-3 + (handler-case + (let ((buffer (make-instance 'obinseq-buffer))) + (setf (buffer-object buffer -1) #\a)) + (climacs-buffer::no-such-offset (c) + (= (climacs-buffer::condition-offset c) -1))) t) (deftest obinseq-buffer-mark<.test-1 Index: climacs/Persistent/persistent-buffer.lisp diff -u climacs/Persistent/persistent-buffer.lisp:1.3 climacs/Persistent/persistent-buffer.lisp:1.4 --- climacs/Persistent/persistent-buffer.lisp:1.3 Fri Jan 28 19:47:36 2005 +++ climacs/Persistent/persistent-buffer.lisp Sat Feb 5 21:59:51 2005 @@ -87,11 +87,31 @@ uses an optimized binary sequence (only non-nil atoms are allowed as elements) for the CONTENTS.")) -(defclass persistent-left-sticky-mark (left-sticky-mark mark-mixin) () +(defclass p-mark-mixin () + ((buffer :initarg :buffer :reader buffer) + (cursor :reader cursor)) + (:documentation "A mixin class used in the initialization of a mark +that is used in a PERSISTENT-BUFFER.")) + +(defmethod backward-object ((mark p-mark-mixin) &optional (count 1)) + (decf (offset mark) count)) + +(defmethod forward-object ((mark p-mark-mixin) &optional (count 1)) + (incf (offset mark) count)) + +(defmethod offset ((mark p-mark-mixin)) + (cursor-pos (cursor mark))) + +(defmethod (setf offset) (new-offset (mark p-mark-mixin)) + (assert (<= 0 new-offset (size (buffer mark))) () + (make-condition 'no-such-offset :offset new-offset)) + (setf (cursor-pos (cursor mark)) new-offset)) + +(defclass persistent-left-sticky-mark (left-sticky-mark p-mark-mixin) () (:documentation "A LEFT-STICKY-MARK subclass suitable for use in a PERSISTENT-BUFFER.")) -(defclass persistent-right-sticky-mark (right-sticky-mark mark-mixin) () +(defclass persistent-right-sticky-mark (right-sticky-mark p-mark-mixin) () (:documentation "A RIGHT-STICKY-MARK subclass suitable for use in a PERSISTENT-BUFFER.")) @@ -145,16 +165,105 @@ (loop for offset from 0 below (size buffer) count (eql (buffer-object buffer offset) #\Newline))) +(defmethod mark< ((mark1 p-mark-mixin) (mark2 p-mark-mixin)) + (assert (eq (buffer mark1) (buffer mark2))) + (< (offset mark1) (offset mark2))) + +(defmethod mark< ((mark1 p-mark-mixin) (mark2 integer)) + (< (offset mark1) mark2)) + +(defmethod mark< ((mark1 integer) (mark2 p-mark-mixin)) + (< mark1 (offset mark2))) + +(defmethod mark<= ((mark1 p-mark-mixin) (mark2 p-mark-mixin)) + (assert (eq (buffer mark1) (buffer mark2))) + (<= (offset mark1) (offset mark2))) + +(defmethod mark<= ((mark1 p-mark-mixin) (mark2 integer)) + (<= (offset mark1) mark2)) + +(defmethod mark<= ((mark1 integer) (mark2 p-mark-mixin)) + (<= mark1 (offset mark2))) + +(defmethod mark= ((mark1 p-mark-mixin) (mark2 p-mark-mixin)) + (assert (eq (buffer mark1) (buffer mark2))) + (= (offset mark1) (offset mark2))) + +(defmethod mark= ((mark1 p-mark-mixin) (mark2 integer)) + (= (offset mark1) mark2)) + +(defmethod mark= ((mark1 integer) (mark2 p-mark-mixin)) + (= mark1 (offset mark2))) + +(defmethod mark> ((mark1 p-mark-mixin) (mark2 p-mark-mixin)) + (assert (eq (buffer mark1) (buffer mark2))) + (> (offset mark1) (offset mark2))) + +(defmethod mark> ((mark1 p-mark-mixin) (mark2 integer)) + (> (offset mark1) mark2)) + +(defmethod mark> ((mark1 integer) (mark2 p-mark-mixin)) + (> mark1 (offset mark2))) + +(defmethod mark>= ((mark1 p-mark-mixin) (mark2 p-mark-mixin)) + (assert (eq (buffer mark1) (buffer mark2))) + (>= (offset mark1) (offset mark2))) + +(defmethod mark>= ((mark1 p-mark-mixin) (mark2 integer)) + (>= (offset mark1) mark2)) + +(defmethod mark>= ((mark1 integer) (mark2 p-mark-mixin)) + (>= mark1 (offset mark2))) + +(defmethod beginning-of-buffer ((mark p-mark-mixin)) + (setf (offset mark) 0)) + +(defmethod end-of-buffer ((mark p-mark-mixin)) + (setf (offset mark) (size (buffer mark)))) + +(defmethod beginning-of-buffer-p ((mark p-mark-mixin)) + (zerop (offset mark))) + +(defmethod end-of-buffer-p ((mark p-mark-mixin)) + (= (offset mark) (size (buffer mark)))) + +(defmethod beginning-of-line-p ((mark p-mark-mixin)) + (or (beginning-of-buffer-p mark) + (eql (object-before mark) #\Newline))) + +(defmethod end-of-line-p ((mark p-mark-mixin)) + (or (end-of-buffer-p mark) + (eql (object-after mark) #\Newline))) + +(defmethod beginning-of-line ((mark p-mark-mixin)) + (loop until (beginning-of-line-p mark) + do (decf (offset mark)))) + +(defmethod end-of-line ((mark p-mark-mixin)) + (let* ((offset (offset mark)) + (buffer (buffer mark)) + (size (size buffer))) + (loop until (or (= offset size) + (eql (buffer-object buffer offset) #\Newline)) + do (incf offset)) + (setf (offset mark) offset))) + (defmethod buffer-line-number ((buffer persistent-buffer) (offset integer)) (loop for i from 0 below offset count (eql (buffer-object buffer i) #\Newline))) +(defmethod line-number ((mark p-mark-mixin)) + (buffer-line-number (buffer mark) (offset mark))) + (defmethod buffer-column-number ((buffer persistent-buffer) (offset integer)) (loop for i downfrom offset while (> i 0) until (eql (buffer-object buffer (1- i)) #\Newline) count t)) +(defmethod column-number ((mark p-mark-mixin)) + (buffer-column-number (buffer mark) (offset mark))) + ;;; the old value of the CONTENTS slot is dropped upon modification ;;; it can be saved for UNDO purposes in a history tree, by an UNDOABLE-BUFFER @@ -170,6 +279,9 @@ (setf (slot-value buffer 'contents) (obinseq-insert (slot-value buffer 'contents) offset object))) +(defmethod insert-object ((mark p-mark-mixin) object) + (insert-buffer-object (buffer mark) (offset mark) object)) + (defmethod insert-buffer-sequence ((buffer binseq-buffer) offset sequence) (let ((binseq (list-binseq (loop for e across sequence collect e)))) (setf (slot-value buffer 'contents) @@ -180,6 +292,9 @@ (setf (slot-value buffer 'contents) (obinseq-insert* (slot-value buffer 'contents) offset obinseq)))) +(defmethod insert-sequence ((mark p-mark-mixin) sequence) + (insert-buffer-sequence (buffer mark) (offset mark) sequence)) + (defmethod delete-buffer-range ((buffer binseq-buffer) offset n) (assert (<= 0 offset (size buffer)) () (make-condition 'no-such-offset :offset offset)) @@ -192,6 +307,32 @@ (setf (slot-value buffer 'contents) (obinseq-remove* (slot-value buffer 'contents) offset n))) +(defmethod delete-range ((mark p-mark-mixin) &optional (n 1)) + (cond + ((plusp n) (delete-buffer-range (buffer mark) (offset mark) n)) + ((minusp n) (delete-buffer-range (buffer mark) (+ (offset mark) n) (- n))) + (t nil))) + +(defmethod delete-region ((mark1 p-mark-mixin) (mark2 p-mark-mixin)) + (assert (eq (buffer mark1) (buffer mark2))) + (let ((offset1 (offset mark1)) + (offset2 (offset mark2))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (delete-buffer-range (buffer mark1) offset1 (- offset2 offset1)))) + +(defmethod delete-region ((mark1 p-mark-mixin) offset2) + (let ((offset1 (offset mark1))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (delete-buffer-range (buffer mark1) offset1 (- offset2 offset1)))) + +(defmethod delete-region (offset1 (mark2 p-mark-mixin)) + (let ((offset2 (offset mark2))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (delete-buffer-range (buffer mark2) offset1 (- offset2 offset1)))) + (defmethod buffer-object ((buffer binseq-buffer) offset) (assert (<= 0 offset (1- (size buffer))) () (make-condition 'no-such-offset :offset offset)) @@ -240,6 +381,43 @@ nil)) 'vector)) +(defmethod object-before ((mark p-mark-mixin)) + (buffer-object (buffer mark) (1- (offset mark)))) + +(defmethod object-after ((mark p-mark-mixin)) + (buffer-object (buffer mark) (offset mark))) + +(defmethod region-to-sequence ((mark1 p-mark-mixin) (mark2 p-mark-mixin)) + (assert (eq (buffer mark1) (buffer mark2))) + (let ((offset1 (offset mark1)) + (offset2 (offset mark2))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (buffer-sequence (buffer mark1) offset1 offset2))) + +(defmethod region-to-sequence ((offset1 integer) (mark2 p-mark-mixin)) + (let ((offset2 (offset mark2))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (buffer-sequence (buffer mark2) offset1 offset2))) + +(defmethod region-to-sequence ((mark1 p-mark-mixin) (offset2 integer)) + (let ((offset1 (offset mark1))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (buffer-sequence (buffer mark1) offset1 offset2))) + +;;; Buffer modification protocol + +(defmethod (setf buffer-object) + :before (object (buffer persistent-buffer) offset) + (declare (ignore object)) + (setf (offset (low-mark buffer)) + (min (offset (low-mark buffer)) offset)) + (setf (offset (high-mark buffer)) + (max (offset (high-mark buffer)) offset)) + (setf (slot-value buffer 'modified) t)) + (defmethod insert-buffer-object :before ((buffer persistent-buffer) offset object) (declare (ignore object)) @@ -309,4 +487,4 @@ (defmethod delete-buffer-range :after ((buffer persistent-buffer) offset n) (with-slots (cursors) buffer - (setf cursors (adjust-cursors-on-delete buffer offset n)))) \ No newline at end of file + (setf cursors (adjust-cursors-on-delete buffer offset n))))

1 0

[climacs-cvs] CVS update: climacs/buffer-test.lisp climacs/buffer.lisp
by abakic＠common-lisp.net 05 Feb '05

05 Feb '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv1016 Modified Files: buffer-test.lisp buffer.lisp Log Message: Introduced p-mark-mixin class to separate methods related to the standard-buffer and its marks, from those related to the persistent buffers and their marks. Also added a few tests for (setf buffer-object). Date: Sat Feb 5 21:59:50 2005 Author: abakic Index: climacs/buffer-test.lisp diff -u climacs/buffer-test.lisp:1.11 climacs/buffer-test.lisp:1.12 --- climacs/buffer-test.lisp:1.11 Sat Feb 5 14:49:20 2005 +++ climacs/buffer-test.lisp Sat Feb 5 21:59:49 2005 @@ -459,6 +459,29 @@ (= (climacs-buffer::condition-offset c) 8))) t) +(deftest standard-buffer-setf-buffer-object.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (setf (buffer-object buffer 0) #\C) + (buffer-sequence buffer 0 (size buffer))) + "Climacs") + +(deftest standard-buffer-setf-buffer-object.test-2 + (handler-case + (let ((buffer (make-instance 'standard-buffer))) + (setf (buffer-object buffer 0) #\a)) + (climacs-buffer::no-such-offset (c) + (= (climacs-buffer::condition-offset c) 0))) + t) + +(deftest standard-buffer-setf-buffer-object.test-3 + (handler-case + (let ((buffer (make-instance 'standard-buffer))) + (setf (buffer-object buffer -1) #\a)) + (climacs-buffer::no-such-offset (c) + (= (climacs-buffer::condition-offset c) -1))) + t) + (deftest standard-buffer-mark<.test-1 (handler-case (let ((buffer (make-instance 'standard-buffer)) Index: climacs/buffer.lisp diff -u climacs/buffer.lisp:1.26 climacs/buffer.lisp:1.27 --- climacs/buffer.lisp:1.26 Sat Feb 5 14:49:20 2005 +++ climacs/buffer.lisp Sat Feb 5 21:59:50 2005 @@ -88,12 +88,12 @@ (defgeneric backward-object (mark &optional count)) -(defmethod backward-object ((mark mark) &optional (count 1)) +(defmethod backward-object ((mark mark-mixin) &optional (count 1)) (decf (offset mark) count)) (defgeneric forward-object (mark &optional count)) -(defmethod forward-object ((mark mark) &optional (count 1)) +(defmethod forward-object ((mark mark-mixin) &optional (count 1)) (incf (offset mark) count)) (defclass standard-left-sticky-mark (left-sticky-mark mark-mixin) () @@ -297,7 +297,7 @@ either immediately before the closest following newline character, or at the end of the buffer if no following newline character exists.")) -(defmethod end-of-line ((mark mark-mixin)) ;PB +(defmethod end-of-line ((mark mark-mixin)) (let* ((offset (offset mark)) (buffer (buffer mark)) (chain (slot-value buffer 'contents))

1 0

[climacs-cvs] CVS update: climacs/Persistent/persistent-buffer-test.lisp
by abakic＠common-lisp.net 05 Feb '05

05 Feb '05

Update of /project/climacs/cvsroot/climacs/Persistent In directory common-lisp.net:/tmp/cvs-serv9690/Persistent Modified Files: persistent-buffer-test.lisp Log Message: Changed region-to-sequence to be symmetrical wrt. marks. Date: Sat Feb 5 14:49:23 2005 Author: abakic Index: climacs/Persistent/persistent-buffer-test.lisp diff -u climacs/Persistent/persistent-buffer-test.lisp:1.3 climacs/Persistent/persistent-buffer-test.lisp:1.4 --- climacs/Persistent/persistent-buffer-test.lisp:1.3 Fri Jan 28 19:47:34 2005 +++ climacs/Persistent/persistent-buffer-test.lisp Sat Feb 5 14:49:23 2005 @@ -724,6 +724,14 @@ (and (not (eq seq seq2)) seq2))) "climacs") +(deftest binseq-buffer-region-to-sequence.test-1aa + (let ((seq "climacs") + (buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 seq) + (let ((seq2 (region-to-sequence (high-mark buffer) 0))) + (and (not (eq seq seq2)) seq2))) + "climacs") + (deftest binseq-buffer-region-to-sequence.test-1b (let ((seq "climacs") (buffer (make-instance 'binseq-buffer))) @@ -732,12 +740,20 @@ (and (not (eq seq seq2)) seq2))) "climacs") +(deftest binseq-buffer-region-to-sequence.test-1ba + (let ((seq "climacs") + (buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 seq) + (let ((seq2 (region-to-sequence 7 (low-mark buffer)))) + (and (not (eq seq seq2)) seq2))) + "climacs") + (deftest binseq-buffer-region-to-sequence.test-2 (let ((seq "climacs") (buffer (make-instance 'binseq-buffer))) (insert-buffer-sequence buffer 0 seq) (region-to-sequence (high-mark buffer) (low-mark buffer))) - #()) + "climacs") (deftest binseq-buffer-region-to-sequence.test-3 (handler-case @@ -1453,6 +1469,14 @@ (and (not (eq seq seq2)) seq2))) "climacs") +(deftest obinseq-buffer-region-to-sequence.test-1aa + (let ((seq "climacs") + (buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 seq) + (let ((seq2 (region-to-sequence (high-mark buffer) 0))) + (and (not (eq seq seq2)) seq2))) + "climacs") + (deftest obinseq-buffer-region-to-sequence.test-1b (let ((seq "climacs") (buffer (make-instance 'obinseq-buffer))) @@ -1461,12 +1485,20 @@ (and (not (eq seq seq2)) seq2))) "climacs") +(deftest obinseq-buffer-region-to-sequence.test-1ba + (let ((seq "climacs") + (buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 seq) + (let ((seq2 (region-to-sequence 7 (low-mark buffer)))) + (and (not (eq seq seq2)) seq2))) + "climacs") + (deftest obinseq-buffer-region-to-sequence.test-2 (let ((seq "climacs") (buffer (make-instance 'obinseq-buffer))) (insert-buffer-sequence buffer 0 seq) (region-to-sequence (high-mark buffer) (low-mark buffer))) - #()) + "climacs") (deftest obinseq-buffer-region-to-sequence.test-3 (handler-case @@ -1696,4 +1728,4 @@ for i from 0 below 100000 do (insert-buffer-sequence b (floor (size b) 2) "abcdefghij") finally (return (size b))) - 1000000) \ No newline at end of file + 1000000)

1 0

[climacs-cvs] CVS update: climacs/Doc/climacs-internals.texi
by abakic＠common-lisp.net 05 Feb '05

05 Feb '05

Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv9690/Doc Modified Files: climacs-internals.texi Log Message: Changed region-to-sequence to be symmetrical wrt. marks. Date: Sat Feb 5 14:49:22 2005 Author: abakic Index: climacs/Doc/climacs-internals.texi diff -u climacs/Doc/climacs-internals.texi:1.11 climacs/Doc/climacs-internals.texi:1.12 --- climacs/Doc/climacs-internals.texi:1.11 Sat Feb 5 08:04:06 2005 +++ climacs/Doc/climacs-internals.texi Sat Feb 5 14:49:22 2005 @@ -323,10 +323,10 @@ @deffn {Generic Function} {delete-region} mark1 mark2 -Delete the objects in the buffer that are -between mark1 and mark2. An error is signaled if the two marks -are positioned in different buffers. It is acceptable to pass an -offset in place of one of the marks. +Delete the objects in the buffer that are between mark1 and mark2. An +error is signaled if the two marks are positioned in different +buffers. It is acceptable to pass an offset in place of one of the +marks. This function calls delete-buffer-range with the appropriate arguments. @end deffn @@ -349,7 +349,7 @@ offset1, an empty sequence will be returned. @end deffn -@deffn {Generic Function} {objecct-before} mark +@deffn {Generic Function} {object-before} mark Return the object that is immediately before the mark. If mark is at the beginning of the buffer, a no-such-offset condition is signaled. @@ -357,7 +357,7 @@ of the buffer, a newline character is returned. @end deffn -@deffn {Generic Function} {objecct-after} mark +@deffn {Generic Function} {object-after} mark Return the object that is immediately after the mark. If mark is at the end of the buffer, a no-such-offset condition is signaled. If @@ -367,11 +367,10 @@ @deffn {Generic Function} {region-to-sequence} mark1 mark2 -Return a freshly allocated sequence of the objects after mark1 and -before mark2. An error is signaled if the two marks are positioned -in different buffers. If mark1 is positioned at an offset equal to -or greater than that of mark2, an empty sequence is returned. It is -acceptable to pass an offset in place of one of the marks. +Return a freshly allocated sequence of the objects between mark1 and +mark2. An error is signaled if the two marks are positioned in +different buffers. It is acceptable to pass an offset in place of one +of the marks. @end deffn @section Implementation hints

1 0

[climacs-cvs] CVS update: climacs/buffer-test.lisp climacs/buffer.lisp
by abakic＠common-lisp.net 05 Feb '05

05 Feb '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv9690 Modified Files: buffer-test.lisp buffer.lisp Log Message: Changed region-to-sequence to be symmetrical wrt. marks. Date: Sat Feb 5 14:49:21 2005 Author: abakic Index: climacs/buffer-test.lisp diff -u climacs/buffer-test.lisp:1.10 climacs/buffer-test.lisp:1.11 --- climacs/buffer-test.lisp:1.10 Fri Jan 28 19:47:29 2005 +++ climacs/buffer-test.lisp Sat Feb 5 14:49:20 2005 @@ -710,6 +710,14 @@ (and (not (eq seq seq2)) seq2))) "climacs") +(deftest standard-buffer-region-to-sequence.test-1aa + (let ((seq "climacs") + (buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 seq) + (let ((seq2 (region-to-sequence (high-mark buffer) 0))) + (and (not (eq seq seq2)) seq2))) + "climacs") + (deftest standard-buffer-region-to-sequence.test-1b (let ((seq "climacs") (buffer (make-instance 'standard-buffer))) @@ -718,12 +726,20 @@ (and (not (eq seq seq2)) seq2))) "climacs") +(deftest standard-buffer-region-to-sequence.test-1ba + (let ((seq "climacs") + (buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 seq) + (let ((seq2 (region-to-sequence 7 (low-mark buffer)))) + (and (not (eq seq seq2)) seq2))) + "climacs") + (deftest standard-buffer-region-to-sequence.test-2 (let ((seq "climacs") (buffer (make-instance 'standard-buffer))) (insert-buffer-sequence buffer 0 seq) (region-to-sequence (high-mark buffer) (low-mark buffer))) - #()) + "climacs") (deftest standard-buffer-region-to-sequence.test-3 (handler-case @@ -847,4 +863,4 @@ for i from 0 below 100000 do (insert-buffer-sequence b (floor (size b) 2) "abcdefghij") finally (return (size b))) - 1000000) \ No newline at end of file + 1000000) Index: climacs/buffer.lisp diff -u climacs/buffer.lisp:1.25 climacs/buffer.lisp:1.26 --- climacs/buffer.lisp:1.25 Sat Feb 5 08:04:03 2005 +++ climacs/buffer.lisp Sat Feb 5 14:49:20 2005 @@ -488,13 +488,23 @@ (defmethod region-to-sequence ((mark1 mark-mixin) (mark2 mark-mixin)) (assert (eq (buffer mark1) (buffer mark2))) - (buffer-sequence (buffer mark1) (offset mark1) (offset mark2))) + (let ((offset1 (offset mark1)) + (offset2 (offset mark2))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (buffer-sequence (buffer mark1) offset1 offset2))) -(defmethod region-to-sequence ((offset integer) (mark mark-mixin)) - (buffer-sequence (buffer mark) offset (offset mark))) +(defmethod region-to-sequence ((offset1 integer) (mark2 mark-mixin)) + (let ((offset2 (offset mark2))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (buffer-sequence (buffer mark2) offset1 offset2))) -(defmethod region-to-sequence ((mark mark-mixin) (offset integer)) - (buffer-sequence (buffer mark) (offset mark) offset)) +(defmethod region-to-sequence ((mark1 mark-mixin) (offset2 integer)) + (let ((offset1 (offset mark1))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (buffer-sequence (buffer mark1) offset1 offset2))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0