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