[graphic-forms-cvs] r35 - in trunk: . src/intrinsics/datastructs src/tests/uitoolkit src/uitoolkit/widgets

junrue at common-lisp.net junrue at common-lisp.net
Mon Mar 13 00:19:37 UTC 2006


Author: junrue
Date: Sun Mar 12 19:19:36 2006
New Revision: 35

Added:
   trunk/src/intrinsics/datastructs/datastruct.lisp
   trunk/src/tests/uitoolkit/layout-unit-tests.lisp
   trunk/src/tests/uitoolkit/mock-objects.lisp
   trunk/src/uitoolkit/widgets/flow-layout.lisp
   trunk/src/uitoolkit/widgets/layout.lisp
      - copied, changed from r32, trunk/src/uitoolkit/widgets/layouts.lisp
Removed:
   trunk/src/uitoolkit/widgets/layouts.lisp
Modified:
   trunk/graphic-forms-tests.asd
   trunk/graphic-forms-uitoolkit.asd
   trunk/src/tests/uitoolkit/layout-tester.lisp
   trunk/tests.lisp
Log:
flow layout unit-test code; bug fixes for vertical flow layout style

Modified: trunk/graphic-forms-tests.asd
==============================================================================
--- trunk/graphic-forms-tests.asd	(original)
+++ trunk/graphic-forms-tests.asd	Sun Mar 12 19:19:36 2006
@@ -49,6 +49,8 @@
               :components
                 ((:module "uitoolkit"
                   :components
-                    ((:file "hello-world")
+                    ((:file "mock-objects")
+                     (:file "layout-unit-tests")
+                     (:file "hello-world")
                      (:file "event-tester")
                      (:file "layout-tester")))))))))

Modified: trunk/graphic-forms-uitoolkit.asd
==============================================================================
--- trunk/graphic-forms-uitoolkit.asd	(original)
+++ trunk/graphic-forms-uitoolkit.asd	Sun Mar 12 19:19:36 2006
@@ -51,7 +51,8 @@
               :components
                 ((:module "datastructs"
                     :components
-                      ((:file "datastruct-classes")))
+                      ((:file "datastruct-classes")
+                       (:file "datastruct")))
                  (:module "system"
                     :components
                       ((:file "native-classes")
@@ -106,4 +107,5 @@
                        (:file "menu-language")
                        (:file "event")
                        (:file "window")
-                       (:file "layouts")))))))))
+                       (:file "layout")
+                       (:file "flow-layout")))))))))

Added: trunk/src/intrinsics/datastructs/datastruct.lisp
==============================================================================
--- (empty file)
+++ trunk/src/intrinsics/datastructs/datastruct.lisp	Sun Mar 12 19:19:36 2006
@@ -0,0 +1,38 @@
+;;;;
+;;;; datastruct.lisp
+;;;;
+;;;; Copyright (C) 2006, Jack D. Unrue
+;;;; All rights reserved.
+;;;;
+;;;; Redistribution and use in source and binary forms, with or without
+;;;; modification, are permitted provided that the following conditions
+;;;; are met:
+;;;; 
+;;;;     1. Redistributions of source code must retain the above copyright
+;;;;        notice, this list of conditions and the following disclaimer.
+;;;; 
+;;;;     2. Redistributions in binary form must reproduce the above copyright
+;;;;        notice, this list of conditions and the following disclaimer in the
+;;;;        documentation and/or other materials provided with the distribution.
+;;;; 
+;;;;     3. Neither the names of the authors nor the names of its contributors
+;;;;        may be used to endorse or promote products derived from this software
+;;;;        without specific prior written permission.
+;;;; 
+;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS "AS IS" AND ANY
+;;;; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DIS-
+;;;; CLAIMED.  IN NO EVENT SHALL THE AUTHORS AND CONTRIBUTORS BE LIABLE FOR ANY
+;;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+;;;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+;;;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+;;;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;;
+
+(in-package :graphic-forms.intrinsics)
+
+(defmethod print-object ((obj rectangle) stream)
+  (print-unreadable-object (obj stream :type t)
+    (format stream "location: ~a size: ~a" (location obj) (size obj))))

Modified: trunk/src/tests/uitoolkit/layout-tester.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/layout-tester.lisp	(original)
+++ trunk/src/tests/uitoolkit/layout-tester.lisp	Sun Mar 12 19:19:36 2006
@@ -157,6 +157,18 @@
       (gfw:show victim (not (gfw:visible-p victim)))
       (gfw:layout *layout-tester-win*))))
 
+(defun set-flow-horizontal (disp item time rect)
+  (declare (ignorable disp item time rect))
+  (let ((layout (gfw:layout-manager *layout-tester-win*)))
+    (setf (gfw:style-of layout) (list :horizontal))
+    (gfw:layout *layout-tester-win*)))
+
+(defun set-flow-vertical (disp item time rect)
+  (declare (ignorable disp item time rect))
+  (let ((layout (gfw:layout-manager *layout-tester-win*)))
+    (setf (gfw:style-of layout) (list :vertical))
+    (gfw:layout *layout-tester-win*)))
+
 (defun flow-mod-callback (disp menu time)
   (declare (ignore disp time))
   (gfw:clear-all menu)
@@ -173,8 +185,10 @@
                                          (:item "Bottom"
                                           :submenu ((:item "Decrease")
                                                     (:item "Increase"))))))
-        (orient-menu (gfw:defmenusystem ((:item "Horizontal")
-                                         (:item "Vertical"))))
+        (orient-menu (gfw:defmenusystem ((:item "Horizontal"
+                                          :callback #'set-flow-horizontal)
+                                         (:item "Vertical"
+                                          :callback #'set-flow-vertical))))
         (spacing-menu (gfw:defmenusystem ((:item "Decrease")
                                           (:item "Increase")))))
     (gfw:append-submenu menu "Margin" margin-menu)

Added: trunk/src/tests/uitoolkit/layout-unit-tests.lisp
==============================================================================
--- (empty file)
+++ trunk/src/tests/uitoolkit/layout-unit-tests.lisp	Sun Mar 12 19:19:36 2006
@@ -0,0 +1,81 @@
+;;;;
+;;;; layout-unit-tests.lisp
+;;;;
+;;;; Copyright (C) 2006, Jack D. Unrue
+;;;; All rights reserved.
+;;;;
+;;;; Redistribution and use in source and binary forms, with or without
+;;;; modification, are permitted provided that the following conditions
+;;;; are met:
+;;;; 
+;;;;     1. Redistributions of source code must retain the above copyright
+;;;;        notice, this list of conditions and the following disclaimer.
+;;;; 
+;;;;     2. Redistributions in binary form must reproduce the above copyright
+;;;;        notice, this list of conditions and the following disclaimer in the
+;;;;        documentation and/or other materials provided with the distribution.
+;;;; 
+;;;;     3. Neither the names of the authors nor the names of its contributors
+;;;;        may be used to endorse or promote products derived from this software
+;;;;        without specific prior written permission.
+;;;; 
+;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS "AS IS" AND ANY
+;;;; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DIS-
+;;;; CLAIMED.  IN NO EVENT SHALL THE AUTHORS AND CONTRIBUTORS BE LIABLE FOR ANY
+;;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+;;;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+;;;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+;;;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;;
+
+(in-package :graphic-forms.uitoolkit.tests)
+
+(defvar *minsize1* (gfi:make-size :width 20 :height 10))
+(defvar *flow-layout-kids1* (list (make-instance 'mock-widget :min-size *minsize1*)
+                                  (make-instance 'mock-widget :min-size *minsize1*)
+                                  (make-instance 'mock-widget :min-size *minsize1*)))
+
+(defun validate-layout-points (actual-entries expected-pnts)
+  (mapc #'(lambda (pnt entry)
+            (let ((pnt2 (gfi:location (cdr entry))))
+              (assert-true (and (= (gfi:point-x pnt) (gfi:point-x pnt2))
+                                (= (gfi:point-y pnt) (gfi:point-y pnt2))))))
+        expected-pnts
+        actual-entries))
+
+(define-test flow-layout-test1
+  ;; orient: horizontal
+  ;; wrap: disabled
+  ;; fill: disabled
+  ;; container: visible
+  ;; kids: uniform
+  ;;
+  (let* ((size (gfw::flow-container-size '(:horizontal) t *flow-layout-kids1* -1 -1))
+         (actual (gfw::flow-container-layout '(:horizontal) t *flow-layout-kids1* -1 -1))
+         (expected-pnts nil))
+      (push (gfi:make-point :x 40 :y 0) expected-pnts)
+      (push (gfi:make-point :x 20 :y 0) expected-pnts)
+      (push (gfi:make-point :x 0 :y 0) expected-pnts)
+      (assert-equal 60 (gfi:size-width size))
+      (assert-equal 10 (gfi:size-height size))
+      (validate-layout-points actual expected-pnts)))
+
+(define-test flow-layout-test2
+  ;; orient: vertical
+  ;; wrap: disabled
+  ;; fill: disabled
+  ;; container: visible
+  ;; kids: uniform
+  ;;
+  (let* ((size (gfw::flow-container-size '(:vertical) t *flow-layout-kids1* -1 -1))
+         (actual (gfw::flow-container-layout '(:vertical) t *flow-layout-kids1* -1 -1))
+         (expected-pnts nil))
+      (push (gfi:make-point :x 0 :y 20) expected-pnts)
+      (push (gfi:make-point :x 0 :y 10) expected-pnts)
+      (push (gfi:make-point :x 0 :y 0) expected-pnts)
+      (assert-equal 20 (gfi:size-width size))
+      (assert-equal 30 (gfi:size-height size))
+      (validate-layout-points actual expected-pnts)))

Added: trunk/src/tests/uitoolkit/mock-objects.lisp
==============================================================================
--- (empty file)
+++ trunk/src/tests/uitoolkit/mock-objects.lisp	Sun Mar 12 19:19:36 2006
@@ -0,0 +1,79 @@
+;;;;
+;;;; mock-objects.lisp
+;;;;
+;;;; Copyright (C) 2006, Jack D. Unrue
+;;;; All rights reserved.
+;;;;
+;;;; Redistribution and use in source and binary forms, with or without
+;;;; modification, are permitted provided that the following conditions
+;;;; are met:
+;;;; 
+;;;;     1. Redistributions of source code must retain the above copyright
+;;;;        notice, this list of conditions and the following disclaimer.
+;;;; 
+;;;;     2. Redistributions in binary form must reproduce the above copyright
+;;;;        notice, this list of conditions and the following disclaimer in the
+;;;;        documentation and/or other materials provided with the distribution.
+;;;; 
+;;;;     3. Neither the names of the authors nor the names of its contributors
+;;;;        may be used to endorse or promote products derived from this software
+;;;;        without specific prior written permission.
+;;;; 
+;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS "AS IS" AND ANY
+;;;; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DIS-
+;;;; CLAIMED.  IN NO EVENT SHALL THE AUTHORS AND CONTRIBUTORS BE LIABLE FOR ANY
+;;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+;;;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+;;;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+;;;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;;
+
+(in-package :graphic-forms.uitoolkit.tests)
+
+(defconstant +max-widget-size+ 5000)
+
+;;;
+;;; stand-ins for widgets that would be children of windows, to be organized
+;;; via layout managers
+;;;
+
+(defclass mock-widget (gfw:widget)
+  ((visibility
+    :accessor visibility-of
+    :initform t)
+   (actual-size
+    :accessor actual-size-of
+    :initarg :actual-size
+    :initform (gfi:make-size))
+   (max-size
+    :accessor max-size-of
+    :initarg :max-size
+    :initform (gfi:make-size :width +max-widget-size+ :height +max-widget-size+))
+   (min-size
+    :accessor min-size-of
+    :initarg :min-size
+    :initform (gfi:make-size))))
+
+(defmethod initialize-instance :after ((widget mock-widget) &key &allow-other-keys)
+  (setf (slot-value widget 'gfi:handle) (cffi:make-pointer #xFFFFFFFF)))
+
+(defmethod gfw:minimum-size ((widget mock-widget))
+  (gfi:make-size :width (gfi:size-width (min-size-of widget))
+                 :height (gfi:size-height (min-size-of widget))))
+
+(defmethod gfw:preferred-size ((widget mock-widget) width-hint height-hint)
+  (let ((size (gfi:make-size))
+        (min-size (min-size-of widget)))
+    (if (< width-hint 0)
+      (setf (gfi:size-width size) (gfi:size-width min-size))
+      (setf (gfi:size-width size) width-hint))
+    (if (< height-hint 0)
+      (setf (gfi:size-height size) (gfi:size-height min-size))
+      (setf (gfi:size-height size) height-hint))
+    size))
+
+(defmethod gfw:visible-p ((widget mock-widget))
+  (visibility-of widget))

Added: trunk/src/uitoolkit/widgets/flow-layout.lisp
==============================================================================
--- (empty file)
+++ trunk/src/uitoolkit/widgets/flow-layout.lisp	Sun Mar 12 19:19:36 2006
@@ -0,0 +1,109 @@
+;;;;
+;;;; flow-layout.lisp
+;;;;
+;;;; Copyright (C) 2006, Jack D. Unrue
+;;;; All rights reserved.
+;;;;
+;;;; Redistribution and use in source and binary forms, with or without
+;;;; modification, are permitted provided that the following conditions
+;;;; are met:
+;;;; 
+;;;;     1. Redistributions of source code must retain the above copyright
+;;;;        notice, this list of conditions and the following disclaimer.
+;;;; 
+;;;;     2. Redistributions in binary form must reproduce the above copyright
+;;;;        notice, this list of conditions and the following disclaimer in the
+;;;;        documentation and/or other materials provided with the distribution.
+;;;; 
+;;;;     3. Neither the names of the authors nor the names of its contributors
+;;;;        may be used to endorse or promote products derived from this software
+;;;;        without specific prior written permission.
+;;;; 
+;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS "AS IS" AND ANY
+;;;; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DIS-
+;;;; CLAIMED.  IN NO EVENT SHALL THE AUTHORS AND CONTRIBUTORS BE LIABLE FOR ANY
+;;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+;;;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+;;;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+;;;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;;
+
+(in-package :graphic-forms.uitoolkit.widgets)
+
+;;;
+;;; helper functions
+;;;
+
+(defun flow-container-size (style win-visible kids width-hint height-hint)
+  (let ((max -1)
+        (total 0)
+        (vert-orient (find :vertical style)))
+    (loop for kid in kids
+          do (let ((size (preferred-size kid
+                                         (if vert-orient width-hint -1)
+                                         (if vert-orient -1 height-hint))))
+               (when (or (visible-p kid) (not win-visible))
+                 (if vert-orient
+                   (progn
+                     (incf total (gfi:size-height size))
+                     (if (< max (gfi:size-width size))
+                       (setf max (gfi:size-width size))))
+                   (progn
+                     (incf total (gfi:size-width size))
+                     (if (< max (gfi:size-height size))
+                       (setf max (gfi:size-height size))))))))
+    (if vert-orient
+      (gfi:make-size :width max :height total)
+      (gfi:make-size :width total :height max))))
+
+(defun flow-container-layout (style win-visible kids width-hint height-hint)
+  (let ((entries nil)
+        (last-coord 0)
+        (last-dim 0)
+        (vert-orient (find :vertical style)))
+    (loop for kid in kids
+          do (let ((size (preferred-size kid
+                                         (if vert-orient width-hint -1)
+                                         (if vert-orient -1 height-hint)))
+                   (pnt (gfi:make-point)))
+               (when (or (visible-p kid) (not win-visible))
+                 (if vert-orient
+                   (progn
+                     (setf (gfi:point-y pnt) (+ last-coord last-dim))
+                     (if (>= width-hint 0)
+                       (setf (gfi:size-width size) width-hint))
+                     (setf last-coord (gfi:point-y pnt))
+                     (setf last-dim (gfi:size-height size)))
+                   (progn
+                     (setf (gfi:point-x pnt) (+ last-coord last-dim))
+                     (if (>= height-hint 0)
+                       (setf (gfi:size-height size) height-hint))
+                     (setf last-coord (gfi:point-x pnt))
+                     (setf last-dim (gfi:size-width size))))
+                 (push (cons kid (make-instance 'gfi:rectangle
+                                                :size size
+                                                :location pnt))
+                       entries))))
+  (reverse entries)))
+
+;;;
+;;; methods
+;;;
+
+(defmethod compute-size ((layout flow-layout) (win window) width-hint height-hint)
+  (with-children (win kids)
+    (flow-container-size (style-of layout) (visible-p win) kids width-hint height-hint)))
+
+(defmethod compute-layout ((layout flow-layout) (win window) width-hint height-hint)
+  (with-children (win kids)
+    (flow-container-layout (style-of layout) (visible-p win) kids width-hint height-hint)))
+
+(defmethod initialize-instance :after ((layout flow-layout) &key style)
+  (unless (listp style)
+    (setf style (list style)))
+  (if (and (null (find :horizontal style)) (null (find :vertical style)))
+    (setf (style-of layout) '(:horizontal))
+    (setf (style-of layout) style)))

Copied: trunk/src/uitoolkit/widgets/layout.lisp (from r32, trunk/src/uitoolkit/widgets/layouts.lisp)
==============================================================================
--- trunk/src/uitoolkit/widgets/layouts.lisp	(original)
+++ trunk/src/uitoolkit/widgets/layout.lisp	Sun Mar 12 19:19:36 2006
@@ -1,5 +1,5 @@
 ;;;;
-;;;; layouts.lisp
+;;;; layout.lisp
 ;;;;
 ;;;; Copyright (C) 2006, Jack D. Unrue
 ;;;; All rights reserved.
@@ -45,6 +45,7 @@
         (hdwp nil))
     (when (and (layout-p win) layout)
       (setf kids (compute-layout layout win width-hint height-hint))
+(loop for x in kids do (format t "~a~%" (cdr x)))
       (setf hdwp (gfs::begin-defer-window-pos (length kids)))
       (loop for k in kids
             do (let* ((rect (cdr k))
@@ -68,65 +69,3 @@
                                                      +window-pos-flags+)))))
       (unless (gfi:null-handle-p hdwp)
         (gfs::end-defer-window-pos hdwp)))))
-
-;;;
-;;; flow-layout methods
-;;;
-
-(defmethod compute-size ((layout flow-layout) (win window) width-hint height-hint)
-  (let ((max -1)
-        (total 0)
-        (vert-orient (find :vertical (style-of layout))))
-    (with-children (win kids)
-      (loop for k in kids
-            do (let ((kid-size (preferred-size k
-                                               (if vert-orient width-hint -1)
-                                               (if vert-orient -1 height-hint))))
-                 (when (or (visible-p k) (not (visible-p win)))
-                   (if (not vert-orient)
-                     (progn
-                       (incf total (gfi:size-width kid-size))
-                       (if (< max (gfi:size-height kid-size))
-                         (setf max (gfi:size-height kid-size))))
-                     (progn
-                       (incf total (gfi:size-height kid-size))
-                       (if (< max (gfi:size-width kid-size))
-                         (setf max (gfi:size-width kid-size)))))))))
-    (if vert-orient
-      (gfi:make-size :width max :height total)
-      (gfi:make-size :width total :height max))))
-
-(defmethod compute-layout ((layout flow-layout) (win window) width-hint height-hint)
-  (let ((entries nil)
-        (last-coord 0)
-        (last-dim 0)
-        (vert-orient (find :vertical (style-of layout))))
-    (with-children (win kids)
-      (loop for k in kids
-            do (let ((kid-size (preferred-size k
-                                               (if vert-orient width-hint -1)
-                                               (if vert-orient -1 height-hint)))
-                     (pnt (gfi:make-point)))
-                 (when (or (visible-p k) (not (visible-p win)))
-                   (if (not vert-orient)
-                     (progn
-                       (setf (gfi:point-x pnt) (+ last-coord last-dim))
-                       (if (>= height-hint 0)
-                         (setf (gfi:size-height kid-size) height-hint))
-                       (setf last-coord (gfi:point-x pnt))
-                       (setf last-dim (gfi:size-width kid-size)))
-                     (progn
-                       (setf (gfi:point-y pnt) (+ last-coord last-dim))
-                       (if (>= width-hint 0)
-                         (setf (gfi:size-width kid-size) width-hint))
-                       (setf last-coord (gfi:point-y pnt))
-                       (setf last-dim (gfi:size-height kid-size))))
-                   (push (cons k (make-instance 'gfi:rectangle :size kid-size :location pnt)) entries)))))
-    (reverse entries)))
-
-(defmethod initialize-instance :after ((layout flow-layout) &key style)
-  (unless (listp style)
-    (setf style (list style)))
-  (if (and (null (find :horizontal style)) (null (find :vertical style)))
-    (setf (style-of layout) '(:horizontal))
-    (setf (style-of layout) style)))

Modified: trunk/tests.lisp
==============================================================================
--- trunk/tests.lisp	(original)
+++ trunk/tests.lisp	Sun Mar 12 19:19:36 2006
@@ -33,15 +33,15 @@
 
 (in-package #:graphic-forms-system)
 
-(defvar *lisp-unit-srcfile* (concatenate 'string *library-root* "lisp-unit.lisp"))
+(defvar *lisp-unit-file* (concatenate 'string *library-root* "lisp-unit"))
 
-(load (compile-file *lisp-unit-srcfile*))
+(load (compile-file *lisp-unit-file*))
 
 (defpackage #:graphic-forms.uitoolkit.tests
   (:nicknames #:gft)
   (:use :common-lisp :lisp-unit))
 
-(defun load-adhoc-tests ()
+(defun load-tests ()
   (if *external-build-dirs*
     (chdir *gf-build-dir*))
   (asdf:operate 'asdf:load-op :graphic-forms-tests))



More information about the Graphic-forms-cvs mailing list