[graphic-forms-cvs] r12 - in trunk/src: tests/uitoolkit uitoolkit/widgets

Author: junrue Date: Sun Feb 19 17:57:22 2006 New Revision: 12

Modified: trunk/src/tests/uitoolkit/event-tester.lisp trunk/src/tests/uitoolkit/hello-world.lisp trunk/src/tests/uitoolkit/layout-tester.lisp trunk/src/uitoolkit/widgets/event-generics.lisp trunk/src/uitoolkit/widgets/event.lisp trunk/src/uitoolkit/widgets/widget.lisp trunk/src/uitoolkit/widgets/window.lisp Log: revised event generic methods to also pass receiving widget

Modified: trunk/src/tests/uitoolkit/event-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/event-tester.lisp (original) +++ trunk/src/tests/uitoolkit/event-tester.lisp Sun Feb 19 17:57:22 2006 @@ -46,16 +46,16 @@

(defclass event-tester-window-events (gfw:event-dispatcher) ())

-(defmethod gfw:event-paint ((d event-tester-window-events) time gc rect) +(defmethod gfw:event-paint ((d event-tester-window-events) window time gc rect) (declare (ignorable time rect)) (setf (gfg:background-color gc) gfg:+color-white+) (setf (gfg:foreground-color gc) gfg:+color-blue+) - (let* ((sz (gfw:client-size *event-tester-window*)) + (let* ((sz (gfw:client-size window)) (pnt (gfi:make-point :x 0 :y (floor (/ (gfi:size-height sz) 2))))) (gfg:draw-text gc *event-tester-text* pnt)))

-(defmethod gfw:event-close ((d event-tester-window-events) time) - (declare (ignore time)) +(defmethod gfw:event-close ((d event-tester-window-events) widget time) + (declare (ignore widget time)) (exit-event-tester))

(defun text-for-modifiers () @@ -120,68 +120,68 @@ time (text-for-modifiers)))

-(defmethod gfw:event-key-down ((d event-tester-window-events) time key-code char) +(defmethod gfw:event-key-down ((d event-tester-window-events) window time key-code char) (setf *event-tester-text* (text-for-key "down" time key-code char)) - (gfw:redraw *event-tester-window*)) + (gfw:redraw window))

-(defmethod gfw:event-key-up ((d event-tester-window-events) time key-code char) +(defmethod gfw:event-key-up ((d event-tester-window-events) window time key-code char) (setf *event-tester-text* (text-for-key "up" time key-code char)) - (gfw:redraw *event-tester-window*)) + (gfw:redraw window))

-(defmethod gfw:event-mouse-double ((d event-tester-window-events) time pnt button) +(defmethod gfw:event-mouse-double ((d event-tester-window-events) window time pnt button) (setf *event-tester-text* (text-for-mouse "double" time button pnt)) - (gfw:redraw *event-tester-window*)) + (gfw:redraw window))

-(defmethod gfw:event-mouse-down ((d event-tester-window-events) time pnt button) +(defmethod gfw:event-mouse-down ((d event-tester-window-events) window time pnt button) (setf *event-tester-text* (text-for-mouse "down" time button pnt)) (setf *mouse-down-flag* t) - (gfw:redraw *event-tester-window*)) + (gfw:redraw window))

-(defmethod gfw:event-mouse-move ((d event-tester-window-events) time pnt button) +(defmethod gfw:event-mouse-move ((d event-tester-window-events) window time pnt button) (when *mouse-down-flag* (setf *event-tester-text* (text-for-mouse "move" time button pnt)) - (gfw:redraw *event-tester-window*))) + (gfw:redraw window)))

-(defmethod gfw:event-mouse-up ((d event-tester-window-events) time pnt button) +(defmethod gfw:event-mouse-up ((d event-tester-window-events) window time pnt button) (setf *event-tester-text* (text-for-mouse "up" time button pnt)) (setf *mouse-down-flag* nil) - (gfw:redraw *event-tester-window*)) + (gfw:redraw window))

-(defmethod gfw:event-move ((d event-tester-window-events) time pnt) +(defmethod gfw:event-move ((d event-tester-window-events) window time pnt) (setf *event-tester-text* (text-for-move time pnt)) - (gfw:redraw *event-tester-window*) + (gfw:redraw window) 0)

-(defmethod gfw:event-resize ((d event-tester-window-events) time size type) +(defmethod gfw:event-resize ((d event-tester-window-events) window time size type) (setf *event-tester-text* (text-for-size type time size)) - (gfw:redraw *event-tester-window*) + (gfw:redraw window) 0)

(defclass event-tester-exit-dispatcher (gfw:event-dispatcher) ())

-(defmethod gfw:event-select ((d event-tester-exit-dispatcher) time item rect) - (declare (ignorable time item rect)) +(defmethod gfw:event-select ((d event-tester-exit-dispatcher) item time rect) + (declare (ignorable item time rect)) (exit-event-tester))

-(defmethod gfw:event-arm ((d event-tester-exit-dispatcher) time item) +(defmethod gfw:event-arm ((d event-tester-exit-dispatcher) item time) (declare (ignore rect)) (setf *event-tester-text* (text-for-item (gfw:text item) time "item armed")) (gfw:redraw *event-tester-window*))

(defclass event-tester-echo-dispatcher (gfw:event-dispatcher) ())

-(defmethod gfw:event-select ((d event-tester-echo-dispatcher) time item rect) +(defmethod gfw:event-select ((d event-tester-echo-dispatcher) item time rect) (declare (ignore rect)) (setf *event-tester-text* (text-for-item (gfw:text item) time "item selected")) (gfw:redraw *event-tester-window*))

-(defmethod gfw:event-arm ((d event-tester-echo-dispatcher) time item) +(defmethod gfw:event-arm ((d event-tester-echo-dispatcher) item time) (declare (ignore rect)) (setf *event-tester-text* (text-for-item (gfw:text item) time "item armed")) (gfw:redraw *event-tester-window*))

-(defmethod gfw:event-activate ((d event-tester-echo-dispatcher) time) - (setf *event-tester-text* (text-for-item "" time "menu activated")) +(defmethod gfw:event-activate ((d event-tester-echo-dispatcher) widget time) + (setf *event-tester-text* (text-for-item (format nil "~a" widget) time "menu activated")) (gfw:redraw *event-tester-window*))

(defun run-event-tester-internal ()

Modified: trunk/src/tests/uitoolkit/hello-world.lisp ============================================================================== --- trunk/src/tests/uitoolkit/hello-world.lisp (original) +++ trunk/src/tests/uitoolkit/hello-world.lisp Sun Feb 19 17:57:22 2006 @@ -43,21 +43,20 @@

(defclass hellowin-events (gfw:event-dispatcher) ())

-(defmethod gfw:event-close ((d hellowin-events) time) - (declare (ignore time)) - (format t "hellowin-events event-close~%") +(defmethod gfw:event-close ((d hellowin-events) widget time) + (declare (ignore widget time)) (exit-hello-world))

-(defmethod gfw:event-paint ((d hellowin-events) time (gc gfg:graphics-context) rect) - (declare (ignore time) (ignore rect)) +(defmethod gfw:event-paint ((d hellowin-events) window time gc rect) + (declare (ignorable window time ignore rect)) (setf (gfg:background-color gc) gfg:+color-red+) (setf (gfg:foreground-color gc) gfg:+color-green+) (gfg:draw-text gc "Hello World!" (gfi:make-point)))

(defclass hellowin-exit-dispatcher (gfw:event-dispatcher) ())

-(defmethod gfw:event-select ((d hellowin-exit-dispatcher) time item rect) - (declare (ignorable time item rect)) +(defmethod gfw:event-select ((d hellowin-exit-dispatcher) item time rect) + (declare (ignorable item time rect)) (exit-hello-world))

(defun run-hello-world-internal ()

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 17:57:22 2006 @@ -48,8 +48,8 @@

(defclass layout-tester-events (gfw:event-dispatcher) ())

-(defmethod gfw:event-close ((d layout-tester-events) time) - (declare (ignore time)) +(defmethod gfw:event-close ((d layout-tester-events) widget time) + (declare (ignore widget time)) (exit-layout-tester))

(defclass layout-tester-widget-events (gfw:event-dispatcher) @@ -91,28 +91,26 @@ (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) time item rect) - (declare (ignorable time rect)) +(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)))))

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

-(defmethod gfw:event-activate ((d layout-tester-child-menu-dispatcher) time) +(defmethod gfw:event-activate ((d layout-tester-child-menu-dispatcher) menu time) (declare (ignore time)) - (let* ((mb (gfw:menu-bar *layout-tester-win*)) - (menu (gfw:sub-menu mb 1))) - (gfw:clear-all menu) - (gfw:with-children (*layout-tester-win* kids) - (loop for k in kids - do (let ((it (make-instance 'gfw:menu-item))) - (gfw:item-append menu it) - (setf (gfw:text it) (gfw:text k))))))) + (gfw:clear-all menu) + (gfw:with-children (*layout-tester-win* kids) + (loop for k in kids + do (let ((it (make-instance 'gfw:menu-item))) + (gfw:item-append menu it) + (setf (gfw:text it) (gfw:text k))))))

(defclass layout-tester-exit-dispatcher (gfw:event-dispatcher) ())

-(defmethod gfw:event-select ((d layout-tester-exit-dispatcher) time item rect) - (declare (ignorable time item rect)) +(defmethod gfw:event-select ((d layout-tester-exit-dispatcher) item time rect) + (declare (ignorable item time rect)) (exit-layout-tester))

(defun run-layout-tester-internal ()

Modified: trunk/src/uitoolkit/widgets/event-generics.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event-generics.lisp (original) +++ trunk/src/uitoolkit/widgets/event-generics.lisp Sun Feb 19 17:57:22 2006 @@ -33,157 +33,157 @@

(in-package :graphic-forms.uitoolkit.widgets)

-(defgeneric event-activate (dispatcher time) +(defgeneric event-activate (dispatcher widget time) (:documentation "Implement this to respond to an object being activated.") - (:method (dispatcher time) - (declare (ignorable dispatcher time)))) + (:method (dispatcher widget time) + (declare (ignorable dispatcher widget time))))

-(defgeneric event-arm (dispatcher time item) +(defgeneric event-arm (dispatcher item time) (:documentation "Implement this to respond to an object about to be selected.") - (:method (dispatcher time item) - (declare (ignorable dispatcher time item)))) + (:method (dispatcher item time) + (declare (ignorable dispatcher item time))))

-(defgeneric event-close (dispatcher time) +(defgeneric event-close (dispatcher widget time) (:documentation "Implement this to respond to an object being closed.") - (:method (dispatcher time) - (declare (ignorable dispatcher time)))) + (:method (dispatcher widget time) + (declare (ignorable dispatcher widget time))))

-(defgeneric event-collapse (dispatcher time item rect) +(defgeneric event-collapse (dispatcher item time rect) (:documentation "Implement this to respond to an object (or item within) being collapsed.") - (:method (dispatcher time item rect) - (declare (ignorable dispatcher time item rect)))) + (:method (dispatcher item time rect) + (declare (ignorable dispatcher item time rect))))

-(defgeneric event-deactivate (dispatcher time) +(defgeneric event-deactivate (dispatcher widget time) (:documentation "Implement this to respond to an object being deactivated.") - (:method (dispatcher time) - (declare (ignorable dispatcher time)))) + (:method (dispatcher widget time) + (declare (ignorable dispatcher widget time))))

-(defgeneric event-deiconify (dispatcher time) +(defgeneric event-deiconify (dispatcher widget time) (:documentation "Implement this to respond to an object being deiconified.") - (:method (dispatcher time) - (declare (ignorable dispatcher time)))) + (:method (dispatcher widget time) + (declare (ignorable dispatcher widget time))))

-(defgeneric event-dispose (dispatcher time) +(defgeneric event-dispose (dispatcher widget time) (:documentation "Implement this to respond to an object being disposed (via dispose, not the GC).") - (:method (dispatcher time) - (declare (ignorable dispatcher time)))) + (:method (dispatcher widget time) + (declare (ignorable dispatcher widget time))))

-(defgeneric event-expand (dispatcher time item rect) +(defgeneric event-expand (dispatcher item time rect) (:documentation "Implement this to respond to an object (or item within) being expanded.") - (:method (dispatcher time item rect) - (declare (ignorable dispatcher time item rect)))) + (:method (dispatcher item time rect) + (declare (ignorable dispatcher item time rect))))

-(defgeneric event-focus-gain (dispatcher time) +(defgeneric event-focus-gain (dispatcher widget time) (:documentation "Implement this to respond to an object gaining keyboard focus.") - (:method (dispatcher time) - (declare (ignorable dispatcher time)))) + (:method (dispatcher widget time) + (declare (ignorable dispatcher widget time))))

-(defgeneric event-focus-loss (dispatcher time) +(defgeneric event-focus-loss (dispatcher widget time) (:documentation "Implement this to respond to an object losing keyboard focus.") - (:method (dispatcher time) - (declare (ignorable dispatcher time)))) + (:method (dispatcher widget time) + (declare (ignorable dispatcher widget time))))

-(defgeneric event-hide (dispatcher time) +(defgeneric event-hide (dispatcher widget time) (:documentation "Implement this to respond to an object being hidden.") - (:method (dispatcher time) - (declare (ignorable dispatcher time)))) + (:method (dispatcher widget time) + (declare (ignorable dispatcher widget time))))

-(defgeneric event-iconify (dispatcher time) +(defgeneric event-iconify (dispatcher widget time) (:documentation "Implement this to respond to an object being iconified.") - (:method (dispatcher time) - (declare (ignorable dispatcher time)))) + (:method (dispatcher widget time) + (declare (ignorable dispatcher widget time))))

-(defgeneric event-key-down (dispatcher time keycode char) +(defgeneric event-key-down (dispatcher widget time keycode char) (:documentation "Implement this to respond to a key down event.") - (:method (dispatcher time keycode char) - (declare (ignorable dispatcher time keycode char)))) + (:method (dispatcher widget time keycode char) + (declare (ignorable dispatcher widget time keycode char))))

-(defgeneric event-key-traverse (dispatcher time keycode char type) +(defgeneric event-key-traverse (dispatcher widget time keycode char type) (:documentation "Implement this to respond to a key traversal event.") - (:method (dispatcher time keycode char type) - (declare (ignorable dispatcher time keycode char type)))) + (:method (dispatcher widget time keycode char type) + (declare (ignorable dispatcher widget time keycode char type))))

-(defgeneric event-key-up (dispatcher time keycode char) +(defgeneric event-key-up (dispatcher widget time keycode char) (:documentation "Implement this to respond to a key up event.") - (:method (dispatcher time keycode char) - (declare (ignorable dispatcher time keycode char)))) + (:method (dispatcher widget time keycode char) + (declare (ignorable dispatcher widget time keycode char))))

-(defgeneric event-modify (dispatcher time) +(defgeneric event-modify (dispatcher widget time) (:documentation "Implement this to respond to content (e.g., text) in an object being modified.") - (:method (dispatcher time) - (declare (ignorable dispatcher time)))) + (:method (dispatcher widget time) + (declare (ignorable dispatcher widget time))))

-(defgeneric event-mouse-double (dispatcher time point btn) +(defgeneric event-mouse-double (dispatcher widget time point button) (:documentation "Implement this to respond to a mouse double-click.") - (:method (dispatcher time point btn) - (declare (ignorable dispatcher time point btn)))) + (:method (dispatcher widget time point button) + (declare (ignorable dispatcher widget time point button))))

-(defgeneric event-mouse-down (dispatcher time point btn) +(defgeneric event-mouse-down (dispatcher widget time point button) (:documentation "Implement this to respond to a mouse down event.") - (:method (dispatcher time point btn) - (declare (ignorable dispatcher time point btn)))) + (:method (dispatcher widget time point button) + (declare (ignorable dispatcher widget time point button))))

-(defgeneric event-mouse-enter (dispatcher time point btn) +(defgeneric event-mouse-enter (dispatcher widget time point button) (:documentation "Implement this to respond to a mouse passing into the bounds of an object.") - (:method (dispatcher time point btn) - (declare (ignorable dispatcher time point btn)))) + (:method (dispatcher widget time point button) + (declare (ignorable dispatcher widget time point button))))

-(defgeneric event-mouse-exit (dispatcher time point btn) +(defgeneric event-mouse-exit (dispatcher widget time point button) (:documentation "Implement this to respond to a mouse leaving the bounds an object.") - (:method (dispatcher time point btn) - (declare (ignorable dispatcher time point btn)))) + (:method (dispatcher widget time point button) + (declare (ignorable dispatcher widget time point button))))

-(defgeneric event-mouse-hover (dispatcher time point btn) +(defgeneric event-mouse-hover (dispatcher widget time point button) (:documentation "Implement this to respond to a mouse that stops moving for a period of time within an object.") - (:method (dispatcher time point btn) - (declare (ignorable dispatcher time point btn)))) + (:method (dispatcher widget time point button) + (declare (ignorable dispatcher widget time point button))))

-(defgeneric event-mouse-move (dispatcher time point btn) +(defgeneric event-mouse-move (dispatcher widget time point button) (:documentation "Implement this to respond to a mouse move event.") - (:method (dispatcher time point btn) - (declare (ignorable dispatcher time point btn)))) + (:method (dispatcher widget time point button) + (declare (ignorable dispatcher widget time point button))))

-(defgeneric event-mouse-up (dispatcher time point btn) +(defgeneric event-mouse-up (dispatcher widget time point button) (:documentation "Implement this to respond to a mouse up event.") - (:method (dispatcher time point btn) - (declare (ignorable dispatcher time point btn)))) + (:method (dispatcher widget time point button) + (declare (ignorable dispatcher widget time point button))))

-(defgeneric event-move (dispatcher time point) +(defgeneric event-move (dispatcher widget time point) (:documentation "Implement this to respond to an object being moved within its parent's coordinate system.") - (:method (dispatcher time point) - (declare (ignorable dispatcher time point)))) + (:method (dispatcher widget time point) + (declare (ignorable dispatcher widget time point))))

-(defgeneric event-paint (dispatcher time gc rect) +(defgeneric event-paint (dispatcher widget time gc rect) (:documentation "Implement this to respond to paint requests.") - (:method (dispatcher time gc rect) - (declare (ignorable dispatcher time gc rect)))) + (:method (dispatcher widget time gc rect) + (declare (ignorable dispatcher widget time gc rect))))

-(defgeneric event-pre-modify (dispatcher time keycode char span new-content) +(defgeneric event-pre-modify (dispatcher widget time keycode char span new-content) (:documentation "Implement this to respond to content (e.g., text) in an object about to be modified.") - (:method (dispatcher time keycode char span new-content) - (declare (ignorable dispatcher time keycode char span new-content)))) + (:method (dispatcher widget time keycode char span new-content) + (declare (ignorable dispatcher widget time keycode char span new-content))))

-(defgeneric event-pre-move (dispatcher time) +(defgeneric event-pre-move (dispatcher widget time) (:documentation "Implement this to preempt moving; return T if processed or nil if not.") - (:method (dispatcher time) - (declare (ignorable dispatcher time)))) + (:method (dispatcher widget time) + (declare (ignorable dispatcher widget time))))

-(defgeneric event-pre-resize (dispatcher time) +(defgeneric event-pre-resize (dispatcher widget time) (:documentation "Implement this to preempt resizing; return T if processed or nil if not.") - (:method (dispatcher time) - (declare (ignorable dispatcher time)))) + (:method (dispatcher widget time) + (declare (ignorable dispatcher widget time))))

-(defgeneric event-resize (dispatcher time size type) +(defgeneric event-resize (dispatcher widget time size type) (:documentation "Implement this to respond to an object being resized.") - (:method (dispatcher time size type) - (declare (ignorable dispatcher time size type)))) + (:method (dispatcher widget time size type) + (declare (ignorable dispatcher widget time size type))))

-(defgeneric event-select (dispatcher time item rect) +(defgeneric event-select (dispatcher item time rect) (:documentation "Implement this to respond to an object (or item within) being selected.") - (:method (dispatcher time item rect) - (declare (ignorable dispatcher time item rect)))) + (:method (dispatcher item time rect) + (declare (ignorable dispatcher item time rect))))

-(defgeneric event-show (dispatcher time) +(defgeneric event-show (dispatcher widget time) (:documentation "Implement this to respond to an object being shown.") - (:method (dispatcher time) - (declare (ignorable dispatcher time)))) + (:method (dispatcher widget time) + (declare (ignorable dispatcher widget time))))

Modified: trunk/src/uitoolkit/widgets/event.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event.lisp (original) +++ trunk/src/uitoolkit/widgets/event.lisp Sun Feb 19 17:57:22 2006 @@ -102,7 +102,7 @@ (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) (event-time tc) (mouse-event-pnt tc) btn-symbol))) + (funcall fn (dispatcher w) w (event-time tc) (mouse-event-pnt tc) btn-symbol))) 0)

(defun get-class-wndproc (hwnd) @@ -130,7 +130,7 @@ (let* ((tc (thread-context)) (w (get-widget tc hwnd))) (if w - (event-close (dispatcher w) (event-time tc)) + (event-close (dispatcher w) w (event-time tc)) (error 'gfs:toolkit-error :detail "no object for hwnd"))) 0)

@@ -146,8 +146,8 @@ (error 'gfs:toolkit-error :detail "no menu item for id")) (unless (null (dispatcher item)) (event-select (dispatcher item) - (event-time tc) item + (event-time tc) (make-instance 'gfi:rectangle))))) ; FIXME ((eq wparam-hi 1) (format t "accelerator wparam: ~x lparam: ~x~%" wparam lparam)) @@ -157,8 +157,8 @@ (error 'gfs:toolkit-error :detail "no object for hwnd")) (unless (null (dispatcher w)) (event-select (dispatcher w) - (event-time tc) w + (event-time tc) (make-instance 'gfi:rectangle)))))) ; FIXME (error 'gfs:toolkit-error :detail "no object for hwnd"))) 0) @@ -170,7 +170,7 @@ (unless (null menu) (let ((d (dispatcher menu))) (unless (null d) - (event-activate d (event-time tc)))))) + (event-activate d menu (event-time tc)))))) 0)

(defmethod process-message (hwnd (msg (eql gfs::+wm-menuselect+)) wparam lparam) @@ -180,7 +180,7 @@ (unless (null item) (let ((d (dispatcher item))) (unless (null d) - (event-arm d (event-time tc) item))))) + (event-arm d item (event-time tc)))))) 0)

(defmethod process-message (hwnd (msg (eql gfs::+wm-create+)) wparam lparam) @@ -199,7 +199,7 @@ (w (get-widget tc hwnd)) (ch (code-char (lo-word wparam)))) (when w - (event-key-down (dispatcher w) (event-time tc) (virtual-key tc) ch))) + (event-key-down (dispatcher w) w (event-time tc) (virtual-key tc) ch))) 0)

(defmethod process-message (hwnd (msg (eql gfs::+wm-keydown+)) wparam lparam) @@ -209,7 +209,7 @@ (w (get-widget tc hwnd))) (setf (virtual-key tc) wparam-lo) (when (and w (= ch 0) (= (logand lparam #x40000000) 0)) - (event-key-down (dispatcher w) (event-time tc) wparam-lo (code-char ch)))) + (event-key-down (dispatcher w) w (event-time tc) wparam-lo (code-char ch)))) 0)

(defmethod process-message (hwnd (msg (eql gfs::+wm-keyup+)) wparam lparam) @@ -220,7 +220,7 @@ (ch (gfs::map-virtual-key wparam-lo 2)) (w (get-widget tc hwnd))) (when w - (event-key-up (dispatcher w) (event-time tc) wparam-lo (code-char ch))))) + (event-key-up (dispatcher w) w (event-time tc) wparam-lo (code-char ch))))) (setf (virtual-key tc) 0)) 0)

@@ -265,14 +265,14 @@ (w (get-widget tc hwnd))) (when w (outer-location w (move-event-pnt tc)) - (event-move (dispatcher w) (event-time tc) (move-event-pnt tc)))) + (event-move (dispatcher w) w (event-time tc) (move-event-pnt tc)))) 0)

(defmethod process-message (hwnd (msg (eql gfs::+wm-moving+)) wparam lparam) (declare (ignorable wparam lparam)) (let* ((tc (thread-context)) (w (get-widget tc hwnd))) - (if (and w (event-pre-move (dispatcher w) (event-time tc))) + (if (and w (event-pre-move (dispatcher w) w (event-time tc))) 1 0)))

@@ -295,7 +295,7 @@ (setf (gfi:size rct) (gfi:make-size :width gfs::rcpaint-width :height gfs::rcpaint-height)) (unwind-protect - (event-paint (dispatcher w) (event-time tc) gc rct) + (event-paint (dispatcher w) w (event-time tc) gc rct) (gfs::end-paint hwnd ps-ptr))))) (error 'gfs:toolkit-error :detail "no object for hwnd"))) 0) @@ -323,14 +323,14 @@ (t nil)))) (when w (outer-size w (size-event-size tc)) - (event-resize (dispatcher w) (event-time tc) (size-event-size tc) type))) + (event-resize (dispatcher w) w (event-time tc) (size-event-size tc) type))) 0)

(defmethod process-message (hwnd (msg (eql gfs::+wm-sizing+)) wparam lparam) (declare (ignorable wparam lparam)) (let* ((tc (thread-context)) (w (get-widget tc hwnd))) - (if (and w (event-pre-resize (dispatcher w) (event-time tc))) + (if (and w (event-pre-resize (dispatcher w) w (event-time tc))) 1 0)))

Modified: trunk/src/uitoolkit/widgets/widget.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget.lisp (original) +++ trunk/src/uitoolkit/widgets/widget.lisp Sun Feb 19 17:57:22 2006 @@ -66,7 +66,7 @@

(defmethod gfi:dispose ((w widget)) (unless (null (dispatcher w)) - (event-dispose (dispatcher w) 0)) + (event-dispose (dispatcher w) w 0)) (let ((hwnd (gfi:handle w))) (if (not (gfi:null-handle-p hwnd)) (if (zerop (gfs::destroy-window hwnd))

Modified: trunk/src/uitoolkit/widgets/window.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/window.lisp (original) +++ trunk/src/uitoolkit/widgets/window.lisp Sun Feb 19 17:57:22 2006 @@ -216,9 +216,9 @@ (setf (slot-value win 'layout-p) t) (layout win))

-(defmethod event-resize ((d dispatcher) time size type) - (declare (ignorable time size type)) - (layout win)) ; FIXME: this is a big flaw in event handling -- need the window here! +(defmethod event-resize ((d event-dispatcher) (win window) time size type) + (declare (ignorable d time size type)) + (layout win))

(defmethod hide ((win window)) (gfs::show-window (gfi:handle win) gfs::+sw-hide+))