[mcclim-cvs] CVS mcclim

ahefner ahefner at common-lisp.net
Tue Jan 23 07:51:11 UTC 2007


Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv21411

Modified Files:
	panes.lisp 
Log Message:
Fix typo in note-space-requirements-changed which caused unnecessary
scrolling. For reference, restored the original scroll-extent call as
a comment.



--- /project/mcclim/cvsroot/mcclim/panes.lisp	2007/01/07 19:53:05	1.177
+++ /project/mcclim/cvsroot/mcclim/panes.lisp	2007/01/23 07:51:10	1.178
@@ -27,7 +27,7 @@
 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;;; Boston, MA  02111-1307  USA.
 
-;;; $Id: panes.lisp,v 1.177 2007/01/07 19:53:05 thenriksen Exp $
+;;; $Id: panes.lisp,v 1.178 2007/01/23 07:51:10 ahefner Exp $
 
 (in-package :clim-internals)
 
@@ -1869,16 +1869,28 @@
       ;; XXX: We cannot use `scroll-extent', because McCLIM ignores it
       ;; unless the scrollee happens to be drawing. Very weird, should
       ;; be fixed.
+
+      ;; It's not a bug, it's a feature. This requires further thought. -Hefner
       (move-sheet child
                   (round (- (if (> (+ horizontal-scroll viewport-width)
                                    child-width)
                                 (- child-width viewport-width)
                                 horizontal-scroll)))
                   (round (- (if (> (+ vertical-scroll viewport-height)
-                                   child-width)
+                                   child-height)
                                 (- child-height viewport-height)
                                 vertical-scroll))))
-      (scroller-pane/update-scroll-bars (sheet-parent pane)))))
+      (scroller-pane/update-scroll-bars (sheet-parent pane))
+      #+NIL
+      (scroll-extent child
+                     (if (> (+ horizontal-scroll viewport-width)
+                            child-width)
+                         (max 0 (- child-width viewport-width))
+                         horizontal-scroll)
+                     (if (> (+ vertical-scroll viewport-height)
+                            child-height)
+                         (max 0 (- child-height viewport-height))
+                         vertical-scroll)))))
 
 ;;;;
 ;;;; SCROLLER PANE
@@ -2090,6 +2102,8 @@
     (setq viewport (first (sheet-children pane)))
     ;; make the background of the viewport match the background of the
     ;; things scrolled.
+    ;; This doesn't appear to work, hence the "gray space" bugs. Actually
+    ;; handy for observing when the space requirements get messed up.. -Hefner
     (when (first (sheet-children viewport))
       (setf (slot-value pane 'background)  ;### hmm ...
             (pane-background (first (sheet-children viewport)))))
@@ -2487,7 +2501,7 @@
   (flet ((compute (val default)
 	   (if (eq val :compute) default val)))
     (if (or (eq (pane-user-width pane) :compute)
-	    (eq (pane-user-height pane) :compute))
+            (eq (pane-user-height pane) :compute))  
 	(progn
 	  (with-output-recording-options (pane :record t :draw nil)
 	    ;; multiple-value-letf anyone?
@@ -2500,7 +2514,7 @@
 	    (stream-output-history pane)
 	    ;; Should we now get rid of the output history?
             ;; Why should we? --GB 2003-03-16
-	    (reset-output-history pane)
+            (reset-output-history pane)
 	    (let ((width (- x2 x1))
 		  (height (- y2 y1)))
               ;; I don't want this letf here --GB 2003-01-23




More information about the Mcclim-cvs mailing list