Commit 4c7a7b1e authored by Aleksandar Bakic's avatar Aleksandar Bakic

Updated persistent buffers and tests to catch up with recent changes.

parent 49323b25
......@@ -103,8 +103,10 @@ that is used in a PERSISTENT-BUFFER."))
(cursor-pos (cursor mark)))
(defmethod (setf offset) (new-offset (mark p-mark-mixin))
(assert (<= 0 new-offset (size (buffer mark))) ()
(make-condition 'no-such-offset :offset new-offset))
(assert (<= 0 new-offset) ()
(make-condition 'motion-before-beginning :offset new-offset))
(assert (<= new-offset (size (buffer mark))) ()
(make-condition 'motion-after-end :offset new-offset))
(setf (cursor-pos (cursor mark)) new-offset))
(defclass persistent-left-sticky-mark (left-sticky-mark p-mark-mixin) ()
......@@ -119,8 +121,10 @@ PERSISTENT-BUFFER."))
&rest args &key (offset 0))
"Associates a created mark with the buffer for which it was created."
(declare (ignorable args))
(assert (<= 0 offset (size (buffer mark))) ()
(make-condition 'no-such-offset :offset offset))
(assert (<= 0 offset) ()
(make-condition 'motion-before-beginning :offset offset))
(assert (<= offset (size (buffer mark))) ()
(make-condition 'motion-after-end :offset offset))
(setf (slot-value mark 'cursor)
(make-instance 'left-sticky-persistent-cursor
:buffer (buffer mark)
......@@ -130,8 +134,10 @@ PERSISTENT-BUFFER."))
&rest args &key (offset 0))
"Associates a created mark with the buffer for which it was created."
(declare (ignorable args))
(assert (<= 0 offset (size (buffer mark))) ()
(make-condition 'no-such-offset :offset offset))
(assert (<= 0 offset) ()
(make-condition 'motion-before-beginning :offset offset))
(assert (<= offset (size (buffer mark))) ()
(make-condition 'motion-after-end :offset offset))
(setf (slot-value mark 'cursor)
(make-instance 'right-sticky-persistent-cursor
:buffer (buffer mark)
......@@ -145,6 +151,26 @@ PERSISTENT-BUFFER."))
(setf high-mark (make-instance 'persistent-right-sticky-mark
:buffer buffer))))
(defmethod clone-mark ((mark persistent-left-sticky-mark) &optional stick-to)
(cond
((or (null stick-to) (eq stick-to :left))
(make-instance 'persistent-left-sticky-mark
:buffer (buffer mark) :offset (offset mark)))
((eq stick-to :right)
(make-instance 'persistent-right-sticky-mark
:buffer (buffer mark) :offset (offset mark)))
(t (error "invalid value for stick-to"))))
(defmethod clone-mark ((mark persistent-right-sticky-mark) &optional stick-to)
(cond
((or (null stick-to) (eq stick-to :right))
(make-instance 'persistent-right-sticky-mark
:buffer (buffer mark) :offset (offset mark)))
((eq stick-to :left)
(make-instance 'persistent-left-sticky-mark
:buffer (buffer mark) :offset (offset mark)))
(t (error "invalid value for stick-to"))))
(defmethod size ((buffer binseq-buffer))
(binseq-length (slot-value buffer 'contents)))
......@@ -258,8 +284,10 @@ PERSISTENT-BUFFER."))
;;; it can be saved for UNDO purposes in a history tree, by an UNDOABLE-BUFFER
(defmethod insert-buffer-object ((buffer binseq-buffer) offset object)
(assert (<= 0 offset (size buffer)) ()
(make-condition 'no-such-offset :offset offset))
(assert (<= 0 offset) ()
(make-condition 'offset-before-beginning :offset offset))
(assert (<= offset (size buffer)) ()
(make-condition 'offset-after-end :offset offset))
(setf (slot-value buffer 'contents)
(binseq-insert (slot-value buffer 'contents) offset object)))
......@@ -286,8 +314,10 @@ PERSISTENT-BUFFER."))
(insert-buffer-sequence (buffer mark) (offset mark) sequence))
(defmethod delete-buffer-range ((buffer binseq-buffer) offset n)
(assert (<= 0 offset (size buffer)) ()
(make-condition 'no-such-offset :offset offset))
(assert (<= 0 offset) ()
(make-condition 'offset-before-beginning :offset offset))
(assert (<= offset (size buffer)) ()
(make-condition 'offset-after-end :offset offset))
(setf (slot-value buffer 'contents)
(binseq-remove* (slot-value buffer 'contents) offset n)))
......@@ -324,32 +354,44 @@ PERSISTENT-BUFFER."))
(delete-buffer-range (buffer mark2) offset1 (- offset2 offset1))))
(defmethod buffer-object ((buffer binseq-buffer) offset)
(assert (<= 0 offset (1- (size buffer))) ()
(make-condition 'no-such-offset :offset offset))
(assert (<= 0 offset) ()
(make-condition 'offset-before-beginning :offset offset))
(assert (<= offset (1- (size buffer))) ()
(make-condition 'offset-after-end :offset offset))
(binseq-get (slot-value buffer 'contents) offset))
(defmethod (setf buffer-object) (object (buffer binseq-buffer) offset)
(assert (<= 0 offset (1- (size buffer))) ()
(make-condition 'no-such-offset :offset offset))
(assert (<= 0 offset) ()
(make-condition 'offset-before-beginning :offset offset))
(assert (<= offset (1- (size buffer))) ()
(make-condition 'offset-after-end :offset offset))
(setf (slot-value buffer 'contents)
(binseq-set (slot-value buffer 'contents) offset object)))
(defmethod buffer-object ((buffer obinseq-buffer) offset)
(assert (<= 0 offset (1- (size buffer))) ()
(make-condition 'no-such-offset :offset offset))
(assert (<= 0 offset) ()
(make-condition 'offset-before-beginning :offset offset))
(assert (<= offset (1- (size buffer))) ()
(make-condition 'offset-after-end :offset offset))
(obinseq-get (slot-value buffer 'contents) offset))
(defmethod (setf buffer-object) (object (buffer obinseq-buffer) offset)
(assert (<= 0 offset (1- (size buffer))) ()
(make-condition 'no-such-offset :offset offset))
(assert (<= 0 offset) ()
(make-condition 'offset-before-beginning :offset offset))
(assert (<= offset (1- (size buffer))) ()
(make-condition 'offset-after-end :offset offset))
(setf (slot-value buffer 'contents)
(obinseq-set (slot-value buffer 'contents) offset object)))
(defmethod buffer-sequence ((buffer binseq-buffer) offset1 offset2)
(assert (<= 0 offset1 (size buffer)) ()
(make-condition 'no-such-offset :offset offset1))
(assert (<= 0 offset2 (size buffer)) ()
(make-condition 'no-such-offset :offset offset2))
(assert (<= 0 offset1) ()
(make-condition 'offset-before-beginning :offset offset1))
(assert (<= offset1 (size buffer)) ()
(make-condition 'offset-after-end :offset offset1))
(assert (<= 0 offset2) ()
(make-condition 'offset-before-beginning :offset offset2))
(assert (<= offset2 (size buffer)) ()
(make-condition 'offset-after-end :offset offset2))
(coerce
(let ((len (- offset2 offset1)))
(if (> len 0)
......
......@@ -8,20 +8,22 @@
(defmultitest previous-line.test-1
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs
climacs
climacs")
(let ((mark (make-instance %%left-sticky-mark
:buffer buffer :offset 8)))
(previous-line mark)
:buffer buffer :offset 16)))
(previous-line mark nil 2)
(offset mark)))
0)
(defmultitest previous-line.test-2
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs
climacs
climacs")
(let ((mark (make-instance %%right-sticky-mark
:buffer buffer :offset 11)))
(previous-line mark 2)
:buffer buffer :offset 19)))
(previous-line mark 2 2)
(offset mark)))
2)
......@@ -78,22 +80,24 @@ climacs2")
(defmultitest next-line.test-1
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs
climacs
climacs")
(let ((mark (make-instance %%left-sticky-mark
:buffer buffer :offset 6)))
(next-line mark)
(next-line mark nil 2)
(offset mark)))
14)
22)
(defmultitest next-line.test-2
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs
climacs
climacs")
(let ((mark (make-instance %%right-sticky-mark
:buffer buffer :offset 3)))
(next-line mark 2)
(next-line mark 2 2)
(offset mark)))
10)
18)
(defmultitest next-line.test-3
(let ((buffer (make-instance %%buffer)))
......@@ -150,9 +154,10 @@ climacs")
(insert-buffer-sequence buffer 0 "climacs")
(let ((mark (make-instance %%left-sticky-mark
:buffer buffer :offset 0)))
(open-line mark)
(open-line mark 2)
(values (buffer-sequence buffer 0 (size buffer)) (offset mark))))
"
climacs" 0)
(defmultitest open-line.test-2
......
......@@ -55,7 +55,7 @@
(handler-case
(let ((buffer (make-instance %%buffer)))
(make-instance %%left-sticky-mark :buffer buffer :offset 1))
(climacs-buffer::no-such-offset (c)
(climacs-buffer::motion-after-end (c)
(= (climacs-buffer::condition-offset c) 1)))
t)
......@@ -63,7 +63,7 @@
(handler-case
(let ((buffer (make-instance %%buffer)))
(make-instance %%right-sticky-mark :buffer buffer :offset 1))
(climacs-buffer::no-such-offset (c)
(climacs-buffer::motion-after-end (c)
(= (climacs-buffer::condition-offset c) 1)))
t)
......@@ -137,7 +137,7 @@
(handler-case
(let ((buffer (make-instance %%buffer)))
(insert-buffer-object buffer -1 #\a))
(climacs-buffer::no-such-offset (c)
(climacs-buffer::motion-before-beginning (c)
(= (climacs-buffer::condition-offset c) -1)))
t)
......@@ -171,7 +171,7 @@
(handler-case
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 1 "climacs"))
(climacs-buffer::no-such-offset (c)
(climacs-buffer::motion-after-end (c)
(= (climacs-buffer::condition-offset c) 1)))
t)
......@@ -179,7 +179,7 @@
(handler-case
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer -1 "climacs"))
(climacs-buffer::no-such-offset (c)
(climacs-buffer::motion-before-beginning (c)
(= (climacs-buffer::condition-offset c) -1)))
t)
......@@ -225,7 +225,7 @@
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs")
(delete-buffer-range buffer -1 0))
(climacs-buffer::no-such-offset (c)
(climacs-buffer::motion-before-beginning (c)
(= (climacs-buffer::condition-offset c) -1)))
t)
......@@ -234,7 +234,7 @@
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs")
(delete-buffer-range buffer 6 2))
(climacs-buffer::no-such-offset (c)
(climacs-buffer::motion-after-end (c)
(= (climacs-buffer::condition-offset c) 8)))
t)
......@@ -482,7 +482,7 @@ climacs
(let ((m (make-instance %%left-sticky-mark
:buffer buffer :offset 4)))
(setf (offset m) -1)))
(climacs-buffer::no-such-offset (c)
(climacs-buffer::motion-before-beginning (c)
(= (climacs-buffer::condition-offset c) -1)))
t)
......@@ -493,7 +493,7 @@ climacs
(let ((m (make-instance %%left-sticky-mark
:buffer buffer :offset 4)))
(setf (offset m) 8)))
(climacs-buffer::no-such-offset (c)
(climacs-buffer::motion-after-end (c)
(= (climacs-buffer::condition-offset c) 8)))
t)
......@@ -516,7 +516,7 @@ climacs
(m2 (clone-mark m1)))
(backward-object m1 3)
(region-to-sequence m1 m2)))
(climacs-buffer::no-such-offset (c)
(climacs-buffer::motion-before-beginning (c)
(= (climacs-buffer::condition-offset c) -1)))
t)
......@@ -539,7 +539,7 @@ climacs
(m2 (clone-mark m1)))
(forward-object m1 3)
(region-to-sequence m1 m2)))
(climacs-buffer::no-such-offset (c)
(climacs-buffer::motion-after-end (c)
(= (climacs-buffer::condition-offset c) 9)))
t)
......@@ -554,7 +554,7 @@ climacs
(handler-case
(let ((buffer (make-instance %%buffer)))
(setf (buffer-object buffer 0) #\a))
(climacs-buffer::no-such-offset (c)
(climacs-buffer::offset-after-end (c)
(= (climacs-buffer::condition-offset c) 0)))
t)
......@@ -562,7 +562,7 @@ climacs
(handler-case
(let ((buffer (make-instance %%buffer)))
(setf (buffer-object buffer -1) #\a))
(climacs-buffer::no-such-offset (c)
(climacs-buffer::motion-before-beginning (c)
(= (climacs-buffer::condition-offset c) -1)))
t)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment