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))