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

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

27 Feb '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv11262 Modified Files: delegating-buffer.lisp Log Message: Added description. Date: Sun Feb 27 20:16:16 2005 Author: abakic Index: climacs/delegating-buffer.lisp diff -u climacs/delegating-buffer.lisp:1.2 climacs/delegating-buffer.lisp:1.3 --- climacs/delegating-buffer.lisp:1.2 Sun Feb 27 20:15:27 2005 +++ climacs/delegating-buffer.lisp Sun Feb 27 20:16:14 2005 @@ -18,7 +18,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. -;;; GUI for the Climacs editor. +;;; Buffer class that allow specifying buffer implementation at run time. (in-package :climacs-buffer)

1 0

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

27 Feb '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv10897 Modified Files: delegating-buffer.lisp Log Message: Added license. Date: Sun Feb 27 20:15:28 2005 Author: abakic Index: climacs/delegating-buffer.lisp diff -u climacs/delegating-buffer.lisp:1.1 climacs/delegating-buffer.lisp:1.2 --- climacs/delegating-buffer.lisp:1.1 Sun Feb 27 20:02:15 2005 +++ climacs/delegating-buffer.lisp Sun Feb 27 20:15:27 2005 @@ -3,6 +3,23 @@ ;;; (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 +;;; License as published by the Free Software Foundation; either +;;; version 2 of the License, or (at your option) any later version. +;;; +;;; This library is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Library General Public License for more details. +;;; +;;; You should have received a copy of the GNU Library General Public +;;; License along with this library; if not, write to the +;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307 USA. + +;;; GUI for the Climacs editor. + (in-package :climacs-buffer) (defclass delegating-buffer (buffer)

1 0

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

27 Feb '05

Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv10718 Modified Files: climacs-internals.texi Log Message: Added descriptions of buffer-line-number and buffer-column-number. Date: Sun Feb 27 20:13:48 2005 Author: abakic Index: climacs/Doc/climacs-internals.texi diff -u climacs/Doc/climacs-internals.texi:1.13 climacs/Doc/climacs-internals.texi:1.14 --- climacs/Doc/climacs-internals.texi:1.13 Sat Feb 26 06:33:37 2005 +++ climacs/Doc/climacs-internals.texi Sun Feb 27 20:13:47 2005 @@ -305,12 +305,24 @@ end of the buffer), nil otherwise. @end deffn +@deffn {Generic Function} {buffer-line-number} buffer offset + +Return the line number of the line at offset. Lines are numbered from +zero. +@end deffn + +@deffn {Generic Function} {buffer-column-number} buffer offset + +Return the column number of the line at offset. It is the number of +objects between it and the preceding newline, or between it and the +beginning of the buffer if offset is on the first line of the buffer. +@end deffn + @deffn {Generic Function} {line-number} mark Return the line number of the mark. Lines are numbered from zero. @end deffn - @deffn {Generic Function} {column-number} mark Return the column number of the mark. The column number of a mark is @@ -318,7 +330,6 @@ between it and the beginning of the buffer if the mark is on the first line of the buffer. @end deffn - @section Inserting and deleting objects

1 0

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

27 Feb '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv10609 Added Files: delegating-buffer.lisp Log Message: Delegating-buffer class implementation. Date: Sun Feb 27 20:02:15 2005 Author: abakic

1 0

[climacs-cvs] CVS update: climacs/base-test.lisp climacs/buffer-test.lisp climacs/climacs.asd climacs/gui.lisp climacs/kill-ring.lisp climacs/packages.lisp climacs/pane.lisp
by abakic＠common-lisp.net 27 Feb '05

27 Feb '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv9768 Modified Files: base-test.lisp buffer-test.lisp climacs.asd gui.lisp kill-ring.lisp packages.lisp pane.lisp Log Message: package.lisp, pane.lisp: Added delegation-buffer class, allowing for dynamic buffer implementation choices. Modified climacs-buffer accordingly and added two extended buffer implementation classes and a few methods delegating undo and syntax functionality. Removed hard-coded uses of standard-buffer and standard mark classes. Modified :buffer arguments to syntax creation to make sure they are buffer implementations. gui.lisp: Removed obsolete region-limits. Modified :buffer arguments to syntax creation to make sure they are buffer implementations. Removed hard-coded uses of standard-buffer and standard mark classes. kill-ring.lisp: Fixed parameter order in (setf kill-ring-max-size). buffer-test.lisp, base-test.lisp: Added tests for delegating-standard-buffer. Replaced all but two mark instantiations with calls to clone-mark. Date: Sun Feb 27 19:52:01 2005 Author: abakic Index: climacs/base-test.lisp diff -u climacs/base-test.lisp:1.11 climacs/base-test.lisp:1.12 --- climacs/base-test.lisp:1.11 Fri Feb 25 21:45:07 2005 +++ climacs/base-test.lisp Sun Feb 27 19:52:00 2005 @@ -10,8 +10,8 @@ (insert-buffer-sequence buffer 0 "climacs climacs climacs") - (let ((mark (make-instance %%left-sticky-mark - :buffer buffer :offset 16))) + (let ((mark (clone-mark (low-mark buffer) :left))) + (setf (offset mark) 16) (previous-line mark nil 2) (offset mark))) 0) @@ -21,8 +21,8 @@ (insert-buffer-sequence buffer 0 "climacs climacs climacs") - (let ((mark (make-instance %%right-sticky-mark - :buffer buffer :offset 19))) + (let ((mark (clone-mark (low-mark buffer) :right))) + (setf (offset mark) 19) (previous-line mark 2 2) (offset mark))) 2) @@ -31,8 +31,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance %%left-sticky-mark - :buffer buffer :offset 7))) + (let ((mark (clone-mark (low-mark buffer) :left))) + (setf (offset mark) 7) (previous-line mark) (offset mark))) 7) @@ -41,8 +41,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance %%right-sticky-mark - :buffer buffer :offset 7))) + (let ((mark (clone-mark (low-mark buffer) :right))) + (setf (offset mark) 7) (previous-line mark 2) (offset mark))) 2) @@ -51,8 +51,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance %%left-sticky-mark - :buffer buffer :offset 0))) + (let ((mark (clone-mark (low-mark buffer) :left))) + (setf (offset mark) 0) (previous-line mark) (offset mark))) 0) @@ -61,8 +61,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance %%right-sticky-mark - :buffer buffer :offset 0))) + (let ((mark (clone-mark (low-mark buffer) :right))) + (setf (offset mark) 0) (previous-line mark 2) (offset mark))) 2) @@ -71,8 +71,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs2") - (let ((mark (make-instance %%left-sticky-mark - :buffer buffer :offset 15))) + (let ((mark (clone-mark (low-mark buffer) :left))) + (setf (offset mark) 15) (previous-line mark) (offset mark))) 7) @@ -82,8 +82,8 @@ (insert-buffer-sequence buffer 0 "climacs climacs climacs") - (let ((mark (make-instance %%left-sticky-mark - :buffer buffer :offset 6))) + (let ((mark (clone-mark (low-mark buffer) :left))) + (setf (offset mark) 6) (next-line mark nil 2) (offset mark))) 22) @@ -93,8 +93,8 @@ (insert-buffer-sequence buffer 0 "climacs climacs climacs") - (let ((mark (make-instance %%right-sticky-mark - :buffer buffer :offset 3))) + (let ((mark (clone-mark (low-mark buffer) :right))) + (setf (offset mark) 3) (next-line mark 2 2) (offset mark))) 18) @@ -103,8 +103,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance %%left-sticky-mark - :buffer buffer :offset 8))) + (let ((mark (clone-mark (low-mark buffer) :left))) + (setf (offset mark) 8) (next-line mark) (offset mark))) 8) @@ -113,8 +113,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance %%right-sticky-mark - :buffer buffer :offset 8))) + (let ((mark (clone-mark (low-mark buffer) :right))) + (setf (offset mark) 8) (next-line mark 2) (offset mark))) 10) @@ -123,8 +123,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance %%left-sticky-mark - :buffer buffer :offset 15))) + (let ((mark (clone-mark (low-mark buffer) :left))) + (setf (offset mark) 15) (next-line mark) (offset mark))) 15) @@ -133,8 +133,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance %%right-sticky-mark - :buffer buffer :offset 15))) + (let ((mark (clone-mark (low-mark buffer) :right))) + (setf (offset mark) 15) (next-line mark 2) (offset mark))) 10) @@ -143,8 +143,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance %%left-sticky-mark - :buffer buffer :offset 0))) + (let ((mark (clone-mark (low-mark buffer) :left))) + (setf (offset mark) 0) (next-line mark) (offset mark))) 8) @@ -152,8 +152,8 @@ (defmultitest open-line.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((mark (make-instance %%left-sticky-mark - :buffer buffer :offset 0))) + (let ((mark (clone-mark (low-mark buffer) :left))) + (setf (offset mark) 0) (open-line mark 2) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) " @@ -163,8 +163,8 @@ (defmultitest open-line.test-2 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((mark (make-instance %%right-sticky-mark - :buffer buffer :offset 0))) + (let ((mark (clone-mark (low-mark buffer) :right))) + (setf (offset mark) 0) (open-line mark) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) " @@ -173,8 +173,8 @@ (defmultitest open-line.test-3 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((mark (make-instance %%left-sticky-mark - :buffer buffer :offset 7))) + (let ((mark (clone-mark (low-mark buffer) :left))) + (setf (offset mark) 7) (open-line mark) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) "climacs @@ -183,8 +183,8 @@ (defmultitest open-line.test-4 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((mark (make-instance %%right-sticky-mark - :buffer buffer :offset 7))) + (let ((mark (clone-mark (low-mark buffer) :right))) + (setf (offset mark) 7) (open-line mark) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) "climacs @@ -193,8 +193,8 @@ (defmultitest kill-line.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((mark (make-instance %%left-sticky-mark - :buffer buffer :offset 0))) + (let ((mark (clone-mark (low-mark buffer) :left))) + (setf (offset mark) 0) (kill-line mark) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) #() 0) @@ -202,8 +202,8 @@ (defmultitest kill-line.test-2 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((mark (make-instance %%right-sticky-mark - :buffer buffer :offset 0))) + (let ((mark (clone-mark (low-mark buffer) :right))) + (setf (offset mark) 0) (kill-line mark) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) #() 0) @@ -211,8 +211,8 @@ (defmultitest kill-line.test-3 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((mark (make-instance %%left-sticky-mark - :buffer buffer :offset 7))) + (let ((mark (clone-mark (low-mark buffer) :left))) + (setf (offset mark) 7) (kill-line mark) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) "climacs" 7) @@ -220,8 +220,8 @@ (defmultitest kill-line.test-4 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((mark (make-instance %%right-sticky-mark - :buffer buffer :offset 7))) + (let ((mark (clone-mark (low-mark buffer) :right))) + (setf (offset mark) 7) (kill-line mark) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) "climacs" 7) @@ -230,8 +230,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance %%left-sticky-mark - :buffer buffer :offset 7))) + (let ((mark (clone-mark (low-mark buffer) :left))) + (setf (offset mark) 7) (kill-line mark) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) "climacsclimacs" 7) @@ -240,34 +240,32 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance %%right-sticky-mark - :buffer buffer :offset 7))) + (let ((mark (clone-mark (low-mark buffer) :right))) + (setf (offset mark) 7) (kill-line mark) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) "climacsclimacs" 7) (defmultitest empty-line-p.test-1 (let* ((buffer (make-instance %%buffer)) - (m1 (make-instance %%left-sticky-mark :buffer buffer)) - (m2 (make-instance %%right-sticky-mark :buffer buffer))) + (m1 (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :right))) (values (empty-line-p m1) (empty-line-p m2))) t t) (defmultitest empty-line-p.test-2 (let ((buffer (make-instance %%buffer))) (insert-buffer-object buffer 0 #\a) - (let ((m1 (make-instance %%left-sticky-mark :buffer buffer)) - (m2 (make-instance %%right-sticky-mark :buffer buffer))) + (let ((m1 (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :right))) (values (empty-line-p m1) (empty-line-p m2)))) nil nil) (defmultitest empty-line-p.test-3 (let ((buffer (make-instance %%buffer))) (insert-buffer-object buffer 0 #\a) - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 1)) - (m2 (make-instance %%right-sticky-mark - :buffer buffer :offset 1))) + (let ((m1 (clone-mark (high-mark buffer) :left)) + (m2 (clone-mark (high-mark buffer) :right))) (values (empty-line-p m1) (empty-line-p m2)))) nil nil) @@ -275,24 +273,24 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "a b") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 1)) - (m2 (make-instance %%right-sticky-mark - :buffer buffer :offset 1))) + (let ((m1 (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :right))) + (setf (offset m1) 1 + (offset m2) 1) (values (empty-line-p m1) (empty-line-p m2)))) nil nil) (defmultitest line-indentation.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 0)) - (m2 (make-instance %%right-sticky-mark - :buffer buffer :offset 0)) - (m3 (make-instance %%left-sticky-mark - :buffer buffer :offset 10)) - (m4 (make-instance %%right-sticky-mark - :buffer buffer :offset 10))) + (let ((m1 (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :right)) + (m3 (clone-mark (low-mark buffer) :left)) + (m4 (clone-mark (low-mark buffer) :right))) + (setf (offset m1) 0 + (offset m2) 0 + (offset m3) 10 + (offset m4) 10) (values (line-indentation m1 8) (line-indentation m2 8) @@ -307,14 +305,14 @@ (defmultitest line-indentation.test-2 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 0)) - (m2 (make-instance %%right-sticky-mark - :buffer buffer :offset 0)) - (m3 (make-instance %%left-sticky-mark - :buffer buffer :offset 11)) - (m4 (make-instance %%right-sticky-mark - :buffer buffer :offset 11))) + (let ((m1 (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :right)) + (m3 (clone-mark (low-mark buffer) :left)) + (m4 (clone-mark (low-mark buffer) :right))) + (setf (offset m1) 0 + (offset m2) 0 + (offset m3) 11 + (offset m4) 11) (values (line-indentation m1 8) (line-indentation m2 8) @@ -329,14 +327,14 @@ (defmultitest line-indentation.test-3 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs ") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 0)) - (m2 (make-instance %%right-sticky-mark - :buffer buffer :offset 0)) - (m3 (make-instance %%left-sticky-mark - :buffer buffer :offset 11)) - (m4 (make-instance %%right-sticky-mark - :buffer buffer :offset 11))) + (let ((m1 (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :right)) + (m3 (clone-mark (low-mark buffer) :left)) + (m4 (clone-mark (low-mark buffer) :right))) + (setf (offset m1) 0 + (offset m2) 0 + (offset m3) 11 + (offset m4) 11) (values (line-indentation m1 8) (line-indentation m2 8) @@ -380,30 +378,30 @@ climacs climacs ") - (let ((m1l (make-instance %%left-sticky-mark - :buffer buffer :offset 0)) - (m1r (make-instance %%right-sticky-mark - :buffer buffer :offset 0)) - (m2l (make-instance %%left-sticky-mark - :buffer buffer :offset 1)) - (m2r (make-instance %%left-sticky-mark - :buffer buffer :offset 1)) - (m3l (make-instance %%left-sticky-mark - :buffer buffer :offset 3)) - (m3r (make-instance %%right-sticky-mark - :buffer buffer :offset 3)) - (m4l (make-instance %%left-sticky-mark - :buffer buffer :offset 8)) - (m4r (make-instance %%right-sticky-mark - :buffer buffer :offset 8)) - (m5l (make-instance %%left-sticky-mark - :buffer buffer :offset 15)) - (m5r (make-instance %%right-sticky-mark - :buffer buffer :offset 15)) - (m6l (make-instance %%left-sticky-mark - :buffer buffer :offset 16)) - (m6r (make-instance %%right-sticky-mark - :buffer buffer :offset 16))) + (let ((m1l (clone-mark (low-mark buffer) :left)) + (m1r (clone-mark (low-mark buffer) :right)) + (m2l (clone-mark (low-mark buffer) :left)) + (m2r (clone-mark (low-mark buffer) :right)) + (m3l (clone-mark (low-mark buffer) :left)) + (m3r (clone-mark (low-mark buffer) :right)) + (m4l (clone-mark (low-mark buffer) :left)) + (m4r (clone-mark (low-mark buffer) :right)) + (m5l (clone-mark (low-mark buffer) :left)) + (m5r (clone-mark (low-mark buffer) :right)) + (m6l (clone-mark (low-mark buffer) :left)) + (m6r (clone-mark (low-mark buffer) :right))) + (setf (offset m1l) 0 + (offset m1r) 0 + (offset m2l) 1 + (offset m2r) 1 + (offset m3l) 3 + (offset m3r) 3 + (offset m4l) 8 + (offset m4r) 8 + (offset m5l) 15 + (offset m5r) 15 + (offset m6l) 16 + (offset m6r) 16) (values (number-of-lines-in-region m1l m1r) (number-of-lines-in-region m1r m1l) @@ -429,14 +427,14 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((m1l (make-instance %%left-sticky-mark - :buffer buffer :offset 6)) - (m1r (make-instance %%right-sticky-mark - :buffer buffer :offset 6)) - (m2l (make-instance %%left-sticky-mark - :buffer buffer :offset 7)) - (m2r (make-instance %%right-sticky-mark - :buffer buffer :offset 7))) + (let ((m1l (clone-mark (low-mark buffer) :left)) + (m1r (clone-mark (low-mark buffer) :right)) + (m2l (clone-mark (low-mark buffer) :left)) + (m2r (clone-mark (low-mark buffer) :right))) + (setf (offset m1l) 6 + (offset m1r) 6 + (offset m2l) 7 + (offset m2r) 7) (values (number-of-lines-in-region m1l 10) (number-of-lines-in-region 10 m1l) @@ -473,18 +471,18 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs climacs") - (let ((m0l (make-instance %%left-sticky-mark - :buffer buffer :offset 0)) - (m0r (make-instance %%right-sticky-mark - :buffer buffer :offset 0)) - (m1l (make-instance %%left-sticky-mark - :buffer buffer :offset 5)) - (m1r (make-instance %%right-sticky-mark - :buffer buffer :offset 5)) - (m2l (make-instance %%left-sticky-mark - :buffer buffer :offset 17)) - (m2r (make-instance %%right-sticky-mark - :buffer buffer :offset 17))) + (let ((m0l (clone-mark (low-mark buffer) :left)) + (m0r (clone-mark (low-mark buffer) :right)) + (m1l (clone-mark (low-mark buffer) :left)) + (m1r (clone-mark (low-mark buffer) :right)) + (m2l (clone-mark (low-mark buffer) :left)) + (m2r (clone-mark (low-mark buffer) :right))) + (setf (offset m0l) 0 + (offset m0r) 0 + (offset m1l) 5 + (offset m1r) 5 + (offset m2l) 17 + (offset m2r) 17) (values (progn (climacs-base::forward-to-word-boundary m0l) (offset m0l)) (progn (climacs-base::forward-to-word-boundary m0r) (offset m0r)) @@ -498,18 +496,18 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs ") - (let ((m0l (make-instance %%left-sticky-mark - :buffer buffer :offset 17)) - (m0r (make-instance %%right-sticky-mark - :buffer buffer :offset 17)) - (m1l (make-instance %%left-sticky-mark - :buffer buffer :offset 10)) - (m1r (make-instance %%right-sticky-mark - :buffer buffer :offset 10)) - (m2l (make-instance %%left-sticky-mark - :buffer buffer :offset 0)) - (m2r (make-instance %%right-sticky-mark - :buffer buffer :offset 0))) + (let ((m0l (clone-mark (low-mark buffer) :left)) + (m0r (clone-mark (low-mark buffer) :right)) + (m1l (clone-mark (low-mark buffer) :left)) + (m1r (clone-mark (low-mark buffer) :right)) + (m2l (clone-mark (low-mark buffer) :left)) + (m2r (clone-mark (low-mark buffer) :right))) + (setf (offset m0l) 17 + (offset m0r) 17 + (offset m1l) 10 + (offset m1r) 10 + (offset m2l) 0 + (offset m2r) 0) (values (progn (climacs-base::backward-to-word-boundary m0l) (offset m0l)) (progn (climacs-base::backward-to-word-boundary m0r) (offset m0r)) @@ -523,18 +521,18 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs climacs") - (let ((m0l (make-instance %%left-sticky-mark - :buffer buffer :offset 0)) - (m0r (make-instance %%right-sticky-mark - :buffer buffer :offset 0)) - (m1l (make-instance %%left-sticky-mark - :buffer buffer :offset 5)) - (m1r (make-instance %%right-sticky-mark - :buffer buffer :offset 15)) - (m2l (make-instance %%left-sticky-mark - :buffer buffer :offset 17)) - (m2r (make-instance %%right-sticky-mark - :buffer buffer :offset 17))) + (let ((m0l (clone-mark (low-mark buffer) :left)) + (m0r (clone-mark (low-mark buffer) :right)) + (m1l (clone-mark (low-mark buffer) :left)) + (m1r (clone-mark (low-mark buffer) :right)) + (m2l (clone-mark (low-mark buffer) :left)) + (m2r (clone-mark (low-mark buffer) :right))) + (setf (offset m0l) 0 + (offset m0r) 0 + (offset m1l) 5 + (offset m1r) 15 + (offset m2l) 17 + (offset m2r) 17) (values (progn (forward-word m0l) (offset m0l)) (progn (forward-word m0r) (offset m0r)) @@ -548,18 +546,18 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs ") - (let ((m0l (make-instance %%left-sticky-mark - :buffer buffer :offset 17)) - (m0r (make-instance %%right-sticky-mark - :buffer buffer :offset 17)) - (m1l (make-instance %%left-sticky-mark - :buffer buffer :offset 10)) - (m1r (make-instance %%right-sticky-mark - :buffer buffer :offset 5)) - (m2l (make-instance %%left-sticky-mark - :buffer buffer :offset 0)) - (m2r (make-instance %%right-sticky-mark - :buffer buffer :offset 0))) + (let ((m0l (clone-mark (low-mark buffer) :left)) + (m0r (clone-mark (low-mark buffer) :right)) + (m1l (clone-mark (low-mark buffer) :left)) + (m1r (clone-mark (low-mark buffer) :right)) + (m2l (clone-mark (low-mark buffer) :left)) + (m2r (clone-mark (low-mark buffer) :right))) + (setf (offset m0l) 17 + (offset m0r) 17 + (offset m1l) 10 + (offset m1r) 5 + (offset m2l) 0 + (offset m2r) 0) (values (progn (backward-word m0l) (offset m0l)) (progn (backward-word m0r) (offset m0r)) @@ -572,8 +570,8 @@ (defmultitest delete-word.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 3))) + (let ((m (clone-mark (low-mark buffer) :left))) + (setf (offset m) 3) (delete-word m) (values (buffer-sequence buffer 0 (size buffer)) @@ -583,8 +581,8 @@ (defmultitest delete-word.test-2 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs climacs") - (let ((m (make-instance %%right-sticky-mark - :buffer buffer :offset 0))) + (let ((m (clone-mark (low-mark buffer) :right))) + (setf (offset m) 0) (delete-word m 2) (values (buffer-sequence buffer 0 (size buffer)) @@ -594,8 +592,8 @@ (defmultitest backward-delete-word.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 3))) + (let ((m (clone-mark (low-mark buffer) :left))) + (setf (offset m) 3) (backward-delete-word m) (values (buffer-sequence buffer 0 (size buffer)) @@ -605,8 +603,8 @@ (defmultitest backward-delete-word.test-2 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs ") - (let ((m (make-instance %%right-sticky-mark - :buffer buffer :offset 17))) + (let ((m (clone-mark (low-mark buffer) :right))) + (setf (offset m) 17) (backward-delete-word m 2) (values (buffer-sequence buffer 0 (size buffer)) @@ -616,12 +614,12 @@ (defmultitest previous-word.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((m0 (make-instance %%right-sticky-mark - :buffer buffer :offset 7)) - (m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 8)) - (m2 (make-instance %%right-sticky-mark - :buffer buffer :offset 10))) + (let ((m0 (clone-mark (low-mark buffer) :right)) + (m1 (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :right))) + (setf (offset m0) 7 + (offset m1) 8 + (offset m2) 10) (values (climacs-base::previous-word m0) (climacs-base::previous-word m1) @@ -638,10 +636,10 @@ (defmultitest downcase-region.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "_Cli mac5_") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 1)) - (m2 (make-instance %%right-sticky-mark - :buffer buffer :offset 8))) + (let ((m1 (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :right))) + (setf (offset m1) 1 + (offset m2) 8) (downcase-region m2 m1) (buffer-sequence buffer 0 (size buffer)))) "_cli mac5_") @@ -649,8 +647,8 @@ (defmultitest downcase-region.test-2 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "_Cli mac5_") - (let ((m1 (make-instance %%right-sticky-mark - :buffer buffer :offset 1))) + (let ((m1 (clone-mark (low-mark buffer) :right))) + (setf (offset m1) 1) (downcase-region 8 m1) (buffer-sequence buffer 0 (size buffer)))) "_cli mac5_") @@ -658,8 +656,8 @@ (defmultitest downcase-region.test-3 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "_Cli mac5_") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 8))) + (let ((m1 (clone-mark (low-mark buffer) :left))) + (setf (offset m1) 8) (downcase-region 1 m1) (buffer-sequence buffer 0 (size buffer)))) "_cli mac5_") @@ -667,8 +665,8 @@ (defmultitest downcase-word.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "CLI MA CS CLIMACS") - (let ((m (make-instance %%right-sticky-mark - :buffer buffer :offset 0))) + (let ((m (clone-mark (low-mark buffer) :right))) + (setf (offset m) 0) (downcase-word m 3) (values (buffer-sequence buffer 0 (size buffer)) @@ -685,10 +683,10 @@ (defmultitest upcase-region.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "_Cli mac5_") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 1)) - (m2 (make-instance %%right-sticky-mark - :buffer buffer :offset 8))) + (let ((m1 (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :right))) + (setf (offset m1) 1 + (offset m2) 8) (upcase-region m2 m1) (buffer-sequence buffer 0 (size buffer)))) "_CLI MAC5_") @@ -696,8 +694,8 @@ (defmultitest upcase-region.test-2 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "_Cli mac5_") - (let ((m1 (make-instance %%right-sticky-mark - :buffer buffer :offset 1))) + (let ((m1 (clone-mark (low-mark buffer) :right))) + (setf (offset m1) 1) (upcase-region 8 m1) (buffer-sequence buffer 0 (size buffer)))) "_CLI MAC5_") @@ -705,8 +703,8 @@ (defmultitest upcase-region.test-3 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "_Cli mac5_") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 8))) + (let ((m1 (clone-mark (low-mark buffer) :left))) + (setf (offset m1) 8) (upcase-region 1 m1) (buffer-sequence buffer 0 (size buffer)))) "_CLI MAC5_") @@ -714,8 +712,8 @@ (defmultitest upcase-word.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "cli ma cs climacs") - (let ((m (make-instance %%right-sticky-mark - :buffer buffer :offset 0))) + (let ((m (clone-mark (low-mark buffer) :right))) + (setf (offset m) 0) (upcase-word m 3) (values (buffer-sequence buffer 0 (size buffer)) @@ -739,10 +737,10 @@ (defmultitest capitalize-region.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "_Cli mac5_") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 1)) - (m2 (make-instance %%right-sticky-mark - :buffer buffer :offset 8))) + (let ((m1 (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :right))) + (setf (offset m1) 1 + (offset m2) 8) (capitalize-region m2 m1) (buffer-sequence buffer 0 (size buffer)))) "_Cli Mac5_") @@ -750,8 +748,8 @@ (defmultitest capitalize-region.test-2 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "_Cli mac5_") - (let ((m1 (make-instance %%right-sticky-mark - :buffer buffer :offset 1))) + (let ((m1 (clone-mark (low-mark buffer) :right))) + (setf (offset m1) 1) (capitalize-region 8 m1) (buffer-sequence buffer 0 (size buffer)))) "_Cli Mac5_") @@ -759,8 +757,8 @@ (defmultitest capitalize-region.test-3 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "_Cli mac5_") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 8))) + (let ((m1 (clone-mark (low-mark buffer) :left))) + (setf (offset m1) 8) (capitalize-region 1 m1) (buffer-sequence buffer 0 (size buffer)))) "_Cli Mac5_") @@ -768,8 +766,8 @@ (defmultitest capitalize-word.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "cli ma cs climacs") - (let ((m (make-instance %%right-sticky-mark - :buffer buffer :offset 0))) + (let ((m (clone-mark (low-mark buffer) :right))) + (setf (offset m) 0) (capitalize-word m 3) (values (buffer-sequence buffer 0 (size buffer)) @@ -793,10 +791,10 @@ (defmultitest tabify-region.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "clim acs") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 3)) - (m2 (make-instance %%right-sticky-mark - :buffer buffer :offset 7))) + (let ((m1 (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :right))) + (setf (offset m1) 3 + (offset m2) 7) (tabify-region m2 m1 4) (buffer-sequence buffer 0 (size buffer)))) "clim acs") @@ -804,8 +802,8 @@ (defmultitest tabify-region.test-2 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "clim acs") - (let ((m1 (make-instance %%right-sticky-mark - :buffer buffer :offset 3))) + (let ((m1 (clone-mark (low-mark buffer) :right))) + (setf (offset m1) 3) (tabify-region 7 m1 4) (buffer-sequence buffer 0 (size buffer)))) "clim acs") @@ -813,8 +811,8 @@ (defmultitest tabify-region.test-3 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "clim acs") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 7))) + (let ((m1 (clone-mark (low-mark buffer) :left))) + (setf (offset m1) 7) (tabify-region 3 m1 4) (buffer-sequence buffer 0 (size buffer)))) "clim acs") @@ -836,10 +834,10 @@ (defmultitest untabify-region.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "clim acs") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 3)) - (m2 (make-instance %%right-sticky-mark - :buffer buffer :offset 5))) + (let ((m1 (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :right))) + (setf (offset m1) 3 + (offset m2) 5) (untabify-region m2 m1 4) (buffer-sequence buffer 0 (size buffer)))) "clim acs") @@ -847,8 +845,8 @@ (defmultitest untabify-region.test-2 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "clim acs") - (let ((m1 (make-instance %%right-sticky-mark - :buffer buffer :offset 3))) + (let ((m1 (clone-mark (low-mark buffer) :right))) + (setf (offset m1) 3) (untabify-region 5 m1 4) (buffer-sequence buffer 0 (size buffer)))) "clim acs") @@ -856,8 +854,8 @@ (defmultitest untabify-region.test-3 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "clim acs") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 5))) + (let ((m1 (clone-mark (low-mark buffer) :left))) + (setf (offset m1) 5) (untabify-region 3 m1 4) (buffer-sequence buffer 0 (size buffer)))) "clim acs") @@ -865,8 +863,8 @@ (defmultitest indent-line.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs ") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 3))) + (let ((m (clone-mark (low-mark buffer) :left))) + (setf (offset m) 3) (indent-line m 4 nil) (values (offset m) @@ -876,8 +874,8 @@ (defmultitest indent-line.test-2 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs ") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 4))) + (let ((m (clone-mark (low-mark buffer) :left))) + (setf (offset m) 4) (indent-line m 5 4) (values (offset m) @@ -887,8 +885,8 @@ (defmultitest indent-line.test-3 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs ") - (let ((m (make-instance %%right-sticky-mark - :buffer buffer :offset 3))) + (let ((m (clone-mark (low-mark buffer) :right))) + (setf (offset m) 3) (indent-line m 5 4) (values (offset m) @@ -899,8 +897,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs ") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 3))) + (let ((m (clone-mark (low-mark buffer) :left))) + (setf (offset m) 3) (delete-indentation m) (values (offset m) @@ -911,8 +909,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs ") - (let ((m (make-instance %%right-sticky-mark - :buffer buffer :offset 7))) + (let ((m (clone-mark (low-mark buffer) :right))) + (setf (offset m) 7) (delete-indentation m) (values (offset m) @@ -922,8 +920,8 @@ (defmultitest delete-indentation.test-3 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs ") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 7))) + (let ((m (clone-mark (low-mark buffer) :left))) + (setf (offset m) 7) (delete-indentation m) (values (offset m) @@ -934,8 +932,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs ") - (let ((m (make-instance %%right-sticky-mark - :buffer buffer :offset 12))) + (let ((m (clone-mark (low-mark buffer) :right))) + (setf (offset m) 12) (delete-indentation m) (values (offset m) @@ -947,8 +945,8 @@ (insert-buffer-sequence buffer 0 " climacs ") - (let ((m (make-instance %%right-sticky-mark - :buffer buffer :offset 12))) + (let ((m (clone-mark (low-mark buffer) :right))) + (setf (offset m) 12) (delete-indentation m) (values (offset m) @@ -959,8 +957,8 @@ (defmultitest fill-line.test-1 (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))) + (let ((m (clone-mark (low-mark buffer) :right))) + (setf (offset m) 25) (fill-line m #'(lambda (m) (declare (ignore m)) 8) 10 8) (values (offset m) @@ -972,8 +970,8 @@ (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))) + (let ((m (clone-mark (low-mark buffer) :right))) + (setf (offset m) 25) (fill-line m #'(lambda (m) (declare (ignore m)) 8) 10 8 nil) (values (offset m) @@ -985,8 +983,8 @@ (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))) + (let ((m (clone-mark (low-mark buffer) :left))) + (setf (offset m) 25) (fill-line m #'(lambda (m) (declare (ignore m)) 8) 10 8) (values (offset m) @@ -998,8 +996,8 @@ (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))) + (let ((m (clone-mark (low-mark buffer) :left))) + (setf (offset m) 25) (fill-line m #'(lambda (m) (declare (ignore m)) 8) 10 8 nil) (values (offset m) @@ -1011,8 +1009,8 @@ (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))) + (let ((m (clone-mark (low-mark buffer) :right))) + (setf (offset m) 1) (fill-line m #'(lambda (m) (declare (ignore m)) 8) 0 8) (values (offset m) @@ -1022,8 +1020,8 @@ (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))) + (let ((m (clone-mark (low-mark buffer) :right))) + (setf (offset m) 1) (fill-line m #'(lambda (m) (declare (ignore m)) 8) 0 8 nil) (values (offset m) @@ -1057,10 +1055,10 @@ (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))) + (let ((m1 (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :right))) + (setf (offset m1) 1 + (offset m2) 3) (values (looking-at m1 "lima") (looking-at m2 "mac") @@ -1108,8 +1106,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 0))) + (let ((m (clone-mark (low-mark buffer) :left))) + (setf (offset m) 0) (search-forward m "Mac" :test #'char-equal) (offset m))) 7) @@ -1117,8 +1115,8 @@ (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))) + (let ((m (clone-mark (low-mark buffer) :right))) + (setf (offset m) 3) (search-forward m "Mac" :test #'char-equal) (offset m))) 6) @@ -1126,8 +1124,8 @@ (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))) + (let ((m (clone-mark (low-mark buffer) :right))) + (setf (offset m) 3) (search-forward m "klimaks") (offset m))) 3) @@ -1136,8 +1134,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs ") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 8))) + (let ((m (clone-mark (low-mark buffer) :left))) + (setf (offset m) 8) (search-backward m "Mac" :test #'char-equal) (offset m))) 3) @@ -1145,8 +1143,8 @@ (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))) + (let ((m (clone-mark (low-mark buffer) :right))) + (setf (offset m) 6) (search-backward m "Mac" :test #'char-equal) (offset m))) 3) @@ -1154,8 +1152,8 @@ (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))) + (let ((m (clone-mark (low-mark buffer) :right))) + (setf (offset m) 3) (search-backward m "klimaks") (offset m))) 3) @@ -1182,4 +1180,4 @@ (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) + 0 nil nil nil 8) \ No newline at end of file Index: climacs/buffer-test.lisp diff -u climacs/buffer-test.lisp:1.17 climacs/buffer-test.lisp:1.18 --- climacs/buffer-test.lisp:1.17 Fri Feb 25 21:45:07 2005 +++ climacs/buffer-test.lisp Sun Feb 27 19:52:01 2005 @@ -8,6 +8,9 @@ (cl:in-package :climacs-tests) +(defclass delegating-standard-buffer (delegating-buffer) () + (:default-initargs :implementation (make-instance 'standard-buffer))) + (defmacro defmultitest (name form &rest results) (let ((name-string (symbol-name name))) (flet ((%deftest-wrapper (bc lsm rsm tn f rs) @@ -26,6 +29,13 @@ form results) ,(%deftest-wrapper + ''delegating-standard-buffer + ''standard-left-sticky-mark + ''standard-right-sticky-mark + (intern (concatenate 'string "DELEGATING-STANDARD-BUFFER-" name-string)) + form + results) + ,(%deftest-wrapper ''binseq-buffer ''persistent-left-sticky-mark ''persistent-right-sticky-mark @@ -42,13 +52,12 @@ (defmultitest buffer-make-instance.test-1 (let* ((buffer (make-instance %%buffer)) - (low (slot-value buffer 'low-mark)) - (high (slot-value buffer 'high-mark))) + (low (low-mark buffer)) + (high (low-mark buffer))) (and (= (offset low) 0) (= (offset high) 0) (null (modified-p buffer)) - (eq (buffer low) buffer) - (eq (buffer high) buffer))) + (eq (buffer low) (buffer high)))) t) (defmultitest mark-make-instance.test-1 @@ -73,8 +82,8 @@ ((null x) nil) (t (when (eq x y) y))))) (let* ((buffer (make-instance %%buffer)) - (low (slot-value buffer 'low-mark)) - (high (slot-value buffer 'high-mark)) + (low (low-mark buffer)) + (high (high-mark buffer)) (low2 (clone-mark low)) (high2 (clone-mark high)) (low3 (clone-mark high :left)) @@ -241,11 +250,10 @@ (defmultitest insert-object.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 3))) + (let ((m (clone-mark (low-mark buffer) :left))) + (setf (offset m) 3) (insert-object m #\X) (and (= (size buffer) 8) - (eq (buffer m) buffer) (= (offset m) 3) (buffer-sequence buffer 0 8)))) "cliXmacs") @@ -253,11 +261,10 @@ (defmultitest insert-object.test-2 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance %%right-sticky-mark - :buffer buffer :offset 3))) + (let ((m (clone-mark (low-mark buffer) :right))) + (setf (offset m) 3) (insert-object m #\X) (and (= (size buffer) 8) - (eq (buffer m) buffer) (= (offset m) 4) (buffer-sequence buffer 0 8)))) "cliXmacs") @@ -265,13 +272,13 @@ (defmultitest insert-sequence.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 3)) - (m2 (make-instance %%left-sticky-mark - :buffer buffer :offset 5))) + (let ((m (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :left))) + (setf (offset m) 3 + (offset m2) 5) (insert-sequence m "ClimacS") (and (= (size buffer) 14) - (eq (buffer m) buffer) + (eq (buffer m) (buffer m2)) (= (offset m) 3) (= (offset m2) 12) (buffer-sequence buffer 0 14)))) @@ -280,13 +287,13 @@ (defmultitest insert-sequence.test-2 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance %%right-sticky-mark - :buffer buffer :offset 3)) - (m2 (make-instance %%right-sticky-mark - :buffer buffer :offset 5))) + (let ((m (clone-mark (low-mark buffer) :right)) + (m2 (clone-mark (low-mark buffer) :right))) + (setf (offset m) 3 + (offset m2) 5) (insert-sequence m "ClimacS") (and (= (size buffer) 14) - (eq (buffer m) buffer) + (eq (buffer m) (buffer m2)) (= (offset m) 10) (= (offset m2) 12) (buffer-sequence buffer 0 14)))) @@ -295,14 +302,13 @@ (defmultitest delete-range.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 3)) - (m2 (make-instance %%left-sticky-mark - :buffer buffer :offset 5))) + (let ((m (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :left))) + (setf (offset m) 3 + (offset m2) 5) (delete-range m 2) (and (= (size buffer) 5) - (eq (buffer m) buffer) - (eq (buffer m2) buffer) + (eq (buffer m) (buffer m2)) (= (offset m) 3) (= (offset m2) 3) (buffer-sequence buffer 0 5)))) @@ -311,14 +317,13 @@ (defmultitest delete-range.test-2 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance %%right-sticky-mark - :buffer buffer :offset 3)) - (m2 (make-instance %%right-sticky-mark - :buffer buffer :offset 5))) + (let ((m (clone-mark (low-mark buffer) :right)) + (m2 (clone-mark (low-mark buffer) :right))) + (setf (offset m) 3 + (offset m2) 5) (delete-range m -2) (and (= (size buffer) 5) - (eq (buffer m) buffer) - (eq (buffer m2) buffer) + (eq (buffer m) (buffer m2)) (= (offset m) 1) (= (offset m2) 3) (buffer-sequence buffer 0 5)))) @@ -327,14 +332,13 @@ (defmultitest delete-region.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 3)) - (m2 (make-instance %%left-sticky-mark - :buffer buffer :offset 5))) + (let ((m (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :left))) + (setf (offset m) 3 + (offset m2) 5) (delete-region m m2) (and (= (size buffer) 5) - (eq (buffer m) buffer) - (eq (buffer m2) buffer) + (eq (buffer m) (buffer m2)) (= (offset m) 3) (= (offset m2) 3) (buffer-sequence buffer 0 5)))) @@ -343,14 +347,13 @@ (defmultitest delete-region.test-2 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance %%right-sticky-mark - :buffer buffer :offset 3)) - (m2 (make-instance %%right-sticky-mark - :buffer buffer :offset 5))) + (let ((m (clone-mark (low-mark buffer) :right)) + (m2 (clone-mark (low-mark buffer) :right))) + (setf (offset m) 3 + (offset m2) 5) (delete-region m m2) (and (= (size buffer) 5) - (eq (buffer m) buffer) - (eq (buffer m2) buffer) + (eq (buffer m) (buffer m2)) (= (offset m) 3) (= (offset m2) 3) (buffer-sequence buffer 0 5)))) @@ -359,14 +362,13 @@ (defmultitest delete-region.test-3 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 3)) - (m2 (make-instance %%left-sticky-mark - :buffer buffer :offset 5))) + (let ((m (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :left))) + (setf (offset m) 3 + (offset m2) 5) (delete-region m2 m) (and (= (size buffer) 5) - (eq (buffer m) buffer) - (eq (buffer m2) buffer) + (eq (buffer m) (buffer m2)) (= (offset m) 3) (= (offset m2) 3) (buffer-sequence buffer 0 5)))) @@ -375,14 +377,13 @@ (defmultitest delete-region.test-4 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance %%right-sticky-mark - :buffer buffer :offset 3)) - (m2 (make-instance %%right-sticky-mark - :buffer buffer :offset 5))) + (let ((m (clone-mark (low-mark buffer) :right)) + (m2 (clone-mark (low-mark buffer) :right))) + (setf (offset m) 3 + (offset m2) 5) (delete-region m2 m) (and (= (size buffer) 5) - (eq (buffer m) buffer) - (eq (buffer m2) buffer) + (eq (buffer m) (buffer m2)) (= (offset m) 3) (= (offset m2) 3) (buffer-sequence buffer 0 5)))) @@ -394,10 +395,10 @@ (buffer2 (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (insert-buffer-sequence buffer2 0 "climacs") - (let ((m (make-instance %%right-sticky-mark - :buffer buffer :offset 3)) - (m2 (make-instance %%right-sticky-mark - :buffer buffer2 :offset 5))) + (let ((m (clone-mark (low-mark buffer) :right)) + (m2 (clone-mark (low-mark buffer2) :right))) + (setf (offset m) 3 + (offset m2) 5) (delete-region m2 m))) (error (c) (declare (ignore c)) @@ -407,15 +408,14 @@ (defmultitest delete-region.test-6 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 3)) - (m2 (make-instance %%left-sticky-mark - :buffer buffer :offset 5))) + (let ((m (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :left))) + (setf (offset m) 3 + (offset m2) 5) (delete-region m 5) (delete-region 1 m2) (and (= (size buffer) 3) - (eq (buffer m) buffer) - (eq (buffer m2) buffer) + (eq (buffer m) (buffer m2)) (= (offset m) 1) (= (offset m2) 1) (buffer-sequence buffer 0 3)))) @@ -437,19 +437,18 @@ (defmultitest mark-relations.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m0 (make-instance %%right-sticky-mark - :buffer buffer :offset 0)) - (m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 3)) - (m1a (make-instance %%right-sticky-mark - :buffer buffer :offset 3)) - (m2 (make-instance %%right-sticky-mark - :buffer buffer :offset 4)) - (m2a (make-instance %%left-sticky-mark - :buffer buffer :offset 5)) - (m3 (make-instance %%left-sticky-mark - :buffer buffer :offset 7))) - (setf (offset m2) 5) + (let ((m0 (clone-mark (low-mark buffer) :right)) + (m1 (clone-mark (low-mark buffer) :left)) + (m1a (clone-mark (low-mark buffer) :right)) + (m2 (clone-mark (low-mark buffer) :right)) + (m2a (clone-mark (low-mark buffer) :left)) + (m3 (clone-mark (low-mark buffer) :left))) + (setf (offset m0) 0 + (offset m1) 3 + (offset m1a) 3 + (offset m2) 5 + (offset m2a) 5 + (offset m3) 7) (and (mark< m0 m1) (not (mark> m0 m1)) (not (mark>= m0 m1)) (mark< m0 m2) (not (mark> m0 m2)) (not (mark>= m0 m2)) (mark< m0 m3) (not (mark> m0 m3)) (not (mark>= m0 m3)) @@ -479,8 +478,7 @@ (handler-case (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 4))) + (let ((m (clone-mark (low-mark buffer) :left))) (setf (offset m) -1))) (climacs-buffer::motion-before-beginning (c) (= (climacs-buffer::condition-offset c) -1))) @@ -490,8 +488,7 @@ (handler-case (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 4))) + (let ((m (clone-mark (low-mark buffer) :left))) (setf (offset m) 8))) (climacs-buffer::motion-after-end (c) (= (climacs-buffer::condition-offset c) 8))) @@ -500,9 +497,10 @@ (defmultitest backward-object.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let* ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 4)) + (let* ((m1 (clone-mark (low-mark buffer) :left)) (m2 (clone-mark m1))) + (setf (offset m1) 4 + (offset m2) 4) (backward-object m1 2) (region-to-sequence m1 m2))) "im") @@ -511,9 +509,10 @@ (handler-case (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let* ((m1 (make-instance %%right-sticky-mark - :buffer buffer :offset 2)) + (let* ((m1 (clone-mark (low-mark buffer) :right)) (m2 (clone-mark m1))) + (setf (offset m1) 2 + (offset m2) 2) (backward-object m1 3) (region-to-sequence m1 m2))) (climacs-buffer::motion-before-beginning (c) @@ -523,9 +522,10 @@ (defmultitest forward-object.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let* ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 4)) + (let* ((m1 (clone-mark (low-mark buffer) :left)) (m2 (clone-mark m1))) + (setf (offset m1) 4 + (offset m2) 4) (forward-object m1 2) (region-to-sequence m1 m2))) "ac") @@ -534,9 +534,10 @@ (handler-case (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let* ((m1 (make-instance %%right-sticky-mark - :buffer buffer :offset 6)) + (let* ((m1 (clone-mark (low-mark buffer) :right)) (m2 (clone-mark m1))) + (setf (offset m1) 6 + (offset m2) 6) (forward-object m1 3) (region-to-sequence m1 m2))) (climacs-buffer::motion-after-end (c) @@ -572,10 +573,8 @@ (buffer2 (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (insert-buffer-sequence buffer2 0 "climacs") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 4)) - (m2 (make-instance %%left-sticky-mark - :buffer buffer2 :offset 4))) + (let ((m1 (clone-mark (low-mark buffer))) + (m2 (clone-mark (low-mark buffer2)))) (mark< m1 m2))) (error (c) (declare (ignore c)) @@ -588,10 +587,8 @@ (buffer2 (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (insert-buffer-sequence buffer2 0 "climacs") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 4)) - (m2 (make-instance %%left-sticky-mark - :buffer buffer2 :offset 4))) + (let ((m1 (clone-mark (low-mark buffer))) + (m2 (clone-mark (low-mark buffer2)))) (mark> m1 m2))) (error (c) (declare (ignore c)) @@ -604,10 +601,8 @@ (buffer2 (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (insert-buffer-sequence buffer2 0 "climacs") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 4)) - (m2 (make-instance %%left-sticky-mark - :buffer buffer2 :offset 4))) + (let ((m1 (clone-mark (low-mark buffer))) + (m2 (clone-mark (low-mark buffer2)))) (mark<= m1 m2))) (error (c) (declare (ignore c)) @@ -620,10 +615,8 @@ (buffer2 (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (insert-buffer-sequence buffer2 0 "climacs") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 4)) - (m2 (make-instance %%left-sticky-mark - :buffer buffer2 :offset 4))) + (let ((m1 (clone-mark (low-mark buffer))) + (m2 (clone-mark (low-mark buffer2)))) (mark>= m1 m2))) (error (c) (declare (ignore c)) @@ -636,10 +629,8 @@ (buffer2 (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (insert-buffer-sequence buffer2 0 "climacs") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 4)) - (m2 (make-instance %%left-sticky-mark - :buffer buffer2 :offset 4))) + (let ((m1 (clone-mark (low-mark buffer))) + (m2 (clone-mark (low-mark buffer2)))) (mark= m1 m2))) (error (c) (declare (ignore c)) @@ -650,10 +641,10 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 3)) - (m2 (make-instance %%right-sticky-mark - :buffer buffer :offset 11))) + (let ((m1 (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :right))) + (setf (offset m1) 3 + (offset m2) 11) (= 0 (line-number m1) (1- (line-number m2))))) t) @@ -678,10 +669,10 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((m1 (make-instance %%left-sticky-mark - :buffer buffer :offset 3)) - (m2 (make-instance %%right-sticky-mark - :buffer buffer :offset 11))) + (let ((m1 (clone-mark (low-mark buffer) :left)) + (m2 (clone-mark (low-mark buffer) :right))) + (setf (offset m1) 3 + (offset m2) 11) (= 3 (column-number m1) (column-number m2)))) t) @@ -689,8 +680,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 11))) + (let ((m (clone-mark (low-mark buffer) :left))) + (setf (offset m) 11) (and (not (beginning-of-line-p m)) (progn (beginning-of-line m) (beginning-of-line-p m))))) t) @@ -699,8 +690,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 11))) + (let ((m (clone-mark (low-mark buffer) :left))) + (setf (offset m) 11) (and (not (end-of-line-p m)) (progn (end-of-line m) (end-of-line-p m))))) t) @@ -709,8 +700,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 11))) + (let ((m (clone-mark (low-mark buffer) :left))) + (setf (offset m) 11) (and (not (beginning-of-buffer-p m)) (progn (beginning-of-buffer m) (beginning-of-buffer-p m))))) t) @@ -719,8 +710,8 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((m (make-instance %%left-sticky-mark - :buffer buffer :offset 11))) + (let ((m (clone-mark (low-mark buffer) :left))) + (setf (offset m) 11) (and (not (end-of-buffer-p m)) (progn (end-of-buffer m) (end-of-buffer-p m))))) t) Index: climacs/climacs.asd diff -u climacs/climacs.asd:1.19 climacs/climacs.asd:1.20 --- climacs/climacs.asd:1.19 Thu Feb 10 01:27:07 2005 +++ climacs/climacs.asd Sun Feb 27 19:52:01 2005 @@ -65,6 +65,7 @@ "cl-syntax" "kill-ring" "undo" + "delegating-buffer" "pane" "gui" ;;---- optional ---- Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.124 climacs/gui.lisp:1.125 --- climacs/gui.lisp:1.124 Thu Feb 24 09:30:28 2005 +++ climacs/gui.lisp Sun Feb 27 19:52:01 2005 @@ -346,11 +346,6 @@ ,@end-clauses)) (redisplay-frame-panes *application-frame*))))) -(defun region-limits (pane) - (if (mark< (mark pane) (point pane)) - (values (mark pane) (point pane)) - (values (point pane) (mark pane)))) - (defmacro define-named-command (command-name args &body body) `(define-climacs-command ,(if (listp command-name) `(,@command-name :name t) @@ -546,13 +541,13 @@ (define-named-command com-tabify-region () (let ((pane (current-window))) - (multiple-value-bind (start end) (region-limits pane) - (tabify-region start end (tab-space-count (stream-default-view pane)))))) + (tabify-region + (mark pane) (point pane) (tab-space-count (stream-default-view pane))))) (define-named-command com-untabify-region () (let ((pane (current-window))) - (multiple-value-bind (start end) (region-limits pane) - (untabify-region start end (tab-space-count (stream-default-view pane)))))) + (untabify-region + (mark pane) (point pane) (tab-space-count (stream-default-view pane))))) (defun indent-current-line (pane point) (let* ((buffer (buffer pane)) @@ -698,7 +693,8 @@ (pane (current-window))) (push buffer (buffers *application-frame*)) (setf (buffer (current-window)) buffer) - (setf (syntax buffer) (make-instance 'basic-syntax :buffer buffer)) + (setf (syntax buffer) (make-instance + 'basic-syntax :buffer (buffer (point pane)))) ;; Don't want to create the file if it doesn't exist. (when (probe-file filename) (with-open-file (stream filename :direction :input) @@ -775,11 +771,13 @@ (define-named-command com-switch-to-buffer () (let ((buffer (accept 'buffer - :prompt "Switch to buffer"))) - (setf (buffer (current-window)) buffer) - (setf (syntax buffer) (make-instance 'basic-syntax :buffer buffer)) - (beginning-of-buffer (point (current-window))) - (full-redisplay (current-window)))) + :prompt "Switch to buffer")) + (pane (current-window))) + (setf (buffer pane) buffer) + (setf (syntax buffer) (make-instance + 'basic-syntax :buffer (buffer (point pane)))) + (beginning-of-buffer (point pane)) + (full-redisplay pane))) (define-named-command com-kill-buffer () (with-slots (buffers) *application-frame* @@ -834,8 +832,11 @@ (return-from com-goto-position nil)))))) (define-named-command com-goto-line () - (loop with mark = (make-instance 'standard-right-sticky-mark ;PB - :buffer (buffer (current-window))) + (loop with mark = (let ((m (clone-mark + (low-mark (buffer (current-window))) + :right))) + (beginning-of-buffer m) + m) do (end-of-line mark) until (end-of-buffer-p mark) repeat (handler-case (accept 'integer :prompt "Goto Line") @@ -868,7 +869,7 @@ (progn (beep) (display-message "No such syntax") (return-from com-set-syntax nil))) - :buffer buffer)) + :buffer (buffer (point pane)))) (setf (offset (low-mark buffer)) 0 (offset (high-mark buffer)) (size buffer)))) @@ -1021,9 +1022,10 @@ ;; Destructively cut a given buffer region into the kill-ring (define-named-command com-cut-out () - (multiple-value-bind (start end) (region-limits (current-window)) - (kill-ring-standard-push *kill-ring* (region-to-sequence start end)) - (delete-region (offset start) end))) + (let ((pane (current-window))) + (kill-ring-standard-push + *kill-ring* (region-to-sequence (mark pane) (point pane))) + (delete-region (mark pane) (point pane)))) ;; Non destructively copies in buffer region to the kill ring (define-named-command com-copy-out () Index: climacs/kill-ring.lisp diff -u climacs/kill-ring.lisp:1.5 climacs/kill-ring.lisp:1.6 --- climacs/kill-ring.lisp:1.5 Fri Jan 7 19:58:08 2005 +++ climacs/kill-ring.lisp Sun Feb 27 19:52:01 2005 @@ -87,7 +87,7 @@ (with-slots (max-size) kr max-size)) -(defmethod (setf kill-ring-max-size) ((kr kill-ring) size) +(defmethod (setf kill-ring-max-size) (size (kr kill-ring)) (unless (typep size 'integer) (error "Error, ~S, is not an integer value" size)) (if (< size 5) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.50 climacs/packages.lisp:1.51 --- climacs/packages.lisp:1.50 Wed Feb 23 19:15:32 2005 +++ climacs/packages.lisp Sun Feb 27 19:52:01 2005 @@ -48,7 +48,9 @@ #:low-mark #:high-mark #:modified-p #:clear-modify #:binseq-buffer #:obinseq-buffer - #:persistent-left-sticky-mark #:persistent-right-sticky-mark)) + #:persistent-left-sticky-mark #:persistent-right-sticky-mark + + #:delegating-buffer #:implementation)) (defpackage :climacs-base (:use :clim-lisp :climacs-buffer) Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.18 climacs/pane.lisp:1.19 --- climacs/pane.lisp:1.18 Sat Feb 5 07:49:53 2005 +++ climacs/pane.lisp Sun Feb 27 19:52:01 2005 @@ -135,6 +135,23 @@ (mapc #'flip-undo-record records) (setf records (nreverse records)))) +;;; undo-mixin delegation (here because of the package) + +(defmethod undo-tree ((buffer delegating-buffer)) + (undo-tree (implementation buffer))) + +(defmethod undo-accumulate ((buffer delegating-buffer)) + (undo-accumulate (implementation buffer))) + +(defmethod (setf undo-accumulate) (object (buffer delegating-buffer)) + (setf (undo-accumulate (implementation buffer)) object)) + +(defmethod performing-undo ((buffer delegating-buffer)) + (performing-undo (implementation buffer))) + +(defmethod (setf performing-undo) (object (buffer delegating-buffer)) + (setf (performing-undo (implementation buffer)) object)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Isearch @@ -165,17 +182,36 @@ ;(defgeneric indent-tabs-mode (climacs-buffer)) -(defclass climacs-buffer (standard-buffer abbrev-mixin filename-mixin name-mixin undo-mixin) ;PB +;;; syntax delegation + +(defmethod update-syntax ((buffer delegating-buffer) syntax) + (update-syntax (implementation buffer) syntax)) + +(defmethod update-syntax-for-redisplay ((buffer delegating-buffer) syntax from to) + (update-syntax-for-redisplay (implementation buffer) syntax from to)) + +;;; buffers + +(defclass extended-standard-buffer (standard-buffer undo-mixin abbrev-mixin) () + (:documentation "Extensions accessible via marks.")) + +(defclass extended-obinseq-buffer (obinseq-buffer undo-mixin abbrev-mixin) () + (:documentation "Extensions accessible via marks.")) + +(defclass climacs-buffer (delegating-buffer filename-mixin name-mixin) ((needs-saving :initform nil :accessor needs-saving) (syntax :accessor syntax) (indent-tabs-mode :initarg indent-tabs-mode :initform t :accessor indent-tabs-mode)) - (:default-initargs :name "*scratch*")) + (:default-initargs + :name "*scratch*" + :implementation (make-instance 'extended-standard-buffer))) (defmethod initialize-instance :after ((buffer climacs-buffer) &rest args) (declare (ignore args)) (with-slots (syntax) buffer - (setf syntax (make-instance 'basic-syntax :buffer buffer)))) + (setf syntax (make-instance + 'basic-syntax :buffer (implementation buffer))))) (defclass climacs-pane (application-pane) ((buffer :initform (make-instance 'climacs-buffer) :accessor buffer) @@ -210,14 +246,12 @@ (declare (ignore args)) (with-slots (buffer point mark) pane (when (null point) - (setf point (make-instance 'standard-right-sticky-mark ;PB - :buffer buffer))) + (setf point (clone-mark (low-mark buffer) :right))) (when (null mark) - (setf mark (make-instance 'standard-right-sticky-mark ;PB - :buffer buffer)))) + (setf mark (clone-mark (low-mark buffer) :right)))) (with-slots (buffer top bot scan) pane - (setf top (make-instance 'standard-left-sticky-mark :buffer buffer) ;PB - bot (make-instance 'standard-right-sticky-mark :buffer buffer))) ;PB + (setf top (clone-mark (low-mark buffer) :left) + bot (clone-mark (high-mark buffer) :right))) (setf (stream-default-view pane) (make-instance 'climacs-textual-view)) (with-slots (space-width tab-width) (stream-default-view pane) (let* ((medium (sheet-medium pane)) @@ -227,12 +261,10 @@ (defmethod (setf buffer) :after (buffer (pane climacs-pane)) (with-slots (point mark top bot) pane - (setf point (make-instance 'standard-right-sticky-mark ;PB - :buffer buffer) - mark (make-instance 'standard-right-sticky-mark ;PB - :buffer buffer) - top (make-instance 'standard-left-sticky-mark :buffer buffer) ;PB - bot (make-instance 'standard-right-sticky-mark :buffer buffer)))) ;PB + (setf point (clone-mark (low-mark (implementation buffer)) :right) + mark (clone-mark (low-mark (implementation buffer)) :right) + top (clone-mark (low-mark (implementation buffer)) :left) + bot (clone-mark (high-mark (implementation buffer)) :right)))) (define-presentation-type url () :inherit-from 'string) @@ -470,4 +502,4 @@ (defgeneric full-redisplay (pane)) (defmethod full-redisplay ((pane climacs-pane)) - (setf (full-redisplay-p pane) t)) \ No newline at end of file + (setf (full-redisplay-p pane) t))

1 0

[climacs-cvs] CVS update: climacs/cl-syntax.lisp
by rstrandh＠common-lisp.net 27 Feb '05

27 Feb '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv1744 Modified Files: cl-syntax.lisp Log Message: Improved performance some more by considering line comments to be single entries. Date: Sun Feb 27 07:23:28 2005 Author: rstrandh Index: climacs/cl-syntax.lisp diff -u climacs/cl-syntax.lisp:1.3 climacs/cl-syntax.lisp:1.4 --- climacs/cl-syntax.lisp:1.3 Sun Feb 27 07:16:48 2005 +++ climacs/cl-syntax.lisp Sun Feb 27 07:23:28 2005 @@ -187,7 +187,9 @@ do (case object (#\( (fo) (make-entry 'list-start-entry)) (#\) (fo) (make-entry 'list-end-entry)) - (#\; (fo) (make-entry 'comment-entry)) + (#\; (loop do (fo) + until (end-of-line-p scan)) + (make-entry 'comment-entry)) (#\" (fo) (make-entry 'double-quote-entry)) (#\' (fo) (make-entry 'quote-entry)) (#\` (fo) (make-entry 'backquote-entry))

1 0

[climacs-cvs] CVS update: climacs/cl-syntax.lisp
by rstrandh＠common-lisp.net 27 Feb '05

27 Feb '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv1114 Modified Files: cl-syntax.lisp Log Message: Decreased consing by a third, and improved performance at the same time, by having a single mark and a size instead of two marks in a stack entry. Date: Sun Feb 27 07:16:52 2005 Author: rstrandh Index: climacs/cl-syntax.lisp diff -u climacs/cl-syntax.lisp:1.2 climacs/cl-syntax.lisp:1.3 --- climacs/cl-syntax.lisp:1.2 Fri Feb 25 08:11:24 2005 +++ climacs/cl-syntax.lisp Sun Feb 27 07:16:48 2005 @@ -24,9 +24,15 @@ (defclass stack-entry () ((start-mark :initarg :start-mark :reader start-mark) - (end-mark :initarg :end-mark :reader end-mark)) + (size :initarg :size)) (:documentation "A stack entry corresponds to a syntactic category")) +(defgeneric end-offset (stack-entry)) + +(defmethod end-offset ((entry stack-entry)) + (with-slots (start-mark size) entry + (+ (offset start-mark) size))) + (defclass error-entry (stack-entry) ()) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -167,14 +173,15 @@ :buffer buffer :offset 0))) (insert* elements 0 (make-instance 'start-entry - :start-mark mark :end-mark mark))))) + :start-mark mark :size 0))))) (defun next-entry (scan) (let ((start-mark (clone-mark scan))) (flet ((fo () (forward-object scan))) (macrolet ((make-entry (type) `(return-from next-entry - (make-instance ,type :start-mark start-mark :end-mark (clone-mark scan))))) + (make-instance ,type :start-mark start-mark + :size (- (offset scan) (offset start-mark)))))) (loop with object = (object-after scan) until (end-of-buffer-p scan) do (case object @@ -245,12 +252,12 @@ (when (mark<= low-mark high-mark) ;; go back to a position before low-mark (loop until (or (= guess-pos 1) - (mark< (end-mark (element* elements (1- guess-pos))) low-mark)) + (mark< (end-offset (element* elements (1- guess-pos))) low-mark)) do (decf guess-pos)) ;; go forward to the last position before low-mark (loop with nb-elements = (nb-elements elements) until (or (= guess-pos nb-elements) - (mark>= (end-mark (element* elements guess-pos)) low-mark)) + (mark>= (end-offset (element* elements guess-pos)) low-mark)) do (incf guess-pos)) ;; delete entries that must be reparsed (loop until (or (= guess-pos (nb-elements elements)) @@ -260,7 +267,7 @@ :buffer buffer :offset (if (zerop guess-pos) 0 - (offset (end-mark (element* elements (1- guess-pos))))))) + (end-offset (element* elements (1- guess-pos)))))) ;; scan (unless (end-of-buffer-p scan) (loop with start-mark = nil

1 0

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

26 Feb '05

Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv17346/Doc Modified Files: climacs-internals.texi Log Message: Updated the description of the buffer protocol to reflect recent changes with respect to conditions and clone-mark. Date: Sat Feb 26 06:33:39 2005 Author: rstrandh Index: climacs/Doc/climacs-internals.texi diff -u climacs/Doc/climacs-internals.texi:1.12 climacs/Doc/climacs-internals.texi:1.13 --- climacs/Doc/climacs-internals.texi:1.12 Sat Feb 5 14:49:22 2005 +++ climacs/Doc/climacs-internals.texi Sat Feb 26 06:33:37 2005 @@ -113,11 +113,12 @@ mark will be positioned to the right of the object. @end deftp -@deffn {Generic Function} {clone-mark} (mark &key type) +@deffn {Generic Function} {clone-mark} (mark &optional stick-to) -Clone a mark. By default (when type is NIL) the same type of mark is -returned. Otherwise type is the name of a class (subclass of the mark -class) to be used as a class of the clone. +Clone a mark. By default (when stick-to is NIL) the same type of mark +is returned. Otherwise stick-to is either :left, indicating that a +left-sticky-mark should be created, or :right indicating that a +right-sticky-mark should be created. @end deffn @deffn {Generic Function} {buffer} mark @@ -127,8 +128,42 @@ @deftp {Error Condition} no-such-offset -This condition is signaled whenever an attempt is made at an operation -that is before the beginning or after the end of the buffer. +This condition is signaled whenever an attempt is made to access an +object that is before the beginning or after the end of the buffer. +@end deftp + +@deftp {Error Condition} offset-before-beginning + +This condition is signaled whenever an attempt is made to access +buffer contents that is before the beginning of the buffer. +This condition is a subclass of no-such-offset +@end deftp + +@deftp {Error Condition} offset-after-end + +This condition is signaled whenever an attempt is made to access +buffer contents that is after the end of the buffer. +This condition is a subclass of no-such-offset +@end deftp + +@deftp {Error Condition} invalid-motion + +This condition is signaled whenever an attempt is made to move a mark +before the beginning or after the end of the buffer. +@end deftp + +@deftp {Error Condition} motion-before-beginning + +This condition is signaled whenever an attempt is made to move a mark +before the beginning of the buffer. +This condition is a subclass of invalid-motion. +@end deftp + +@deftp {Error Condition} motion-after-end + +This condition is signaled whenever an attempt is made to move a mark +after the end of the buffer. +This condition is a subclass of invalid-motion. @end deftp @deffn {Generic Function} {size} buffer @@ -152,25 +187,32 @@ @deffn {Generic Function} {(setf offset)} offset mark -Set the offset of the mark into the buffer. A no-such-offset -condition is signaled if the offset is less than zero or greater than -the size of the buffer. +Set the offset of the mark into the buffer. A motion-before-beginning +condition is signaled if the offset is less than zero. A +motion-after-end condition is signaled if the offset is greater than +the size of the buffer. @end deffn @deffn {Generic Function} {forward-object} mark &optional (count 1) -Move the mark forward the number of positions indicated by count. +Move the mark forward the number of positions indicated by count. This function could be implemented by an incf on the offset of the mark, but many buffer implementations can implement this function much -more efficiently in a different way. +more efficiently in a different way. A motion-before-beginning +condition is signaled if the resulting offset of the mark is less than +zero. A motion-after-end condition is signaled if the resulting offset +of the mark is greater than the size of the buffer. @end deffn @deffn {Generic Function} {backward-object} mark &optional (count 1) -Move the mark backward the number of positions indicated by count. +Move the mark backward the number of positions indicated by count. This function could be implemented by a decf on the offset of the mark, but many buffer implementations can implement this function much -more efficiently in a different way. +more efficiently in a different way. A motion-before-beginning +condition is signaled if the resulting offset of the mark is less than +zero. A motion-after-end condition is signaled if the resulting offset +of the mark is greater than the size of the buffer. @end deffn @deffn {Generic Function} {mark<} mark1 mark2 @@ -309,9 +351,10 @@ @deffn {Generic Function} {delete-buffer-range} buffer offset n -Delete n objects from the buffer starting at the offset. If offset -is negative or offset+n is greater than the size of the buffer, a -no-such-offset condition is signaled. +Delete n objects from the buffer starting at the offset. If offset is +negative, a offset-before-beginning condition is signaled. If +offset+n is greater than the size of the buffer, a offset-after-end +condition is signaled. @end deffn @deffn {Generic Function} {delete-range} mark &optional (n 1) @@ -336,31 +379,33 @@ @deffn {Generic Function} {buffer-object} buffer offset Return the object at the offset in the buffer. The first object -has offset 0. If offset is less than zero or greater than or equal to -the size of the buffer, a no-such-offset condition is signaled. +has offset 0. If offset is less than zero, an offset-before-beginning +condition is signaled. If offset is greater than or equal to +the size of the buffer, an offset-after-end condition is signaled. @end deffn @deffn {Generic Function} {buffer-sequence} buffer offset1 offset2 Return the contents of the buffer starting at offset1 and ending at -offset2-1 as a sequence. If either of the offsets is less than zero -or greater than or equal to the size of the buffer, a no-such-offset -condition is signaled. If offset2 is smaller than or equal to -offset1, an empty sequence will be returned. +offset2-1 as a sequence. If either of the offsets is less than zero, +an offset-before-beginning condition is signaled. If either of the +offsets is greater than or equal to the size of the buffer, an +offset-after-end condition is signaled. If offset2 is smaller than or +equal to offset1, an empty sequence will be returned. @end deffn @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. -If the mark is at the beginning of a line, but not at the beginning -of the buffer, a newline character is returned. +the beginning of the buffer, an offset-before-beginning condition is +signaled. If the mark is at the beginning of a line, but not at the +beginning of the buffer, a newline character is returned. @end deffn @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 +the end of the buffer, an offset-after-end condition is signaled. If the mark is at the end of a line, but not at the end of the buffer, a newline character is returned. @end deffn @@ -371,6 +416,8 @@ 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 buffer-sequence with the appropriate arguments. @end deffn @section Implementation hints

1 0

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

25 Feb '05

Update of /project/climacs/cvsroot/climacs/Persistent In directory common-lisp.net:/tmp/cvs-serv20153/Persistent Modified Files: persistent-buffer.lisp Log Message: Updated persistent buffers and tests to catch up with recent changes. Date: Fri Feb 25 21:45:14 2005 Author: abakic Index: climacs/Persistent/persistent-buffer.lisp diff -u climacs/Persistent/persistent-buffer.lisp:1.6 climacs/Persistent/persistent-buffer.lisp:1.7 --- climacs/Persistent/persistent-buffer.lisp:1.6 Sun Feb 6 17:33:52 2005 +++ climacs/Persistent/persistent-buffer.lisp Fri Feb 25 21:45:11 2005 @@ -103,8 +103,10 @@ (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)) + (assert (<= 0 new-offset) () + (make-condition 'motion-before-beginning :offset new-offset)) + (assert (<= new-offset (size (buffer mark))) () + (make-condition 'motion-after-end :offset new-offset)) (setf (cursor-pos (cursor mark)) new-offset)) (defclass persistent-left-sticky-mark (left-sticky-mark p-mark-mixin) () @@ -119,8 +121,10 @@ &rest args &key (offset 0)) "Associates a created mark with the buffer for which it was created." (declare (ignorable args)) - (assert (<= 0 offset (size (buffer mark))) () - (make-condition 'no-such-offset :offset offset)) + (assert (<= 0 offset) () + (make-condition 'motion-before-beginning :offset offset)) + (assert (<= offset (size (buffer mark))) () + (make-condition 'motion-after-end :offset offset)) (setf (slot-value mark 'cursor) (make-instance 'left-sticky-persistent-cursor :buffer (buffer mark) @@ -130,8 +134,10 @@ &rest args &key (offset 0)) "Associates a created mark with the buffer for which it was created." (declare (ignorable args)) - (assert (<= 0 offset (size (buffer mark))) () - (make-condition 'no-such-offset :offset offset)) + (assert (<= 0 offset) () + (make-condition 'motion-before-beginning :offset offset)) + (assert (<= offset (size (buffer mark))) () + (make-condition 'motion-after-end :offset offset)) (setf (slot-value mark 'cursor) (make-instance 'right-sticky-persistent-cursor :buffer (buffer mark) @@ -145,6 +151,26 @@ (setf high-mark (make-instance 'persistent-right-sticky-mark :buffer buffer)))) +(defmethod clone-mark ((mark persistent-left-sticky-mark) &optional stick-to) + (cond + ((or (null stick-to) (eq stick-to :left)) + (make-instance 'persistent-left-sticky-mark + :buffer (buffer mark) :offset (offset mark))) + ((eq stick-to :right) + (make-instance 'persistent-right-sticky-mark + :buffer (buffer mark) :offset (offset mark))) + (t (error "invalid value for stick-to")))) + +(defmethod clone-mark ((mark persistent-right-sticky-mark) &optional stick-to) + (cond + ((or (null stick-to) (eq stick-to :right)) + (make-instance 'persistent-right-sticky-mark + :buffer (buffer mark) :offset (offset mark))) + ((eq stick-to :left) + (make-instance 'persistent-left-sticky-mark + :buffer (buffer mark) :offset (offset mark))) + (t (error "invalid value for stick-to")))) + (defmethod size ((buffer binseq-buffer)) (binseq-length (slot-value buffer 'contents))) @@ -258,8 +284,10 @@ ;;; it can be saved for UNDO purposes in a history tree, by an UNDOABLE-BUFFER (defmethod insert-buffer-object ((buffer binseq-buffer) offset object) - (assert (<= 0 offset (size buffer)) () - (make-condition 'no-such-offset :offset offset)) + (assert (<= 0 offset) () + (make-condition 'offset-before-beginning :offset offset)) + (assert (<= offset (size buffer)) () + (make-condition 'offset-after-end :offset offset)) (setf (slot-value buffer 'contents) (binseq-insert (slot-value buffer 'contents) offset object))) @@ -286,8 +314,10 @@ (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)) + (assert (<= 0 offset) () + (make-condition 'offset-before-beginning :offset offset)) + (assert (<= offset (size buffer)) () + (make-condition 'offset-after-end :offset offset)) (setf (slot-value buffer 'contents) (binseq-remove* (slot-value buffer 'contents) offset n))) @@ -324,32 +354,44 @@ (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)) + (assert (<= 0 offset) () + (make-condition 'offset-before-beginning :offset offset)) + (assert (<= offset (1- (size buffer))) () + (make-condition 'offset-after-end :offset offset)) (binseq-get (slot-value buffer 'contents) offset)) (defmethod (setf buffer-object) (object (buffer binseq-buffer) offset) - (assert (<= 0 offset (1- (size buffer))) () - (make-condition 'no-such-offset :offset offset)) + (assert (<= 0 offset) () + (make-condition 'offset-before-beginning :offset offset)) + (assert (<= offset (1- (size buffer))) () + (make-condition 'offset-after-end :offset offset)) (setf (slot-value buffer 'contents) (binseq-set (slot-value buffer 'contents) offset object))) (defmethod buffer-object ((buffer obinseq-buffer) offset) - (assert (<= 0 offset (1- (size buffer))) () - (make-condition 'no-such-offset :offset offset)) + (assert (<= 0 offset) () + (make-condition 'offset-before-beginning :offset offset)) + (assert (<= offset (1- (size buffer))) () + (make-condition 'offset-after-end :offset offset)) (obinseq-get (slot-value buffer 'contents) offset)) (defmethod (setf buffer-object) (object (buffer obinseq-buffer) offset) - (assert (<= 0 offset (1- (size buffer))) () - (make-condition 'no-such-offset :offset offset)) + (assert (<= 0 offset) () + (make-condition 'offset-before-beginning :offset offset)) + (assert (<= offset (1- (size buffer))) () + (make-condition 'offset-after-end :offset offset)) (setf (slot-value buffer 'contents) (obinseq-set (slot-value buffer 'contents) offset object))) (defmethod buffer-sequence ((buffer binseq-buffer) offset1 offset2) - (assert (<= 0 offset1 (size buffer)) () - (make-condition 'no-such-offset :offset offset1)) - (assert (<= 0 offset2 (size buffer)) () - (make-condition 'no-such-offset :offset offset2)) + (assert (<= 0 offset1) () + (make-condition 'offset-before-beginning :offset offset1)) + (assert (<= offset1 (size buffer)) () + (make-condition 'offset-after-end :offset offset1)) + (assert (<= 0 offset2) () + (make-condition 'offset-before-beginning :offset offset2)) + (assert (<= offset2 (size buffer)) () + (make-condition 'offset-after-end :offset offset2)) (coerce (let ((len (- offset2 offset1))) (if (> len 0)

1 0

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

25 Feb '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv20153 Modified Files: base-test.lisp buffer-test.lisp Log Message: Updated persistent buffers and tests to catch up with recent changes. Date: Fri Feb 25 21:45:08 2005 Author: abakic Index: climacs/base-test.lisp diff -u climacs/base-test.lisp:1.10 climacs/base-test.lisp:1.11 --- climacs/base-test.lisp:1.10 Sat Feb 12 16:34:46 2005 +++ climacs/base-test.lisp Fri Feb 25 21:45:07 2005 @@ -8,20 +8,22 @@ (defmultitest previous-line.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs +climacs climacs") (let ((mark (make-instance %%left-sticky-mark - :buffer buffer :offset 8))) - (previous-line mark) + :buffer buffer :offset 16))) + (previous-line mark nil 2) (offset mark))) 0) (defmultitest previous-line.test-2 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs +climacs climacs") (let ((mark (make-instance %%right-sticky-mark - :buffer buffer :offset 11))) - (previous-line mark 2) + :buffer buffer :offset 19))) + (previous-line mark 2 2) (offset mark))) 2) @@ -78,22 +80,24 @@ (defmultitest next-line.test-1 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs +climacs climacs") (let ((mark (make-instance %%left-sticky-mark :buffer buffer :offset 6))) - (next-line mark) + (next-line mark nil 2) (offset mark))) - 14) + 22) (defmultitest next-line.test-2 (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs +climacs climacs") (let ((mark (make-instance %%right-sticky-mark :buffer buffer :offset 3))) - (next-line mark 2) + (next-line mark 2 2) (offset mark))) - 10) + 18) (defmultitest next-line.test-3 (let ((buffer (make-instance %%buffer))) @@ -150,9 +154,10 @@ (insert-buffer-sequence buffer 0 "climacs") (let ((mark (make-instance %%left-sticky-mark :buffer buffer :offset 0))) - (open-line mark) + (open-line mark 2) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) " + climacs" 0) (defmultitest open-line.test-2 Index: climacs/buffer-test.lisp diff -u climacs/buffer-test.lisp:1.16 climacs/buffer-test.lisp:1.17 --- climacs/buffer-test.lisp:1.16 Fri Feb 25 08:11:24 2005 +++ climacs/buffer-test.lisp Fri Feb 25 21:45:07 2005 @@ -55,7 +55,7 @@ (handler-case (let ((buffer (make-instance %%buffer))) (make-instance %%left-sticky-mark :buffer buffer :offset 1)) - (climacs-buffer::no-such-offset (c) + (climacs-buffer::motion-after-end (c) (= (climacs-buffer::condition-offset c) 1))) t) @@ -63,7 +63,7 @@ (handler-case (let ((buffer (make-instance %%buffer))) (make-instance %%right-sticky-mark :buffer buffer :offset 1)) - (climacs-buffer::no-such-offset (c) + (climacs-buffer::motion-after-end (c) (= (climacs-buffer::condition-offset c) 1))) t) @@ -137,7 +137,7 @@ (handler-case (let ((buffer (make-instance %%buffer))) (insert-buffer-object buffer -1 #\a)) - (climacs-buffer::no-such-offset (c) + (climacs-buffer::motion-before-beginning (c) (= (climacs-buffer::condition-offset c) -1))) t) @@ -171,7 +171,7 @@ (handler-case (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 1 "climacs")) - (climacs-buffer::no-such-offset (c) + (climacs-buffer::motion-after-end (c) (= (climacs-buffer::condition-offset c) 1))) t) @@ -179,7 +179,7 @@ (handler-case (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer -1 "climacs")) - (climacs-buffer::no-such-offset (c) + (climacs-buffer::motion-before-beginning (c) (= (climacs-buffer::condition-offset c) -1))) t) @@ -225,7 +225,7 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (delete-buffer-range buffer -1 0)) - (climacs-buffer::no-such-offset (c) + (climacs-buffer::motion-before-beginning (c) (= (climacs-buffer::condition-offset c) -1))) t) @@ -234,7 +234,7 @@ (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (delete-buffer-range buffer 6 2)) - (climacs-buffer::no-such-offset (c) + (climacs-buffer::motion-after-end (c) (= (climacs-buffer::condition-offset c) 8))) t) @@ -482,7 +482,7 @@ (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 4))) (setf (offset m) -1))) - (climacs-buffer::no-such-offset (c) + (climacs-buffer::motion-before-beginning (c) (= (climacs-buffer::condition-offset c) -1))) t) @@ -493,7 +493,7 @@ (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 4))) (setf (offset m) 8))) - (climacs-buffer::no-such-offset (c) + (climacs-buffer::motion-after-end (c) (= (climacs-buffer::condition-offset c) 8))) t) @@ -516,7 +516,7 @@ (m2 (clone-mark m1))) (backward-object m1 3) (region-to-sequence m1 m2))) - (climacs-buffer::no-such-offset (c) + (climacs-buffer::motion-before-beginning (c) (= (climacs-buffer::condition-offset c) -1))) t) @@ -539,7 +539,7 @@ (m2 (clone-mark m1))) (forward-object m1 3) (region-to-sequence m1 m2))) - (climacs-buffer::no-such-offset (c) + (climacs-buffer::motion-after-end (c) (= (climacs-buffer::condition-offset c) 9))) t) @@ -554,7 +554,7 @@ (handler-case (let ((buffer (make-instance %%buffer))) (setf (buffer-object buffer 0) #\a)) - (climacs-buffer::no-such-offset (c) + (climacs-buffer::offset-after-end (c) (= (climacs-buffer::condition-offset c) 0))) t) @@ -562,7 +562,7 @@ (handler-case (let ((buffer (make-instance %%buffer))) (setf (buffer-object buffer -1) #\a)) - (climacs-buffer::no-such-offset (c) + (climacs-buffer::motion-before-beginning (c) (= (climacs-buffer::condition-offset c) -1))) t)

1 0