Author: junrue Date: Sun Nov 5 16:06:36 2006 New Revision: 390
Modified: trunk/config.lisp trunk/src/uitoolkit/system/system-utils.lisp trunk/src/uitoolkit/widgets/event.lisp trunk/tests.lisp Log: more fixes for loading the system; minor cleanup in message-loop function; added a couple debug functions
Modified: trunk/config.lisp ============================================================================== --- trunk/config.lisp (original) +++ trunk/config.lisp Sun Nov 5 16:06:36 2006 @@ -43,6 +43,7 @@ (defvar *closer-mop-dir* "closer-mop/") (defvar *lw-compat-dir* "lw-compat/") (defvar *gf-dir* "graphic-forms/") +(defvar *gf-tests-dir* "graphic-forms/src/tests/uitoolkit/") (defvar *binary-data-dir* "src/external-libraries/practicals-1.0.3/Chapter08/") (defvar *macro-utilities-dir* "src/external-libraries/practicals-1.0.3/Chapter24/") (defvar *textedit-dir* "src/demos/textedit/")
Modified: trunk/src/uitoolkit/system/system-utils.lisp ============================================================================== --- trunk/src/uitoolkit/system/system-utils.lisp (original) +++ trunk/src/uitoolkit/system/system-utils.lisp Sun Nov 5 16:06:36 2006 @@ -37,6 +37,14 @@ ;;; convenience functions ;;;
+(defun debug-format (str &rest args) + (apply #'format *trace-output* str args) + (finish-output)) + +(defun debug-print (thing) + (print thing *trace-output*) + (finish-output)) + (defun recreate-array (array) (make-array (array-dimensions array) :element-type (array-element-type array)
Modified: trunk/src/uitoolkit/widgets/event.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event.lisp (original) +++ trunk/src/uitoolkit/widgets/event.lisp Sun Nov 5 16:06:36 2006 @@ -71,13 +71,7 @@ (cffi:with-foreign-object (msg-ptr 'gfs::msg) (loop (let ((gm (gfs::get-message msg-ptr (cffi:null-pointer) 0 0))) - (cffi:with-foreign-slots ((gfs::hwnd - gfs::message - gfs::wparam - gfs::lparam - gfs::time - gfs::pnt) - msg-ptr gfs::msg) + (cffi:with-foreign-slots ((gfs::message gfs::wparam) msg-ptr gfs::msg) (when (funcall msg-filter gm msg-ptr) (return-from message-loop gfs::wparam)))))))
Modified: trunk/tests.lisp ============================================================================== --- trunk/tests.lisp (original) +++ trunk/tests.lisp Sun Nov 5 16:06:36 2006 @@ -34,14 +34,14 @@ (in-package #:graphic-forms-system)
(defun load-tests () - (let ((tests-dir (concatenate 'string gfsys::*gf-dir* "src/tests/uitoolkit/"))) - (setf *default-pathname-defaults* (parse-namestring tests-dir)) - (setf *textedit-dir* (concatenate 'string gfsys::*gf-dir* gfsys::*textedit-dir*)) - (setf *unblocked-dir* (concatenate 'string gfsys::*gf-dir* gfsys::*unblocked-dir*)) + (setf *gf-tests-dir* (concatenate 'string gfsys::*gf-dir* "src/tests/uitoolkit/")) + (setf *textedit-dir* (concatenate 'string gfsys::*gf-dir* "src/demos/textedit/")) + (setf *unblocked-dir* (concatenate 'string gfsys::*gf-dir* "src/demos/unblocked/")) + (setf *default-pathname-defaults* (parse-namestring *gf-tests-dir*)) (asdf:operate 'asdf:load-op :graphic-forms-tests) (loop for file in '("test-utils.lisp" "mock-objects" "color-unit-tests" "graphics-context-unit-tests" "image-unit-tests" "icon-bundle-unit-tests" "layout-unit-tests" "flow-layout-unit-tests" "widget-unit-tests" "item-manager-unit-tests" "misc-unit-tests") - do (load (merge-pathnames file tests-dir))))) + do (load (merge-pathnames file *gf-tests-dir*))))