[climacs-cvs] CVS update: climacs/base.lisp climacs/gui.lisp climacs/packages.lisp climacs/syntax.lisp

[Robert Strandh]

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

Modified Files:
	base.lisp gui.lisp packages.lisp syntax.lisp 
Log Message:
Much improved redisplay algorithm.

The behavior when point is outside the current region on display is
much faster and similar to that of Emacs, in that the algorithm tries
to position point in the middle of the pane. 


Date: Sun Dec 26 08:18:01 2004
Author: rstrandh

Index: climacs/base.lisp
diff -u climacs/base.lisp:1.4 climacs/base.lisp:1.5
--- climacs/base.lisp:1.4	Thu Dec 23 09:00:33 2004
+++ climacs/base.lisp	Sun Dec 26 08:18:01 2004
@@ -66,6 +66,37 @@
 	(end-of-line mark)
 	(delete-region offset mark))))
 
+(defun buffer-number-of-lines-in-region (mark1 mark2)
+  "Helper function for number-of-lines-in-region.  Moves the position
+of mark1 until it is greater than or equal to that of mark2 and counts
+Newline characters along the way"
+  (loop do (end-of-line mark1)
+	while (mark< mark1 mark2)
+	count t
+	do (incf (offset mark1))))
+
+(defgeneric number-of-lines-in-region (mark1 mark2)
+  (:documentation "Return the number of lines (or rather the number of
+Newline characters) in the region between MARK and MARK2.  It is
+acceptable to pass an offset in place of one of the marks"))
+
+(defmethod number-of-lines-in-region ((mark1 mark) (mark2 mark))
+  (buffer-number-of-lines-in-region (clone-mark mark1) mark2))
+
+(defmethod number-of-lines-in-region ((offset integer) (mark mark))
+  (buffer-number-of-lines-in-region
+   (make-instance 'standard-left-sticky-mark
+      :buffer (buffer mark)
+      :offset offset)
+   mark))		  
+
+(defmethod number-of-lines-in-region ((mark mark) (offset integer))
+  (buffer-number-of-lines-in-region
+   (clone-mark mark)
+   (make-instance 'standard-left-sticky-mark
+      :buffer (buffer mark)
+      :offset offset)))
+
 (defun constituentp (obj)
   "A predicate to ensure that an object is a constituent character."
   (and (characterp obj)


Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.16 climacs/gui.lisp:1.17
--- climacs/gui.lisp:1.16	Sat Dec 25 15:49:54 2004
+++ climacs/gui.lisp	Sun Dec 26 08:18:01 2004
@@ -46,14 +46,14 @@
   ((win :reader win))
   (:panes
    (win (make-pane 'climacs-pane
-		   :width 600 :height 400
+		   :width 900 :height 400
 		   :name 'win
 		   :display-function 'display-win))
-   (int :interactor :width 600 :height 50))
+   (int :interactor :width 900 :height 50 :max-height 50))
   (:layouts
    (default
        (vertically ()
-	 (scrolling (:width 600 :height 400) win)
+	 (scrolling (:width 900 :height 400) win)
 	 int)))
   (:top-level (climacs-top-level)))
 


Index: climacs/packages.lisp
diff -u climacs/packages.lisp:1.10 climacs/packages.lisp:1.11
--- climacs/packages.lisp:1.10	Sat Dec 25 15:49:54 2004
+++ climacs/packages.lisp	Sun Dec 26 08:18:01 2004
@@ -44,6 +44,7 @@
   (:use :clim-lisp :climacs-buffer)
   (:export #:previous-line #:next-line
 	   #:open-line #:kill-line
+	   #:number-of-lines-in-region
 	   #:constituentp
 	   #:forward-word #:backward-word
 	   #:input-from-stream #:output-to-stream))


Index: climacs/syntax.lisp
diff -u climacs/syntax.lisp:1.4 climacs/syntax.lisp:1.5
--- climacs/syntax.lisp:1.4	Sat Dec 25 15:49:54 2004
+++ climacs/syntax.lisp	Sun Dec 26 08:18:01 2004
@@ -111,24 +111,30 @@
        (end-of-line bot)
        (multiple-value-bind (x y w h) (bounding-rectangle* pane)
 	 (declare (ignore x y w))
-	 (let ((nb-lines (max 1 (floor h (+ height (stream-vertical-spacing pane))))))
-	   (loop while (> (1+ (- (line-number bot) (line-number top))) nb-lines)
+	 (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)))
 	   (loop until (end-of-buffer-p bot)
-		 while (< (1+ (- (line-number bot) (line-number top))) nb-lines)
+		 repeat (- nb-lines-in-pane nb-lines-on-display)
 		 do (incf (offset bot))
 		    (end-of-line bot))
-	   (loop while (mark< (point pane) top)
-		 do (decf (offset top))
-		    (beginning-of-line top)
-		    (beginning-of-line bot)
-		    (decf (offset bot)))
-	   (loop while (mark> (point pane) bot)
-		 do (end-of-line top)
-		    (incf (offset top))
-		    (incf (offset bot))
-		    (end-of-line bot))
+	   ;; move region on display if point is outside the current region
+	   (when (or (mark< (point pane) top) (mark> (point pane) bot))
+	     (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)))
 	   (setf (offset scan) (offset top))
 	   (loop until (mark= scan bot)
 		 do (display-line pane syntax))