[graphic-forms-cvs] r2 - in trunk: . src src/tests/uitoolkit src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Tue Feb 7 17:42:36 UTC 2006
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))
More information about the Graphic-forms-cvs
mailing list