[climacs-cvs] CVS update: climacs/buffer.lisp

[Matthieu Villeneuve]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv6911

Modified Files:
	buffer.lisp 
Log Message:
Added a (setf buffer-object) method
Date: Thu Jan 13 16:31:12 2005
Author: mvilleneuve

Index: climacs/buffer.lisp
diff -u climacs/buffer.lisp:1.17 climacs/buffer.lisp:1.18
--- climacs/buffer.lisp:1.17	Sun Jan  9 12:54:50 2005
+++ climacs/buffer.lisp	Thu Jan 13 16:31:11 2005
@@ -410,6 +410,16 @@
 	  (make-condition 'no-such-offset :offset offset))
   (element* (slot-value buffer 'contents) offset))
 
+(defgeneric (setf buffer-object) (object buffer offset)
+  (:documentation "Set the object at the offset in the buffer. The first object
+has offset 0. If offset is less than zero or greater than or equal to
+the size of the buffer, a no-such-offset condition is signaled."))
+
+(defmethod (setf buffer-object) (object (buffer standard-buffer) offset)
+  (assert (<= 0 offset (1- (size buffer))) ()
+          (make-condition 'no-such-offset :offset offset))
+  (setf (element* (slot-value buffer 'contents) offset) object))
+
 (defgeneric buffer-sequence (buffer offset1 offset2)
   (:documentation "Return the contents of the buffer starting at offset1 and ending at
 offset2-1 as a sequence.  If either of the offsets is less than zero
@@ -464,6 +474,14 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; Buffer modification protocol
+
+(defmethod (setf buffer-object) :before (object (buffer standard-buffer) offset)
+  (declare (ignore object))
+  (setf (offset (low-mark buffer))
+        (min (offset (low-mark buffer)) offset))
+  (setf (offset (high-mark buffer))
+        (max (offset (high-mark buffer)) offset))
+  (setf (slot-value buffer 'modified) t))
 
 (defmethod insert-buffer-object :before ((buffer standard-buffer) offset object)
   (declare (ignore object))