[mcclim-cvs] CVS mcclim

[thenriksen]

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

Modified Files:
	panes.lisp 
Log Message:
Attempt at making layout panes (scrollers in particular) less likely
to eat space requirements. Issues may still crop up, I do not vouch
for its correctness, but the old way was certainly just wrong. Please
test.


--- /project/mcclim/cvsroot/mcclim/panes.lisp	2007/07/21 13:18:59	1.183
+++ /project/mcclim/cvsroot/mcclim/panes.lisp	2007/08/21 21:45:49	1.184
@@ -27,7 +27,7 @@
 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;;; Boston, MA  02111-1307  USA.
 
-;;; $Id: panes.lisp,v 1.183 2007/07/21 13:18:59 rstrandh Exp $
+;;; $Id: panes.lisp,v 1.184 2007/08/21 21:45:49 thenriksen Exp $
 
 (in-package :clim-internals)
 
@@ -1171,7 +1171,7 @@
            sum (space-requirement-max-major sr) into max-major
            maximize (space-requirement-minor sr) into minor
            maximize (space-requirement-min-minor sr) into min-minor
-           maximize (space-requirement-max-minor sr) into max-minor
+           minimize (space-requirement-max-minor sr) into max-minor
            finally
              (return
                (space-requirement+*
@@ -1830,8 +1830,15 @@
 
 (defmethod compose-space ((pane viewport-pane) &key width height)
   (declare (ignorable width height))
-  ; I _think_ this is right, it certainly shouldn't be the requirements of the child.
-  (make-space-requirement))
+  ;; I _think_ this is right, it certainly shouldn't be the
+  ;; requirements of the child, apart from the max sizes. If the child
+  ;; does not want to go bigger than a specific size, we should not
+  ;; force it to do so.
+  (let ((child-sr (compose-space (first (sheet-children pane)))))
+    (if child-sr
+        (make-space-requirement :max-width (space-requirement-max-width child-sr)
+                                :max-height (space-requirement-max-height child-sr))
+        (make-space-requirement))))
 
 (defmethod allocate-space ((pane viewport-pane) width height)
   (with-slots (hscrollbar vscrollbar) (sheet-parent pane)
@@ -1960,34 +1967,59 @@
 (defmethod compose-space ((pane scroller-pane) &key width height)
   (declare (ignore width height))
   (with-slots (viewport vscrollbar hscrollbar suggested-width suggested-height
-               x-spacing y-spacing scroll-bar)
+                        x-spacing y-spacing scroll-bar)
       pane
     (if viewport
         (let ((req
-               ; v-- where does this requirement come from?
-               ;     a: just an arbitrary default
-		(make-space-requirement
+               ;; v-- where does this requirement come from?
+               ;;     a: just an arbitrary default
+               (make-space-requirement
                 :width suggested-width :height suggested-height :max-width +fill+ :max-height +fill+
                 :min-width  (max (* 2 x-spacing) (if (null scroll-bar) 0 30))
-                :min-height (max (* 2 y-spacing) (if (null scroll-bar) 0 30)))
-		#+nil
-		(make-space-requirement :height +fill+ :width +fill+)))
+                :min-height (max (* 2 y-spacing) (if (null scroll-bar) 0 30))))
+              (viewport-child (first (sheet-children viewport))))
           (when vscrollbar
             (setq req (space-requirement+*
-                        (space-requirement-combine #'max
-                              req
-                              (compose-space vscrollbar))
-                        :height     *scrollbar-thickness*
-                        :min-height *scrollbar-thickness*
-                        :max-height *scrollbar-thickness*)))
+                       (space-requirement-combine #'max
+                                                  req
+                                                  (compose-space vscrollbar))
+                       :height     *scrollbar-thickness*
+                       :min-height *scrollbar-thickness*
+                       :max-height *scrollbar-thickness*)))
           (when hscrollbar
             (setq req (space-requirement+*
-                        (space-requirement-combine #'max
-                              req
-                              (compose-space hscrollbar))
-                        :width     *scrollbar-thickness*
-                        :min-width *scrollbar-thickness*
-                        :max-width *scrollbar-thickness*)))
+                       (space-requirement-combine
+                        #'max req (compose-space hscrollbar))
+                       :width     *scrollbar-thickness*
+                       :min-width *scrollbar-thickness*
+                       :max-width *scrollbar-thickness*)))
+          (let* ((viewport-sr (compose-space viewport
+                               :width suggested-width
+                               :height suggested-height))
+                 (max-width (+ (space-requirement-max-width viewport-sr)
+                               (if vscrollbar *scrollbar-thickness* 0)
+                               ;; I don't know why this is necessary.
+                               (if (extended-output-stream-p viewport-child)
+                                   (* 4 (stream-vertical-spacing viewport-child))
+                                   0)))
+                 (max-height (+ (space-requirement-max-height viewport-sr)
+                                (if hscrollbar *scrollbar-thickness* 0)
+                                ;; I don't know why this is necessary.
+                                (if (extended-output-stream-p viewport-child)
+                                    (* 4 (stream-vertical-spacing viewport-child))
+                                    0))))
+            (setq req (make-space-requirement
+                       :width (min (space-requirement-width req)
+                                   max-width)
+                       :height (min (space-requirement-height req)
+                                    max-height)
+                       :min-width (min (space-requirement-min-width req)
+                                       max-width)
+                       :min-height (min (space-requirement-min-height req)
+                                        max-height)
+                       :max-width max-width
+                       :max-height max-height)))
+          
           req)
         (make-space-requirement))))