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)
