[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