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

[Robert Strandh]

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

Modified Files:
	buffer.lisp buffer.text packages.lisp 
Log Message:
Completed the description of the buffer modification protocol.

Implemented the protocol.

Updated the buffer package accordingly.

Date: Thu Dec 23 18:24:45 2004
Author: rstrandh

Index: climacs/buffer.lisp
diff -u climacs/buffer.lisp:1.9 climacs/buffer.lisp:1.10
--- climacs/buffer.lisp:1.9	Thu Dec 23 09:00:33 2004
+++ climacs/buffer.lisp	Thu Dec 23 18:24:44 2004
@@ -34,8 +34,14 @@
 newline characters.  The last object of the buffer is not
 necessarily a newline character."))
 
+(defgeneric low-mark (buffer))
+
+(defgeneric high-mark (buffer))
+
 (defclass standard-buffer (buffer)
-  ((contents :initform (make-instance 'standard-cursorchain)))
+  ((contents :initform (make-instance 'standard-cursorchain))
+   (low-mark :reader low-mark)
+   (high-mark :reader high-mark))
   (:documentation "The Climacs standard buffer [an instantable subclass of buffer]."))
 
 (defgeneric buffer (mark)
@@ -99,6 +105,13 @@
 	   :chain (slot-value (buffer mark) 'contents)
 	   :position offset)))
 
+(defmethod initialize-instance :after ((buffer standard-buffer) &rest args)
+  "Create the low-mark and high-mark"
+  (declare (ignore args))
+  (with-slots (low-mark high-mark) buffer
+     (setf low-mark (make-instance 'standard-left-sticky-mark :buffer buffer))
+     (setf high-mark (make-instance 'standard-right-sticky-mark :buffer buffer))))
+
 (defgeneric clone-mark (mark &optional type)
   (:documentation "Clone a mark.  By default (when type is NIL) the same type of mark is
 returned.  Otherwise type is the name of a class (subclass of the mark
@@ -240,27 +253,6 @@
 (defmethod end-of-buffer-p ((mark mark-mixin))
   (= (offset mark) (size (buffer mark))))
 
-(defgeneric beginning-of-line (mark)
-  (:documentation "Move the mark to the beginning of the line.  The mark will be
- positioned either immediately after the closest preceding newline
- character, or at the beginning of the buffer if no preceding newline
- character exists."))
-
-(defmethod beginning-of-line ((mark mark-mixin))
-  (loop until (or (beginning-of-buffer-p mark)
-		  (eql (object-before mark) #\Newline))
-	do (decf (offset mark))))
-
-(defgeneric end-of-line (mark)
-  (:documentation "Move the mark to the end of the line. The mark will be positioned
-either immediately before the closest following newline character, or
-at the end of the buffer if no following newline character exists."))
-
-(defmethod end-of-line ((mark mark-mixin))
-  (loop until (or (end-of-buffer-p mark)
-		  (eql (object-after mark) #\Newline))
-	do (incf (offset mark))))
-
 (defgeneric beginning-of-line-p (mark)
   (:documentation "Return t if the mark is at the beginning of the line (i.e., if the
 character preceding the mark is a newline character or if the mark is
@@ -279,6 +271,25 @@
   (or (end-of-buffer-p mark)
       (eql (object-after mark) #\Newline)))
 
+(defgeneric beginning-of-line (mark)
+  (:documentation "Move the mark to the beginning of the line.  The mark will be
+ positioned either immediately after the closest preceding newline
+ character, or at the beginning of the buffer if no preceding newline
+ character exists."))
+
+(defmethod beginning-of-line ((mark mark-mixin))
+  (loop until (beginning-of-line-p mark)
+	do (decf (offset mark))))
+
+(defgeneric end-of-line (mark)
+  (:documentation "Move the mark to the end of the line. The mark will be positioned
+either immediately before the closest following newline character, or
+at the end of the buffer if no following newline character exists."))
+
+(defmethod end-of-line ((mark mark-mixin))
+  (loop until (end-of-line-p mark)
+	do (incf (offset mark))))
+
 (defgeneric line-number (mark)
   (:documentation "Return the line number of the mark.  Lines are numbered from zero."))
 
@@ -439,4 +450,32 @@
   (assert (eq (buffer mark1) (buffer mark2)))
   (buffer-sequence (buffer mark1) (offset mark1) (offset mark2)))
 
-
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Buffer modification protocol
+
+(defmethod insert-buffer-object :before ((buffer standard-buffer) offset object)
+  (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)))
+
+(defmethod insert-buffer-sequence :before ((buffer standard-buffer) offset sequence)
+  (declare (ignore sequence))
+  (setf (offset (low-mark buffer))
+	(min (offset (low-mark buffer)) offset))
+  (setf (offset (high-mark buffer))
+	(max (offset (high-mark buffer)) offset)))
+
+(defmethod delete-buffer-range :before ((buffer standard-buffer) offset n)
+  (setf (offset (low-mark buffer))
+	(min (offset (low-mark buffer)) offset))
+  (setf (offset (high-mark buffer))
+	(max (offset (high-mark buffer)) (+ offset n))))
+
+(defgeneric reset-low-high-marks (buffer))
+
+(defmethod reset-low-high-marks ((buffer standard-buffer))
+  (beginning-of-buffer (high-mark buffer))
+  (end-of-buffer (low-mark buffer)))


Index: climacs/buffer.text
diff -u climacs/buffer.text:1.3 climacs/buffer.text:1.4
--- climacs/buffer.text:1.3	Tue Dec 21 17:19:26 2004
+++ climacs/buffer.text	Thu Dec 23 18:24:44 2004
@@ -323,12 +323,13 @@
  of its current value and the position of the modification.
 
  Redisplay code may use these values to determine what part of the
- screen needs to be updated.  At the end of an invocation of
- redisplay, the offset of the low mark is set to the size of the
- buffer, and the offset of the high mark is set to zero.
+ screen needs to be updated.  These values can also be used to update
+ information about syntax highlighting and other cached information.
 
- These values can also be used to update information about syntax
- highlighting and other cached information. 
+reset-low-high-marks buffer                         [generic function]
+
+ Set the high-mark to the beginning of the beginning of the buffer and
+ the low-mark to the end of the buffer. 
 
 The redisplay protocol
 ======================


Index: climacs/packages.lisp
diff -u climacs/packages.lisp:1.6 climacs/packages.lisp:1.7
--- climacs/packages.lisp:1.6	Thu Dec 23 09:00:33 2004
+++ climacs/packages.lisp	Thu Dec 23 18:24:45 2004
@@ -37,7 +37,8 @@
 	   #:delete-buffer-range #:delete-range
 	   #:delete-region
 	   #:buffer-object #:buffer-sequence
-	   #:object-before #:object-after #:region-to-sequence))
+	   #:object-before #:object-after #:region-to-sequence
+	   #:low-mark #:high-mark #:reset-low-high-marks))
 
 (defpackage :climacs-base
   (:use :clim-lisp :climacs-buffer)