[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