[graphic-forms-cvs] r2 - in trunk: . src src/tests/uitoolkit src/uitoolkit/widgets

Author: junrue Date: Tue Feb 7 11:42:35 2006 New Revision: 2

Added: trunk/graphic-forms-tests.asd trunk/src/tests/uitoolkit/event-tester.lisp trunk/src/tests/uitoolkit/hello-world.lisp trunk/tests.lisp Modified: trunk/build.lisp trunk/src/packages.lisp trunk/src/uitoolkit/widgets/widget-utils.lisp trunk/src/uitoolkit/widgets/widget.lisp Log: upgraded to CFFI 0.9.0; started pulling in test code

Modified: trunk/build.lisp ============================================================================== --- trunk/build.lisp (original) +++ trunk/build.lisp Tue Feb 7 11:42:35 2006 @@ -1,10 +1,38 @@ ;;;; ;;;; build.lisp ;;;; -;;;; Copyright (c) 2006 by Jack D. Unrue +;;;; 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. ;;;;

(defpackage #:graphic-forms-system + (:nicknames #:gfs) (:use :common-lisp :asdf))

(in-package #:graphic-forms-system) @@ -16,7 +44,7 @@

(defvar *asdf-root* (concatenate 'string *library-root* "asdf-repo/"))

-(defvar *cffi-dir* (concatenate 'string *asdf-root* "cffi-060114/")) +(defvar *cffi-dir* (concatenate 'string *asdf-root* "cffi-0.9.0/")) (defvar *pcl-ch08-dir* (concatenate 'string *asdf-root* "practicals-1.0.3/Chapter08/")) (defvar *pcl-ch24-dir* (concatenate 'string *asdf-root* "practicals-1.0.3/Chapter24/")) (defvar *cldoc-dir* (concatenate 'string *asdf-root* "cldoc/")) @@ -25,7 +53,11 @@ (defvar *gf-build-dir* "c:/projects/public/build/graphic-forms/") (defvar *gf-doc-dir* (concatenate 'string *gf-build-dir* "docs/"))

-(defvar *asdf-dirs* (list *cffi-dir* *pcl-ch08-dir* *pcl-ch24-dir* *cldoc-dir* *gf-dir*)) +(defvar *asdf-dirs* (list *cffi-dir* + *pcl-ch08-dir* + *pcl-ch24-dir* + *cldoc-dir* + *gf-dir*))

(defvar *library-build-root* (concatenate 'string *library-root* "build/")) (defvar *cffi-build-dir* (concatenate 'string *library-build-root* "cffi/")) @@ -33,9 +65,11 @@ (defvar *pcl-ch24-build-dir* (concatenate 'string *library-build-root* "pcl-binary-data/")) (defvar *cldoc-build-dir* (concatenate 'string *library-build-root* "cldoc/"))

-(defvar *build-dirs* (list *cffi-build-dir* *pcl-ch08-build-dir* *pcl-ch24-build-dir* *cldoc-build-dir* *gf-build-dir*)) - -(defvar *lisp-unit-srcfile* (concatenate 'string *library-root* "lisp-unit.lisp")) +(defvar *build-dirs* (list *cffi-build-dir* + *pcl-ch08-build-dir* + *pcl-ch24-build-dir* + *cldoc-build-dir* + *gf-build-dir*))

#+lispworks (defmacro chdir (path) `(hcl:change-directory ,path)) @@ -43,7 +77,6 @@ `(ext:cd ,path))

(defun build () - (mapc #'(lambda (dir-str) (pushnew dir-str asdf:*central-registry* :test #'equal)) *asdf-dirs*) (when *external-build-dirs* (mapc #'(lambda (dir-str) (ensure-directories-exist (parse-namestring dir-str))) *build-dirs*)) @@ -65,11 +98,6 @@ (chdir *gf-build-dir*)) (asdf:operate 'asdf:load-op :graphic-forms-uitoolkit))

-;;; FIXME: define test package (and must :use #:lisp-unit) -;;; -(defun run-tests () - (load (compile-file *lisp-unit-srcfile*))) - ;;; FIXME: reference to :cldoc below can't be satisfied yet when ;;; this file is loaded #|

Added: trunk/graphic-forms-tests.asd ============================================================================== --- (empty file) +++ trunk/graphic-forms-tests.asd Tue Feb 7 11:42:35 2006 @@ -0,0 +1,53 @@ +;;;; +;;;; graphic-forms-tests.asd +;;;; +;;;; 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-system) + +(print "Graphic-Forms UI Toolkit Tests") +(print "Copyright (c) 2006 by Jack D. Unrue") +(print " ") + +(defsystem graphic-forms-tests + :description "Graphic-Forms UI Toolkit Tests" + :version "0.2.0" + :author "Jack D. Unrue" + :licence "BSD" + :components + ((:module "src" + :components + ((:module "tests" + :components + ((:module "uitoolkit" + :components + ((:file "hello-world") + (:file "event-tester")))))))))

Modified: trunk/src/packages.lisp ============================================================================== --- trunk/src/packages.lisp (original) +++ trunk/src/packages.lisp Tue Feb 7 11:42:35 2006 @@ -451,6 +451,7 @@ #:show-selection #:shutdown #:size + #:startup #:step-increment #:style #:text

Added: trunk/src/tests/uitoolkit/event-tester.lisp ============================================================================== --- (empty file) +++ trunk/src/tests/uitoolkit/event-tester.lisp Tue Feb 7 11:42:35 2006 @@ -0,0 +1,195 @@ +;;;; +;;;; event-tester.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) + +(defparameter *event-tester-window* nil) +(defparameter *text* "Hello!") +(defvar *event-counter* 0) +(defvar *mouse-down-flag* nil) + +(defun exit-event-tester () + (let ((w *event-tester-window*)) + (setf *event-tester-window* nil) + (gfis:dispose w)) + (gfuw:shutdown 0)) + +(defclass event-tester-window-events (gfuw:event-dispatcher) ()) + +(defmethod gfuw:event-paint ((d event-tester-window-events) time (gc gfug:graphics-context) rect) + (declare (ignore time) (ignore rect)) + (setf (gfug:background-color gc) gfug:+color-white+) + (setf (gfug:foreground-color gc) gfug:+color-blue+) + (gfug:draw-text gc *text* (gfid:make-point))) + +(defmethod gfuw:event-close ((d event-tester-window-events) time) + (declare (ignore time)) + (exit-event-tester)) + +(defun text-for-modifiers () + (format nil + "~:[SHIFT~;~] ~:[CTRL~;~] ~:[ALT~;~] ~:[L-WIN~;~] ~:[R-WIN~;~] ~:[ESC~;~] ~:[CAPSLOCK~;~] ~:[NUMLOCK~;~] ~:[SCROLLOCK~;~]" + (not (gfuw:key-down-p gfuw:+vk-shift+)) + (not (gfuw:key-down-p gfuw:+vk-control+)) + (not (gfuw:key-down-p gfuw:+vk-alt+)) + (not (gfuw:key-down-p gfuw:+vk-left-win+)) + (not (gfuw:key-down-p gfuw:+vk-right-win+)) + (not (gfuw:key-toggled-p gfuw:+vk-escape+)) + (not (gfuw:key-toggled-p gfuw:+vk-caps-lock+)) + (not (gfuw:key-toggled-p gfuw:+vk-num-lock+)) + (not (gfuw:key-toggled-p gfuw:+vk-scroll-lock+)))) + +(defun text-for-mouse (action time button pnt) + (format nil + "~a mouse action: ~s button: ~a point: (~d,~d) time: 0x~x ~s" + (incf *event-counter*) + action + button + (gfid:point-x pnt) + (gfid:point-y pnt) + time + (text-for-modifiers))) + +(defun text-for-key (action time key-code char) + (format nil + "~a key action: ~s char: ~s code: 0x~x time: 0x~x ~s" + (incf *event-counter*) + action + char + key-code + time + (text-for-modifiers))) + +(defun text-for-menu (text time) + (format nil + "~a menu: ~s time: 0x~x ~s" + (incf *event-counter*) + text + time + (text-for-modifiers))) + +(defun text-for-size (type time size) + (format nil + "~a resize action: ~s size: (~d,~d) time: 0x~x ~s" + (incf *event-counter*) + (symbol-name type) + (gfid:size-width size) + (gfid:size-height size) + time + (text-for-modifiers))) + +(defun text-for-move (time pnt) + (format nil + "~a move point: (~d,~d) time: 0x~x ~s" + (incf *event-counter*) + (gfid:point-x pnt) + (gfid:point-y pnt) + time + (text-for-modifiers))) + +(defmethod gfuw:event-key-down ((d event-tester-window-events) time key-code char) + (setf *text* (text-for-key "down" time key-code char)) + (gfuw:redraw *event-tester-window*)) + +(defmethod gfuw:event-key-up ((d event-tester-window-events) time key-code char) + (setf *text* (text-for-key "up" time key-code char)) + (gfuw:redraw *event-tester-window*)) + +(defmethod gfuw:event-mouse-double ((d event-tester-window-events) time pnt button) + (setf *text* (text-for-mouse "double" time button pnt)) + (gfuw:redraw *event-tester-window*)) + +(defmethod gfuw:event-mouse-down ((d event-tester-window-events) time pnt button) + (setf *text* (text-for-mouse "down" time button pnt)) + (setf *mouse-down-flag* t) + (gfuw:redraw *event-tester-window*)) + +(defmethod gfuw:event-mouse-move ((d event-tester-window-events) time pnt button) + (when *mouse-down-flag* + (setf *text* (text-for-mouse "move" time button pnt)) + (gfuw:redraw *event-tester-window*))) + +(defmethod gfuw:event-mouse-up ((d event-tester-window-events) time pnt button) + (setf *text* (text-for-mouse "up" time button pnt)) + (setf *mouse-down-flag* nil) + (gfuw:redraw *event-tester-window*)) + +(defmethod gfuw:event-move ((d event-tester-window-events) time pnt) + (setf *text* (text-for-move time pnt)) + (gfuw:redraw *event-tester-window*) + 0) + +(defmethod gfuw:event-resize ((d event-tester-window-events) time size type) + (setf *text* (text-for-size type time size)) + (gfuw:redraw *event-tester-window*) + 0) + +(defclass event-tester-exit-dispatcher (gfuw:event-dispatcher) ()) + +(defmethod gfuw:event-select ((d event-tester-exit-dispatcher) time item rect) + (declare (ignorable time item rect)) + (exit-event-tester)) + +(defclass echo-menu-dispatcher (gfuw:event-dispatcher) ()) + +(defmethod gfuw:event-select ((d echo-menu-dispatcher) time item rect) + (declare (ignore rect)) + (setf *text* (text-for-menu (gfuw:text item) time)) + (gfuw:redraw *event-tester-window*)) + +(defun run-event-tester-internal () + (setf *text* "Hello!") + (setf *event-counter* 0) + (let ((echo-md (make-instance 'echo-menu-dispatcher)) + (exit-md (make-instance 'event-tester-exit-dispatcher)) + (menubar nil)) + (setf *event-tester-window* (make-instance 'gfuw:window :dispatcher (make-instance 'event-tester-window-events))) + (gfuw:realize *event-tester-window* nil :style-workspace) + (setf menubar (gfuw:defmenusystem `(((:menu "&File") + (:menuitem "&Open..." :dispatcher ,echo-md) + (:menuitem "&Save..." :disabled :dispatcher ,echo-md) + (:menuitem :separator) + (:menuitem "E&xit" :dispatcher ,exit-md)) + ((:menu "&Options") + (:menuitem "&Enabled" :checked :dispatcher ,echo-md) + (:menuitem :submenu ((:menu "&Tools" :dispatcher ,echo-md) + (:menuitem "&Fonts" :dispatcher ,echo-md :disabled) + (:menuitem "&Colors" :dispatcher ,echo-md)))) + ((:menu "&Help") + (:menuitem "&About" :dispatcher ,echo-md :image "foobar.bmp"))))) + (setf (gfuw:menu-bar *event-tester-window*) menubar) + (gfuw:show *event-tester-window*) + (gfuw:run-default-message-loop))) + +(defun run-event-tester () + (gfuw:startup "Event Tester" #'run-event-tester-internal))

Added: trunk/src/tests/uitoolkit/hello-world.lisp ============================================================================== --- (empty file) +++ trunk/src/tests/uitoolkit/hello-world.lisp Tue Feb 7 11:42:35 2006 @@ -0,0 +1,75 @@ +;;;; +;;;; hello-world.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) + +(defparameter *hellowin* nil) + +(defun exit-hello-world () + (let ((w *hellowin*)) + (setf *hellowin* nil) + (gfis:dispose w)) + (gfuw:shutdown 0)) + +(defclass hellowin-events (gfuw:event-dispatcher) ()) + +(defmethod gfuw:event-close ((d hellowin-events) time) + (declare (ignore time)) + (format t "hellowin-events event-close~%") + (exit-hello-world)) + +(defmethod gfuw:event-paint ((d hellowin-events) time (gc gfug:graphics-context) rect) + (declare (ignore time) (ignore rect)) + (setf (gfug:background-color gc) gfug:+color-red+) + (setf (gfug:foreground-color gc) gfug:+color-green+) + (gfug:draw-text gc "Hello World!" (gfid:make-point))) + +(defclass hellowin-exit-dispatcher (gfuw:event-dispatcher) ()) + +(defmethod gfuw:event-select ((d hellowin-exit-dispatcher) time item rect) + (declare (ignorable time item rect)) + (exit-hello-world)) + +(defun run-hello-world-internal () + (let ((menubar nil) + (md (make-instance 'hellowin-exit-dispatcher))) + (setf *hellowin* (make-instance 'gfuw:window :dispatcher (make-instance 'hellowin-events))) + (gfuw:realize *hellowin* nil :style-workspace) + (setf menubar (gfuw:defmenusystem `(((:menu "&File") + (:menuitem "E&xit" :dispatcher ,md))))) + (setf (gfuw:menu-bar *hellowin*) menubar) + (gfuw:show *hellowin*) + (gfuw:run-default-message-loop))) + +(defun run-hello-world () + (gfuw:startup "Hello World" #'run-hello-world-internal))

Modified: trunk/src/uitoolkit/widgets/widget-utils.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-utils.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-utils.lisp Tue Feb 7 11:42:35 2006 @@ -1,5 +1,5 @@ ;;;; -;;;; utils.lisp +;;;; widget-utils.lisp ;;;; ;;;; Copyright (C) 2006, Jack D. Unrue ;;;; All rights reserved. @@ -31,7 +31,19 @@ ;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ;;;;

-(in-package :graphic-forms.uitoolkit.widgets) +(in-package #:graphic-forms.uitoolkit.widgets) + +#+clisp (defun startup (thread-name start-fn) + (declare (ignore thread-name)) + (funcall start-fn)) + +#+lispworks (defun startup (thread-name start-fn) + (when (null (mp:list-all-processes)) + (mp:initialize-multiprocessing)) + (mp:process-run-function thread-name nil start-fn)) + +(defun shutdown (exit-code) + (gfus::post-quit-message exit-code))

(defun create-window (class-name title parent-hwnd std-style ex-style) (cffi:with-foreign-string (cname-ptr class-name)

Modified: trunk/src/uitoolkit/widgets/widget.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget.lisp (original) +++ trunk/src/uitoolkit/widgets/widget.lisp Tue Feb 7 11:42:35 2006 @@ -145,10 +145,3 @@ (defun remove-widget (hwnd) (when (not *widget-in-progress*) (remhash (cffi:pointer-address hwnd) *widgets-by-hwnd*))) - -;;; -;;; miscellaneous -;;; - -(defun shutdown (exit-code) - (gfus::post-quit-message exit-code))

Added: trunk/tests.lisp ============================================================================== --- (empty file) +++ trunk/tests.lisp Tue Feb 7 11:42:35 2006 @@ -0,0 +1,47 @@ +;;;; +;;;; 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-system) + +(defvar *lisp-unit-srcfile* (concatenate 'string *library-root* "lisp-unit.lisp")) + +(load (compile-file *lisp-unit-srcfile*)) + +(defpackage #:graphic-forms.uitoolkit.tests + (:nicknames #:gft) + (:use :common-lisp :lisp-unit)) + +(defun load-adhoc-tests () + (if *external-build-dirs* + (chdir *gf-build-dir*)) + (asdf:operate 'asdf:load-op :graphic-forms-tests))