[climacs-cvs] CVS climacs

[thenriksen]

Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv19572

Modified Files:
	pane.lisp 
Log Message:
Improved the handling of long lines, the view now automatically
scrolls when point is moved beyond the viewport.


--- /project/climacs/cvsroot/climacs/pane.lisp	2006/08/31 18:40:48	1.50
+++ /project/climacs/cvsroot/climacs/pane.lisp	2006/09/01 18:22:15	1.51
@@ -561,10 +561,8 @@
 (defgeneric fix-pane-viewport (pane))
 
 (defmethod fix-pane-viewport ((pane climacs-pane))
-  (setf (window-viewport-position pane) (values 0 0))
   (change-space-requirements pane :min-width (bounding-rectangle-width (stream-current-output-record pane))))
 
-
 (defmethod redisplay-pane-with-syntax ((pane climacs-pane) (syntax basic-syntax) current-p)
   (display-cache pane)
   (when (region-visible-p pane) (display-region pane syntax))
@@ -583,7 +581,6 @@
   (redisplay-pane-with-syntax pane (syntax (buffer pane)) current-p)
   (fix-pane-viewport pane))
 
-
 (defgeneric full-redisplay (pane))
 
 (defmethod full-redisplay ((pane climacs-pane))
@@ -595,11 +592,25 @@
   (let ((point (point pane)))
     (multiple-value-bind (cursor-x cursor-y line-height)
 	(offset-to-screen-position (offset point) pane)
-      (updating-output (pane :unique-id -1)
+      (updating-output (pane :unique-id -1 :cache-value (offset point))
 	(draw-rectangle* pane
 			 (1- cursor-x) cursor-y
 			 (+ cursor-x 2) (+ cursor-y line-height)
-			 :ink (if current-p +red+ +blue+))))))
+			 :ink (if current-p +red+ +blue+))
+        ;; Move the position of the viewport if point is outside the
+        ;; visible area. The trick is that we do this inside the body
+        ;; of `updating-output', so the view will only be re-focused
+        ;; when point is actually moved.
+        (let ((x-position (abs (transform-position (sheet-transformation pane) 0 0)))
+              (viewport-width (bounding-rectangle-width (or (pane-viewport pane) pane))))
+          #+nil(print (list cursor-x (+ x-position (bounding-rectangle-width (pane-viewport pane)))) *terminal-io*)
+          (cond ((> cursor-x (+ x-position viewport-width))
+                 (move-sheet pane (round (- (- cursor-x viewport-width))) 0))
+                ((> x-position cursor-x)
+                 (move-sheet pane (if (> viewport-width cursor-x)
+                                      0
+                                      (round (- cursor-x)))
+                             0))))))))
 
 (defgeneric display-region (pane syntax))