[graphic-forms-cvs] r100 - trunk/src/uitoolkit/widgets

[junrue at common-lisp.net]

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))
-       , at 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))
+        , at body))))
 
 ;;;
 ;;; methods