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

Modified Files: panes.lisp Log Message: Attempt to remedy bit rot in grid-pane.

Date: Mon Jan 31 19:08:28 2005 Author: ahefner

Index: mcclim/panes.lisp diff -u mcclim/panes.lisp:1.148 mcclim/panes.lisp:1.149 --- mcclim/panes.lisp:1.148 Fri Jan 21 03:01:37 2005 +++ mcclim/panes.lisp Mon Jan 31 19:08:27 2005 @@ -27,7 +27,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA.

-;;; $Id: panes.lisp,v 1.148 2005/01/21 11:01:37 ahefner Exp $ +;;; $Id: panes.lisp,v 1.149 2005/02/01 03:08:27 ahefner Exp $

(in-package :clim-internals)

@@ -1371,7 +1371,7 @@ (with-slots (array) pane (setf array (make-array (list nrows ncols) :initial-element nil)) - (loop for row in contents + (loop for row in contents for i from 0 do (loop for cell in row for j from 0 do @@ -1542,39 +1542,43 @@ (defmethod compose-space ((grid grid-pane) &key width height) (declare (ignore width height)) (mapc #'compose-space (sheet-children grid)) - (loop with nb-children-pl = (table-pane-number grid) - with nb-children-pc = (/ (length (sheet-children grid)) nb-children-pl) - for child in (sheet-children grid) - and width = 0 then (max width (sr-width child)) - and height = 0 then (max height (sr-height child)) - and max-width = 5000000 then (min max-width (sr-min-width child)) - and max-height = 5000000 then (min max-height (sr-max-height child)) - and min-width = 0 then (max min-width (sr-min-width child)) - and min-height = 0 then (max min-height (sr-min-height child)) - finally (return - (make-space-requirement - :width (* width nb-children-pl) - :height (* height nb-children-pc) - :max-width (* width nb-children-pl) - :max-height (* max-height nb-children-pc) - :min-width (* min-width nb-children-pl) - :min-height (* min-height nb-children-pc))))) + (with-slots (array) grid + (loop with nb-children-pl = (array-dimension array 1) ;(table-pane-number grid) + with nb-children-pc = (array-dimension array 0) ;(/ (length (sheet-children grid)) nb-children-pl) + for child in (sheet-children grid) + and width = 0 then (max width (sr-width child)) + and height = 0 then (max height (sr-height child)) + and max-width = 5000000 then (min max-width (sr-min-width child)) + and max-height = 5000000 then (min max-height (sr-max-height child)) + and min-width = 0 then (max min-width (sr-min-width child)) + and min-height = 0 then (max min-height (sr-min-height child)) + finally (return + (make-space-requirement + :width (* width nb-children-pl) + :height (* height nb-children-pc) + :max-width (* width nb-children-pl) + :max-height (* max-height nb-children-pc) + :min-width (* min-width nb-children-pl) + :min-height (* min-height nb-children-pc))))))

(defmethod allocate-space ((grid grid-pane) width height) - (loop with nb-kids-p-l = (table-pane-number grid) - with nb-kids-p-c = (/ (length (sheet-children grid)) nb-kids-p-l) - for children in (format-children grid) - for c from nb-kids-p-c downto 1 - for tmp-height = height then (decf tmp-height new-height) - for new-height = (/ tmp-height c) - for y = 0 then (+ y new-height) - do (loop for child in children - for l from nb-kids-p-l downto 1 - for tmp-width = width then (decf tmp-width new-width) - for new-width = (/ tmp-width l) - for x = 0 then (+ x new-width) - do (move-sheet child x y) - (allocate-space child (round new-width) (round new-height))))) + (with-slots (array) grid + (loop with nb-kids-p-l = (array-dimension array 1) ;(table-pane-number grid) + with nb-kids-p-c = (array-dimension array 0) ;(/ (length (sheet-children grid)) nb-kids-p-l) + for c from nb-kids-p-c downto 1 + for row-index from 0 by 1 + for tmp-height = height then (decf tmp-height new-height) + for new-height = (/ tmp-height c) + for y = 0 then (+ y new-height) + do (loop + for col-index from 0 by 1 + for l from nb-kids-p-l downto 1 + for child = (aref array row-index col-index) + for tmp-width = width then (decf tmp-width new-width) + for new-width = (/ tmp-width l) + for x = 0 then (+ x new-width) + do (move-sheet child x y) + (allocate-space child (round new-width) (round new-height))))))

;;; SPACING PANE

@@ -2557,7 +2561,7 @@ (eq (frame-state frame) :shrunk)) (enable-frame frame)) ;; Start a new thread to run the event loop, if necessary. - #+CLIM-MP + #+clim-mp (unless input-buffer (clim-sys:make-process (lambda () (let ((*application-frame* frame)) (standalone-event-loop)))))