[climacs-cvs] CVS update: climacs/base.lisp climacs/buffer.lisp climacs/gui.lisp climacs/packages.lisp climacs/syntax.lisp
Robert Strandh
rstrandh at common-lisp.net
Sun Jan 9 11:54:54 UTC 2005
Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv29333
Modified Files:
base.lisp buffer.lisp gui.lisp packages.lisp syntax.lisp
Log Message:
Moved forward-object and backward-object to base.lisp because I
needed them in syntax.lisp.
Improved performance of end-of-line, the slowness of which was
a problem for redisplay.
Fixed (I hope) bug in redisplay code. I don't seem to be able to
convince McCLIM to avoid redrawing all the lines after a new
line has been inserted, though.
Date: Sun Jan 9 12:54:50 2005
Author: rstrandh
Index: climacs/base.lisp
diff -u climacs/base.lisp:1.12 climacs/base.lisp:1.13
--- climacs/base.lisp:1.12 Fri Jan 7 08:26:23 2005
+++ climacs/base.lisp Sun Jan 9 12:54:50 2005
@@ -28,6 +28,16 @@
(in-package :climacs-base)
+(defgeneric backward-object (mark &optional count))
+(defmethod backward-object ((mark climacs-buffer::mark-mixin)
+ &optional (count 1))
+ (decf (offset mark) count))
+
+(defgeneric forward-object (mark &optional count))
+(defmethod forward-object ((mark climacs-buffer::mark-mixin)
+ &optional (count 1))
+ (incf (offset mark) count))
+
(defun previous-line (mark &optional column)
"Move a mark up one line conserving horizontal position."
(unless column
Index: climacs/buffer.lisp
diff -u climacs/buffer.lisp:1.16 climacs/buffer.lisp:1.17
--- climacs/buffer.lisp:1.16 Wed Jan 5 22:39:23 2005
+++ climacs/buffer.lisp Sun Jan 9 12:54:50 2005
@@ -288,8 +288,14 @@
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))))
+ (let* ((offset (offset mark))
+ (buffer (buffer mark))
+ (chain (slot-value buffer 'contents))
+ (size (nb-elements chain)))
+ (loop until (or (= offset size)
+ (eql (element* chain offset) #\Newline))
+ do (incf offset))
+ (setf (offset mark) offset)))
(defgeneric line-number (mark)
(:documentation "Return the line number of the mark. Lines are numbered from zero."))
Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.58 climacs/gui.lisp:1.59
--- climacs/gui.lisp:1.58 Sun Jan 9 03:42:14 2005
+++ climacs/gui.lisp Sun Jan 9 12:54:50 2005
@@ -277,16 +277,6 @@
(insert-object point object)
(forward-object point)))))
-(defgeneric backward-object (mark &optional count))
-(defmethod backward-object ((mark climacs-buffer::mark-mixin)
- &optional (count 1))
- (decf (offset mark) count))
-
-(defgeneric forward-object (mark &optional count))
-(defmethod forward-object ((mark climacs-buffer::mark-mixin)
- &optional (count 1))
- (incf (offset mark) count))
-
(define-named-command com-backward-object ()
(backward-object (point (win *application-frame*))))
Index: climacs/packages.lisp
diff -u climacs/packages.lisp:1.24 climacs/packages.lisp:1.25
--- climacs/packages.lisp:1.24 Sun Jan 9 03:46:35 2005
+++ climacs/packages.lisp Sun Jan 9 12:54:50 2005
@@ -42,7 +42,8 @@
(defpackage :climacs-base
(:use :clim-lisp :climacs-buffer)
- (:export #:previous-line #:next-line
+ (:export #:forward-object #:backward-object
+ #:previous-line #:next-line
#:open-line #:kill-line
#:number-of-lines-in-region
#:constituentp #:whitespacep
Index: climacs/syntax.lisp
diff -u climacs/syntax.lisp:1.19 climacs/syntax.lisp:1.20
--- climacs/syntax.lisp:1.19 Mon Jan 3 16:07:09 2005
+++ climacs/syntax.lisp Sun Jan 9 12:54:50 2005
@@ -64,6 +64,11 @@
;;;
;;; Basic syntax
+(defun make-cache ()
+ (let ((cache (make-instance 'standard-flexichain)))
+ (insert* cache 0 nil)
+ cache))
+
(define-syntax basic-syntax ("Basic" (syntax))
((top :reader top)
(bot :reader bot)
@@ -72,7 +77,7 @@
(cursor-y :initform 2)
(space-width :initform nil)
(tab-width :initform nil)
- (cache :initform nil)))
+ (cache :initform (make-cache))))
(defmethod initialize-instance :after ((syntax basic-syntax) &rest args &key pane)
(declare (ignore args))
@@ -151,92 +156,113 @@
(terpri pane)
(incf scan))))))
-(defgeneric compute-cache (pane syntax))
+(defgeneric fill-cache (pane syntax)
+ (:documentation "fill nil cache entries from the buffer"))
-(defmethod compute-cache (pane (syntax basic-syntax))
+(defmethod fill-cache (pane (syntax basic-syntax))
(with-slots (top bot cache) syntax
- (let* ((buffer (buffer pane))
- (high-mark (high-mark buffer))
- (low-mark (low-mark buffer)))
- (when (or (mark< low-mark top) (mark> high-mark bot))
- (setf cache nil))
- (if (null cache)
- (let ((nb-lines-on-display (1+ (number-of-lines-in-region top bot)))
- (mark1 (clone-mark top))
- (mark2 (clone-mark top)))
- (setf cache (make-instance 'standard-flexichain))
- (loop for line from 0 below nb-lines-on-display
- do (beginning-of-line mark1)
- (end-of-line mark2)
- (insert* cache line (region-to-sequence mark1 mark2))
- unless (end-of-buffer-p mark2)
- do (setf (offset mark1) (1+ (offset mark2))
- (offset mark2) (offset mark1))))
- (let ((nb-lines-on-display (1+ (number-of-lines-in-region top bot)))
- (mark1 (clone-mark low-mark))
- (mark2 (clone-mark low-mark))
- (size1 (number-of-lines-in-region top low-mark))
- (size2 (number-of-lines-in-region high-mark bot)))
- (loop repeat (- (nb-elements cache) size1 size2)
- do (delete* cache size1))
- (loop for line from size1
- repeat (- nb-lines-on-display (nb-elements cache))
- do (beginning-of-line mark1)
- (end-of-line mark2)
- (insert* cache line (region-to-sequence mark1 mark2))
- unless (end-of-buffer-p mark2)
- do (setf (offset mark1) (1+ (offset mark2))
- (offset mark2) (offset mark1))))))))
+ (let ((mark1 (clone-mark top))
+ (mark2 (clone-mark top)))
+ (loop for line from 0 below (nb-elements cache)
+ do (beginning-of-line mark1)
+ (end-of-line mark2)
+ when (null (element* cache line))
+ do (setf (element* cache line) (region-to-sequence mark1 mark2))
+ unless (end-of-buffer-p mark2)
+ do (setf (offset mark1) (1+ (offset mark2))
+ (offset mark2) (offset mark1))))))
-(defun position-window (pane syntax)
+(defun nb-lines-in-pane (pane)
(let* ((medium (sheet-medium pane))
(style (medium-text-style medium))
(height (text-style-height style medium)))
+ (multiple-value-bind (x y w h) (bounding-rectangle* pane)
+ (declare (ignore x y w))
+ (max 1 (floor h (+ height (stream-vertical-spacing pane)))))))
+
+;;; make the region on display fit the size of the pane as closely as
+;;; possible by adjusting bot leaving top intact. Also make the cache
+;;; size fit the size of the region on display.
+(defun adjust-cache-size-and-bot (pane syntax)
+ (let ((nb-lines-in-pane (nb-lines-in-pane pane)))
+ (with-slots (top bot cache) syntax
+ (setf (offset bot) (offset top))
+ (loop until (end-of-buffer-p bot)
+ repeat (1- nb-lines-in-pane)
+ do (forward-object bot)
+ (end-of-line bot))
+ (let ((nb-lines-on-display (1+ (number-of-lines-in-region top bot))))
+ (loop repeat (- (nb-elements cache) nb-lines-on-display)
+ do (pop-end cache))
+ (loop repeat (- nb-lines-on-display (nb-elements cache))
+ do (push-end cache nil))))))
+
+;;; put all-nil entries in the cache
+(defun empty-cache (cache)
+ (loop for i from 0 below (nb-elements cache)
+ do (setf (element* cache i) nil)))
+
+;;; empty the cache and try to put point close to the middle
+;;; of the pane by moving top half a pane-size up.
+(defun reposition-window (pane syntax)
+ (let ((nb-lines-in-pane (nb-lines-in-pane pane)))
+ (with-slots (top bot cache) syntax
+ (empty-cache cache)
+ (setf (offset top) (offset (point pane)))
+ (loop do (beginning-of-line top)
+ repeat (floor nb-lines-in-pane 2)
+ until (beginning-of-buffer-p top)
+ do (decf (offset top))
+ (beginning-of-line top)))))
+
+;;; Make the cache reflect the contents of the buffer starting at top,
+;;; trying to preserve contents as much as possible, and inserting a
+;;; nil entry where buffer contents is unknonwn. The size of the
+;;; cache size at the end may be smaller than, equal to, or greater
+;;; than the number of lines in the pane.
+(defun adjust-cache (pane syntax)
+ (let* ((buffer (buffer pane))
+ (high-mark (high-mark buffer))
+ (low-mark (low-mark buffer))
+ (nb-lines-in-pane (nb-lines-in-pane pane)))
(with-slots (top bot cache) syntax
(beginning-of-line top)
(end-of-line bot)
- (multiple-value-bind (x y w h) (bounding-rectangle* pane)
- (declare (ignore x y w))
- (let ((nb-lines-in-pane (max 1 (floor h (+ height (stream-vertical-spacing pane)))))
- (nb-lines-on-display (1+ (number-of-lines-in-region top bot))))
- ;; adjust the region on display to fit the pane
- (loop repeat (- nb-lines-on-display nb-lines-in-pane)
- do (beginning-of-line bot)
- (decf (offset bot))
- (unless (null cache)
- (pop-end cache)))
- (loop until (end-of-buffer-p bot)
- repeat (- nb-lines-in-pane nb-lines-on-display)
- do (incf (offset bot))
+ (if (or (mark< (point pane) top)
+ (>= (number-of-lines-in-region top (point pane)) nb-lines-in-pane)
+ (and (mark< low-mark top)
+ (>= (number-of-lines-in-region top high-mark) (nb-elements cache))))
+ (reposition-window pane syntax)
+ (let* ((n1 (number-of-lines-in-region top low-mark))
+ (n2 (1+ (number-of-lines-in-region low-mark high-mark)))
+ (n3 (number-of-lines-in-region high-mark bot))
+ (diff (- (+ n1 n2 n3) (nb-elements cache))))
+ (cond ((>= (+ n1 n2 n3) (+ (nb-elements cache) 20))
+ (setf (offset bot) (offset top))
(end-of-line bot)
- (setf cache nil))
- ;; move region on display if point is outside the current region
- (when (or (mark< (point pane) top) (mark> (point pane) bot))
- (setf cache nil)
- (setf (offset top) (offset (point pane)))
- (loop do (beginning-of-line top)
- repeat (floor nb-lines-in-pane 2)
- until (beginning-of-buffer-p top)
- do (decf (offset top))
- (beginning-of-line top))
- (setf (offset bot) (offset top))
- (loop do (end-of-line bot)
- repeat (1- nb-lines-in-pane)
- until (end-of-buffer-p bot)
- do (incf (offset bot))
- (end-of-line bot))))))))
+ (loop for i from n1 below (nb-elements cache)
+ do (setf (element* cache i) nil)))
+ ((>= diff 0)
+ (loop repeat diff do (insert* cache n1 nil))
+ (loop for i from (+ n1 diff) below (+ n1 n2)
+ do (setf (element* cache i) nil)))
+ (t
+ (loop repeat (- diff) do (delete* cache n1))
+ (loop for i from n1 below (+ n1 n2)
+ do (setf (element* cache i) nil))))))))
+ (adjust-cache-size-and-bot pane syntax))
(defun page-down (pane syntax)
- (position-window pane syntax)
+ (adjust-cache pane syntax)
(with-slots (top bot cache) syntax
(when (mark> (size (buffer bot)) bot)
+ (empty-cache cache)
(setf (offset top) (offset bot))
(beginning-of-line top)
- (setf (offset (point pane)) (offset top))
- (setf cache nil))))
+ (setf (offset (point pane)) (offset top)))))
(defun page-up (pane syntax)
- (position-window pane syntax)
+ (adjust-cache pane syntax)
(with-slots (top bot cache) syntax
(when (> (offset top) 0)
(let ((nb-lines-in-region (number-of-lines-in-region top bot)))
@@ -247,10 +273,10 @@
do (decf (offset top))
(beginning-of-line top))
(setf (offset (point pane)) (offset top))
- (position-window pane syntax)
+ (adjust-cache pane syntax)
(setf (offset (point pane)) (offset bot))
(beginning-of-line (point pane))
- (setf cache nil)))))
+ (empty-cache cache)))))
;;; this one should not be necessary.
(defun round-up (x)
@@ -263,8 +289,8 @@
(style (medium-text-style medium))
(height (text-style-height style medium)))
(with-slots (top bot scan cache cursor-x cursor-y) syntax
- (position-window pane syntax)
- (compute-cache pane syntax)
+ (adjust-cache pane syntax)
+ (fill-cache pane syntax)
(loop with start-offset = (offset top)
for id from 0 below (nb-elements cache)
do (setf scan start-offset)
More information about the Climacs-cvs
mailing list