[mcclim-cvs] CVS update: mcclim/panes.lisp

[Gilbert Baumann]

Update of /project/mcclim/cvsroot/mcclim
In directory common-lisp.net:/tmp/cvs-serv27504

Modified Files:
	panes.lisp 
Log Message:
TABLE-PANE
    The table pane now recognizes x-spacing and y-spacing, but units
    are not tested.


Date: Mon Nov 28 14:23:55 2005
Author: gbaumann

Index: mcclim/panes.lisp
diff -u mcclim/panes.lisp:1.156 mcclim/panes.lisp:1.157
--- mcclim/panes.lisp:1.156	Thu Oct 27 03:21:33 2005
+++ mcclim/panes.lisp	Mon Nov 28 14:23:53 2005
@@ -27,7 +27,7 @@
 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;;; Boston, MA  02111-1307  USA.
 
-;;; $Id: panes.lisp,v 1.156 2005/10/27 01:21:33 rstrandh Exp $
+;;; $Id: panes.lisp,v 1.157 2005/11/28 13:23:53 gbaumann Exp $
 
 (in-package :clim-internals)
 
@@ -1471,59 +1471,67 @@
 
 (defmethod compose-space ((pane table-pane) &key width height)
   (declare (ignore width height))
-  (with-slots (array) pane
+  (with-slots (array x-spacing y-spacing) pane
     ; ---v our problem is here.
+    ; Which problem? --GB
     (let ((rsrs (loop for i from 0 below (array-dimension array 0) 
                     collect (table-pane-row-space-requirement pane i)))
           (csrs (loop for j from 0 below (array-dimension array 1) 
-                    collect (table-pane-col-space-requirement pane j))))
+                    collect (table-pane-col-space-requirement pane j)))
+          (xs (* x-spacing (1- (array-dimension array 1))))
+          (ys (* y-spacing (1- (array-dimension array 0)))))
       (let ((r (stack-space-requirements-vertically rsrs))
             (c (stack-space-requirements-horizontally csrs)))
         (let ((res
                (make-space-requirement
-                :width      (space-requirement-width r)
-                :min-width  (space-requirement-min-width r)
-                :max-width  (space-requirement-max-width r)
-                :height     (space-requirement-height c)
-                :min-height (space-requirement-min-height c)
-                :max-height (space-requirement-max-height c))))
+                :width      (+ (space-requirement-width r) xs)
+                :min-width  (+ (space-requirement-min-width r) xs)
+                :max-width  (+ (space-requirement-max-width r) xs)
+                :height     (+ (space-requirement-height c) ys)
+                :min-height (+ (space-requirement-min-height c) ys)
+                :max-height (+ (space-requirement-max-height c) ys))))
           #+nil
           (format *trace-output* "~%;;; TABLE-PANE sr = ~S." res)
           res)))))
 
-(defmethod allocate-space ((pane table-pane) width height &aux rsrs csrs)
-  (declare (ignorable rsrs csrs))
-  (with-slots (array) pane
-    ;; allot rows
-    (let ((rows (allot-space-vertically
-                 (setq rsrs (loop for i from 0 below (array-dimension array 0)
-                                collect (table-pane-row-space-requirement pane i)))
-                 height))
-          (cols (allot-space-horizontally
-                 (setq csrs (loop for j from 0 below (array-dimension array 1)
-                                collect (table-pane-col-space-requirement pane j)))
-                 width)))
-      #+nil
-      (progn
-        (format T "~&;; row space requirements = ~S." rsrs)
-        (format T "~&;; col space requirements = ~S." csrs)
-        (format T "~&;; row allotment: needed = ~S result = ~S (sum ~S)." height rows (reduce #'+ rows))
-        (format T "~&;; col allotment: needed = ~S result = ~S (sum ~S)." width cols (reduce #'+ cols))
-        (format T "~&;; align-x = ~S, align-y ~S~%"
-                (pane-align-x pane)
-                (pane-align-y pane)))
-      ;; now finally layout each child
-      (loop
-          for y = 0 then (+ y h)
-          for h in rows
-          for i from 0
-          do (loop
-                 for x = 0 then (+ x w)
-                 for w in cols
-                 for j from 0
-                 do (layout-child (aref array i j) (pane-align-x pane) (pane-align-y pane)
-                                  x y w h))))))
-
+(defmethod allocate-space ((pane table-pane) width height)
+  (let (rsrs csrs)
+    (declare (ignorable rsrs csrs))
+    (with-slots (array x-spacing y-spacing) pane
+      ;; allot rows
+      (let* ((xs (* x-spacing (1- (array-dimension array 1))))
+             (ys (* y-spacing (1- (array-dimension array 0))))
+             (rows (allot-space-vertically
+                    (setq rsrs (loop for i from 0 below (array-dimension array 0)
+                                     collect (table-pane-row-space-requirement pane i)))
+                    (- height ys)))
+             (cols (allot-space-horizontally
+                    (setq csrs (loop for j from 0 below (array-dimension array 1)
+                                     collect (table-pane-col-space-requirement pane j)))
+                    (- width xs))))
+        #+nil
+        (progn
+          (format T "~&;; row space requirements = ~S." rsrs)
+          (format T "~&;; col space requirements = ~S." csrs)
+          (format T "~&;; row allotment: needed = ~S result = ~S (sum ~S)." height rows (reduce #'+ rows))
+          (format T "~&;; col allotment: needed = ~S result = ~S (sum ~S)." width cols (reduce #'+ cols))
+          (format T "~&;; align-x = ~S, align-y ~S~%"
+                  (pane-align-x pane)
+                  (pane-align-y pane)))
+        ;; now finally layout each child
+        (loop
+            for y = 0 then (+ y h y-spacing)
+            for h in rows
+            for i from 0
+            do (loop
+                   for x = 0 then (+ x w x-spacing)
+                   for w in cols
+                   for j from 0
+                   do (let ((child (aref array i j)))
+                        (layout-child child
+                                      (pane-align-x pane)
+                                      (pane-align-y pane)
+                                      x y w h))))))))
 
 (defun table-pane-p (pane)
   (typep pane 'table-pane))