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)