Author: junrue Date: Sun Apr 16 23:59:10 2006 New Revision: 100 Modified: trunk/src/uitoolkit/widgets/event-source.lisp trunk/src/uitoolkit/widgets/event.lisp trunk/src/uitoolkit/widgets/flow-layout.lisp trunk/src/uitoolkit/widgets/top-level.lisp trunk/src/uitoolkit/widgets/widget.lisp trunk/src/uitoolkit/widgets/window.lisp Log: fixed a bug in with-children macro where I shouldn't have been using ancestor-p to filter the results from enum-child-windows; added a couple of debug statements enabled with #+gf-debug-widgets; added a couple strategic implementations of print-object to aid debugging Modified: trunk/src/uitoolkit/widgets/event-source.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event-source.lisp (original) +++ trunk/src/uitoolkit/widgets/event-source.lisp Sun Apr 16 23:59:10 2006 @@ -81,3 +81,8 @@ (defmethod parent :before ((self event-source)) (if (gfs:disposed-p self) (error 'gfs:disposed-error))) + +(defmethod print-object ((self event-source) stream) + (print-unreadable-object (self stream :type t) + (format stream "handle: ~x " (gfs:handle self)) + (format stream "dispatcher: ~a " (dispatcher self)))) Modified: trunk/src/uitoolkit/widgets/event.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event.lisp (original) +++ trunk/src/uitoolkit/widgets/event.lisp Sun Apr 16 23:59:10 2006 @@ -357,6 +357,7 @@ (t nil)))) (when w (outer-size w (size-event-size tc)) + #+gf-debug-widgets (format t "about to call event-resize: ~a~%" hwnd) (event-resize (dispatcher w) w (event-time tc) (size-event-size tc) type))) 0) Modified: trunk/src/uitoolkit/widgets/flow-layout.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/flow-layout.lisp (original) +++ trunk/src/uitoolkit/widgets/flow-layout.lisp Sun Apr 16 23:59:10 2006 @@ -131,6 +131,7 @@ (defmethod compute-layout ((layout flow-layout) (win window) width-hint height-hint) (with-children (win kids) + #+gf-debug-widgets (format t "compute-layout: ~a~%~a~%" win kids) (flow-container-layout layout (visible-p win) kids width-hint height-hint))) (defmethod initialize-instance :after ((layout flow-layout) Modified: trunk/src/uitoolkit/widgets/top-level.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/top-level.lisp (original) +++ trunk/src/uitoolkit/widgets/top-level.lisp Sun Apr 16 23:59:10 2006 @@ -183,6 +183,14 @@ (setf (size win) size) (perform-layout win (gfs:size-width size) (gfs:size-height size))))) +(defmethod print-object ((self top-level) stream) + (print-unreadable-object (self stream :type t) + (format stream "handle: ~x " (gfs:handle self)) + (format stream "dispatcher: ~a " (dispatcher self)) + (format stream "client size: ~a " (size self)) + (format stream "min size: ~a " (minimum-size self)) + (format stream "max size: ~a" (maximum-size self)))) + (defmethod text :before ((win top-level)) (if (gfs:disposed-p win) (error 'gfs:disposed-error))) Modified: trunk/src/uitoolkit/widgets/widget.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget.lisp (original) +++ trunk/src/uitoolkit/widgets/widget.lisp Sun Apr 16 23:59:10 2006 @@ -233,6 +233,12 @@ (error 'gfs:toolkit-error :detail "no widget for hwnd"))) widget)) +(defmethod print-object ((self widget) stream) + (print-unreadable-object (self stream :type t) + (format stream "handle: ~x " (gfs:handle self)) + (format stream "dispatcher: ~a " (dispatcher self)) + (format stream "client size: ~a" (size self)))) + (defmethod redraw :before ((w widget)) (if (gfs:disposed-p w) (error 'gfs:disposed-error))) Modified: trunk/src/uitoolkit/widgets/window.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/window.lisp (original) +++ trunk/src/uitoolkit/widgets/window.lisp Sun Apr 16 23:59:10 2006 @@ -138,12 +138,14 @@ (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))) + (let ((hwnd (gensym))) + `(let ((,var nil)) + (visit-child-widgets ,win #'(lambda (parent child) + (let ((,hwnd (gfs::get-ancestor (gfs:handle child) gfs::+ga-parent+))) + (if (cffi:pointer-eq (gfs:handle parent) ,hwnd) + (push child ,var))))) + (setf ,var (reverse ,var)) + ,@body)))) ;;; ;;; methods