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

[junrue at common-lisp.net]

Author: junrue
Date: Wed Feb 22 20:55:47 2006
New Revision: 18

Modified:
   trunk/src/uitoolkit/widgets/event.lisp
Log:
fixed a mis-declaration of the msg parameter for wndproc defcallbacks

Modified: trunk/src/uitoolkit/widgets/event.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/event.lisp	(original)
+++ trunk/src/uitoolkit/widgets/event.lisp	Wed Feb 22 20:55:47 2006
@@ -43,7 +43,7 @@
 ;;;
 
 (cffi:defcallback uit_widgets_wndproc
-                  gfs::LONG
+                  gfs::UINT
                   ((hwnd gfs::HANDLE)
                    (msg gfs::UINT)
                    (wparam gfs::WPARAM)
@@ -51,7 +51,7 @@
   (process-message hwnd msg wparam lparam))
 
 (cffi:defcallback subclassing_wndproc
-                  gfs::LONG
+                  gfs::UINT
                   ((hwnd gfs::HANDLE)
                    (msg gfs::UINT)
                    (wparam gfs::WPARAM)
@@ -98,11 +98,12 @@
 
 (defun process-mouse-message (fn hwnd lparam btn-symbol)
   (let* ((tc (thread-context))
-         (w (get-widget tc hwnd)))
+         (w (get-widget tc hwnd))
+         (pnt (mouse-event-pnt tc)))
     (when w
-      (setf (gfi:point-x (mouse-event-pnt tc)) (lo-word lparam))
-      (setf (gfi:point-y (mouse-event-pnt tc)) (hi-word lparam))
-      (funcall fn (dispatcher w) w (event-time tc) (mouse-event-pnt tc) btn-symbol)))
+      (setf (gfi:point-x pnt) (lo-word lparam))
+      (setf (gfi:point-y pnt) (hi-word lparam))
+      (funcall fn (dispatcher w) w (event-time tc) pnt btn-symbol)))
   0)
 
 (defun get-class-wndproc (hwnd)