[graphic-forms-cvs] r12 - in trunk/src: tests/uitoolkit uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Sun Feb 19 23:57:22 UTC 2006
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+))
More information about the Graphic-forms-cvs
mailing list