From manuel.giraud at univ-nantes.fr  Mon Sep 27 15:06:11 2010
From: manuel.giraud at univ-nantes.fr (Manuel Giraud)
Date: Mon, 27 Sep 2010 17:06:11 +0200
Subject: [mcclim-devel] Drei reposition
Message-ID: <87vd5rjkf0.fsf@univ-nantes.fr>


Hi, here's a patch to correct the behaviour of the "C-l" gesture in
Climacs to be more like the Emacs one.

Index: drei-redisplay.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp,v
retrieving revision 1.71
diff -u -r1.71 drei-redisplay.lisp
--- drei-redisplay.lisp 3 May 2008 07:47:17 -0000       1.71
+++ drei-redisplay.lisp 27 Sep 2010 15:01:16 -0000
@@ -1090,6 +1090,12 @@
     (declare (ignore y1))
     (- x2 x1)))
 
+(defmethod bounding-rectangle-height ((view drei-buffer-view))
+  (multiple-value-bind (x1 y1 x2 y2)
+      (bounding-rectangle* view)
+    (declare (ignore x1 x2))
+    (- y2 y1)))
+
 (defun drei-bounding-rectangle* (drei-instance)
   "Return the bounding rectangle of the visual appearance of
 `drei-instance' as four values, just as `bounding-rectangle*'."
@@ -1172,15 +1178,22 @@
   "Try to put point close to the middle of the pane by moving top
 half a pane-size up."
   (let* ((view (view drei-pane))
-         (nb-lines-in-pane (number-of-lines-in-region (top view) (bot view))))
-    (with-accessors ((top top) (point point)) view
-      (setf (offset top) (offset point))
-      (beginning-of-line top)
-      (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))
+         (buffer (buffer view))
+         (line-and-space-height (+ (text-style-height (medium-merged-text-style
+                                                       (sheet-medium drei-pane)) drei-pane)
+                                   (stream-vertical-spacing drei-pane)))
+         (nb-lines-in-pane (floor (bounding-rectangle-height drei-pane)
+                                  line-and-space-height))
+         (nb-lines-in-buffer (number-of-lines buffer)))
+    (when (> nb-lines-in-buffer nb-lines-in-pane)
+      (with-accessors ((top top) (point point)) view
+        (setf (offset top) (offset point))
+        (beginning-of-line top)
+        (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)))
       (invalidate-all-strokes view :modified t))))
 
 (defun adjust-pane (drei-pane)

-- 
Manuel Giraud