Author: junrue Date: Sun Feb 19 21:23:23 2006 New Revision: 13

Modified: trunk/src/tests/uitoolkit/layout-tester.lisp trunk/src/uitoolkit/widgets/event.lisp trunk/src/uitoolkit/widgets/window.lisp Log: fixed regression in with-children under LispWorks

Modified: trunk/src/tests/uitoolkit/layout-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/layout-tester.lisp (original) +++ trunk/src/tests/uitoolkit/layout-tester.lisp Sun Feb 19 21:23:23 2006 @@ -53,11 +53,7 @@ (exit-layout-tester))

(defclass layout-tester-widget-events (gfw:event-dispatcher) - ((widget - :accessor widget - :initarg :widget - :initform nil) - (toggle-fn + ((toggle-fn :accessor toggle-fn :initform nil) (id @@ -68,7 +64,6 @@ (defun add-layout-tester-widget (primary-type sub-type) (let* ((be (make-instance 'layout-tester-widget-events :id *button-counter*)) (w (make-instance primary-type :dispatcher be))) - (setf (widget be) w) (cond ((eql sub-type :push-button) (setf (toggle-fn be) (let ((flag nil)) @@ -81,20 +76,13 @@ (setf flag nil) (format nil "~d ~a" (id be) +btn-text-after+)))))) (incf *button-counter*))) -#| - (gfw:with-children (*layout-tester-win* child-list) - (let ((child (first (reverse (rest child-list))))) - (unless (null child) - (setf (gfi:point-x pnt) (+ (gfi:point-x (gfw:location child)) - (gfi:size-width (gfw:size child))))))) -|# (gfw:realize w *layout-tester-win* sub-type) (setf (gfw:text w) (funcall (toggle-fn be)))))

-(defmethod gfw:event-select ((d layout-tester-widget-events) item time rect) - (declare (ignorable item time rect)) - (let ((btn (widget d))) - (setf (gfw:text btn) (funcall (toggle-fn d))))) +(defmethod gfw:event-select ((d layout-tester-widget-events) btn time rect) + (declare (ignorable time rect)) + (setf (gfw:text btn) (funcall (toggle-fn d))) + (gfw:layout *layout-tester-win*))

(defclass layout-tester-child-menu-dispatcher (gfw:event-dispatcher) ())

@@ -130,7 +118,6 @@ (add-layout-tester-widget 'gfw:button :push-button) (add-layout-tester-widget 'gfw:button :push-button) (add-layout-tester-widget 'gfw:button :push-button) - (gfw:layout *layout-tester-win*) (gfw:show *layout-tester-win*)))

(defun run-layout-tester ()

Modified: trunk/src/uitoolkit/widgets/event.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event.lisp (original) +++ trunk/src/uitoolkit/widgets/event.lisp Sun Feb 19 21:23:23 2006 @@ -113,9 +113,9 @@

(defun subclass-wndproc (hwnd) (if (zerop (gfs::set-window-long hwnd - gfs::+gwlp-wndproc+ - (cffi:pointer-address - (cffi:get-callback 'subclassing_wndproc)))) + gfs::+gwlp-wndproc+ + (cffi:pointer-address + (cffi:get-callback 'subclassing_wndproc)))) (error 'gfs:win32-error :detail "set-window-long failed")))

;;;

Modified: trunk/src/uitoolkit/widgets/window.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/window.lisp (original) +++ trunk/src/uitoolkit/widgets/window.lisp Sun Feb 19 21:23:23 2006 @@ -121,13 +121,14 @@ retval (error 'gfs::win32-error :detail "register-class failed")))))))

-(defmacro with-children ((win var) &body body) - `(let ((,var nil)) - (visit-child-widgets ,win #'(lambda (parent child) - (if (gfw:ancestor-p parent child) - (push child ,var)))) - (nreverse ,var) - ,@body)) +(eval-when (:compile-toplevel :load-toplevel :execute) + (defmacro with-children ((win var) &body body) + `(let ((,var nil)) + (visit-child-widgets ,win #'(lambda (parent child) + (when (gfw:ancestor-p parent child) + (push child ,var)))) + (setf ,var (reverse ,var)) + ,@body)))

(defun register-workspace-window-class () (register-window-class +workspace-window-classname+