Author: junrue Date: Sun Jul 9 11:30:38 2006 New Revision: 187
Modified: trunk/docs/manual/api.texinfo trunk/src/demos/textedit/textedit-window.lisp trunk/src/tests/uitoolkit/drawing-tester.lisp trunk/src/tests/uitoolkit/event-tester.lisp trunk/src/tests/uitoolkit/layout-tester.lisp trunk/src/uitoolkit/widgets/control.lisp trunk/src/uitoolkit/widgets/event-generics.lisp trunk/src/uitoolkit/widgets/event-source.lisp trunk/src/uitoolkit/widgets/event.lisp trunk/src/uitoolkit/widgets/window.lisp Log: completed event-activate and added event-deactivate
Modified: trunk/docs/manual/api.texinfo ============================================================================== --- trunk/docs/manual/api.texinfo (original) +++ trunk/docs/manual/api.texinfo Sun Jul 9 11:30:38 2006 @@ -836,8 +836,9 @@
This chapter documents two types of functions: @itemize @bullet -@item generic functions implemented in order to handle system events -@item functions provided to help implement application message pumps +@item generic functions whose methods are to be implemented by application +code in order to handle system events +@item functions provided to help implement message loops @end itemize
@anchor{default-message-filter} @@ -861,29 +862,19 @@ @end table @end defun
-@deffn GenericFunction event-activate dispatcher widget type +@anchor{event-activate} +@deffn GenericFunction event-activate dispatcher widget Implement this method to respond to @var{widget} being activated. For a @ref{top-level} @ref{window} or @ref{dialog}, this means that @var{widget} was brought to the foreground and its trim (titlebar and border) was highlighted to indicate that it is now the active window. For a @ref{menu}, it means that the user has clicked on the @ref{item} invoking @ref{widget} and it is about to be shown; this is -an opportunity to update the menu's contents. +an opportunity to update the menu's contents. @xref{event-deactivate}. @table @var @event-dispatcher-arg @item widget The menu, dialog, or window that has been activated. -@item type -Provides a hint as to how activation occurred, via one of the following -keywords: -@table @code -@item :click -Indicates that @var{widget} was activated as the result of a mouse click. -@item :programmatic -Indicates that @var{widget} was activated as the result of the keyboard -interface to select a window, or programmatically via a call to -@sc{activate}. -@end table @end table @end deffn
@@ -910,6 +901,19 @@ @end table @end deffn
+@anchor{event-deactivate} +@deffn GenericFunction event-deactivate dispatcher widget +Implement this method to respond to @var{widget} being deactivated, +meaning that some other object has been made active. This event only +applies to @ref{top-level} @ref{window}s or +@ref{dialog}s. @xref{event-activate}. +@table @var +@event-dispatcher-arg +@item widget +The dialog or window that has been deactivated. +@end table +@end deffn + @deffn GenericFunction event-dispose dispatcher widget Implement this method to respond to @var{widget} being disposed (explicitly via @ref{dispose}, not collected via the garbage collector). This @@ -1089,7 +1093,7 @@ @item widget The @ref{widget} (or item) that was selected. @item rect -The @ref{rectangle} bounding @var{widget}. +The @ref{rectangle} bounding the selection inside @var{widget}. @end table @end deffn
@@ -1123,7 +1127,7 @@ @anchor{obtain-event-time} @defun obtain-event-time => milliseconds Returns the timestamp for the event currently being processed, or -zero if called prior to the delivery of any events. +zero if called prior to delivery of any events. @end defun
Modified: trunk/src/demos/textedit/textedit-window.lisp ============================================================================== --- trunk/src/demos/textedit/textedit-window.lisp (original) +++ trunk/src/demos/textedit/textedit-window.lisp Sun Jul 9 11:30:38 2006 @@ -40,8 +40,8 @@ (defvar *textedit-file-filters* '(("Text Files (*.txt)" . "*.txt") ("All Files (*.*)" . "*.*")))
-(defun manage-textedit-file-menu (disp menu type) - (declare (ignore disp type)) +(defun manage-textedit-file-menu (disp menu) + (declare (ignore disp)) (gfw:enable (elt (gfw:items menu) 2) (gfw:text-modified-p *textedit-control*)))
(defun textedit-file-new (disp item rect) @@ -95,15 +95,15 @@
(defclass textedit-win-events (gfw:event-dispatcher) ())
-(defmethod gfw:event-close ((disp textedit-win-events) window) - (declare (ignore window)) - (textedit-file-quit disp nil nil)) - -(defmethod gfw:event-focus-gain ((self textedit-win-events) window) +(defmethod gfw:event-activate ((self textedit-win-events) window) (declare (ignore window)) (if *textedit-control* (gfw:give-focus *textedit-control*)))
+(defmethod gfw:event-close ((disp textedit-win-events) window) + (declare (ignore window)) + (textedit-file-quit disp nil nil)) + (defclass textedit-about-dialog-events (gfw:event-dispatcher) ())
(defmethod gfw:event-close ((disp textedit-about-dialog-events) (dlg gfw:dialog))
Modified: trunk/src/tests/uitoolkit/drawing-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/drawing-tester.lisp (original) +++ trunk/src/tests/uitoolkit/drawing-tester.lisp Sun Jul 9 11:30:38 2006 @@ -42,8 +42,8 @@ (gfw:check *last-checked-drawing-item* nil)) (gfw:check item t))
-(defun find-checked-item (disp menu type) - (declare (ignore disp type)) +(defun find-checked-item (disp menu) + (declare (ignore disp)) (dotimes (i (length (gfw:items menu))) (let ((item (elt (gfw:items menu) i))) (when (gfw:checked-p item)
Modified: trunk/src/tests/uitoolkit/event-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/event-tester.lisp (original) +++ trunk/src/tests/uitoolkit/event-tester.lisp Sun Jul 9 11:30:38 2006 @@ -72,6 +72,14 @@ (not (gfw:key-toggled-p gfw:+vk-num-lock+)) (not (gfw:key-toggled-p gfw:+vk-scroll-lock+))))
+(defun text-for-activation (action) + (format nil + "~a action: ~s time: 0x~x ~s" + (incf *event-counter*) + action + (gfw:obtain-event-time) + (text-for-modifiers))) + (defun text-for-mouse (action button pnt) (format nil "~a mouse action: ~s button: ~a point: (~d,~d) time: 0x~x ~s" @@ -128,7 +136,15 @@ (gfw:id-of *timer*) (gfw:obtain-event-time) (text-for-modifiers))) - + +(defmethod gfw:event-activate ((d event-tester-window-events) window) + (setf *event-tester-text* (text-for-activation "window activated")) + (gfw:redraw window)) + +(defmethod gfw:event-deactivate ((d event-tester-window-events) window) + (setf *event-tester-text* (text-for-activation "window deactivated")) + (gfw:redraw window)) + (defmethod gfw:event-key-down ((d event-tester-window-events) window key-code char) (setf *event-tester-text* (text-for-key "down" key-code char)) (gfw:redraw window)) @@ -187,8 +203,7 @@ (setf *event-tester-text* (text-for-item (gfw:text item) "item armed")) (gfw:redraw *event-tester-window*))
-(defmethod gfw:event-activate ((d event-tester-echo-dispatcher) widget type) - (declare (ignore type)) +(defmethod gfw:event-activate ((d event-tester-echo-dispatcher) widget) (setf *event-tester-text* (text-for-item (format nil "~a" widget) "menu activated")) (gfw:redraw *event-tester-window*))
@@ -197,8 +212,8 @@ (setf *event-tester-text* (text-for-timer)) (gfw:redraw *event-tester-window*))
-(defun manage-file-menu (disp menu type) - (declare (ignore disp type)) +(defun manage-file-menu (disp menu) + (declare (ignore disp)) (let ((item (elt (gfw:items menu) 0))) (setf (gfw:text item) (if *timer* "Sto&p Timer" "&Start Timer"))))
Modified: trunk/src/tests/uitoolkit/layout-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/layout-tester.lisp (original) +++ trunk/src/tests/uitoolkit/layout-tester.lisp Sun Jul 9 11:30:38 2006 @@ -169,8 +169,7 @@ :initarg :sub-disp-class :initform nil)))
-(defmethod gfw:event-activate ((d child-menu-dispatcher) menu type) - (declare (ignore type)) +(defmethod gfw:event-activate ((d child-menu-dispatcher) menu) (gfw:clear-all menu) (gfw:mapchildren *layout-tester-win* (lambda (parent child) @@ -208,8 +207,8 @@ (gfw:show victim (not (gfw:visible-p victim))) (gfw:layout *layout-tester-win*))))
-(defun check-flow-orient-items (disp menu type) - (declare (ignore disp type)) +(defun check-flow-orient-items (disp menu) + (declare (ignore disp)) (let ((layout (gfw:layout-of *layout-tester-win*))) (gfw:check (elt (gfw:items menu) 0) (find :horizontal (gfw:style-of layout))) (gfw:check (elt (gfw:items menu) 1) (find :vertical (gfw:style-of layout))))) @@ -250,8 +249,8 @@ (setf (gfw:style-of layout) (push :wrap style))) (gfw:layout *layout-tester-win*)))
-(defun enable-flow-spacing-items (disp menu type) - (declare (ignore disp type)) +(defun enable-flow-spacing-items (disp menu) + (declare (ignore disp)) (let ((spacing (gfw:spacing-of (gfw:layout-of *layout-tester-win*)))) (gfw:enable (elt (gfw:items menu) 0) (> spacing 0))))
@@ -338,8 +337,8 @@ (decf (gfw:bottom-margin-of layout) +margin-delta+) (gfw:layout *layout-tester-win*)))
-(defun flow-mod-callback (disp menu type) - (declare (ignore disp type)) +(defun flow-mod-callback (disp menu) + (declare (ignore disp)) (gfw:clear-all menu) (let ((it nil) (margin-menu (gfw:defmenu ((:item "Left"
Modified: trunk/src/uitoolkit/widgets/control.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/control.lisp (original) +++ trunk/src/uitoolkit/widgets/control.lisp Sun Jul 9 11:30:38 2006 @@ -146,8 +146,7 @@ (error 'gfs:disposed-error)))
(defmethod give-focus ((self control)) - (if (gfs:null-handle-p (gfs::set-focus (gfs:handle self))) - (error 'gfs:win32-error :detail "set-focus failed"))) + (gfs::set-focus (gfs:handle self)))
(defmethod initialize-instance :after ((self control) &key callback callbacks disp parent &allow-other-keys) (if (gfs:disposed-p parent)
Modified: trunk/src/uitoolkit/widgets/event-generics.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event-generics.lisp (original) +++ trunk/src/uitoolkit/widgets/event-generics.lisp Sun Jul 9 11:30:38 2006 @@ -33,10 +33,10 @@
(in-package :graphic-forms.uitoolkit.widgets)
-(defgeneric event-activate (dispatcher widget type) +(defgeneric event-activate (dispatcher widget) (:documentation "Implement this to respond to an object being activated.") - (:method (dispatcher widget type) - (declare (ignorable dispatcher widget type)))) + (:method (dispatcher widget) + (declare (ignorable dispatcher widget))))
(defgeneric event-arm (dispatcher item) (:documentation "Implement this to respond to an object about to be selected.") @@ -53,10 +53,10 @@ (:method (dispatcher item rect) (declare (ignorable dispatcher item rect))))
-(defgeneric event-deactivate (dispatcher widget type) +(defgeneric event-deactivate (dispatcher widget) (:documentation "Implement this to respond to an object being deactivated.") - (:method (dispatcher widget type) - (declare (ignorable dispatcher widget type)))) + (:method (dispatcher widget) + (declare (ignorable dispatcher widget))))
(defgeneric event-deiconify (dispatcher widget) (:documentation "Implement this to respond to an object being deiconified.")
Modified: trunk/src/uitoolkit/widgets/event-source.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event-source.lisp (original) +++ trunk/src/uitoolkit/widgets/event-source.lisp Sun Jul 9 11:30:38 2006 @@ -33,7 +33,7 @@
(in-package :graphic-forms.uitoolkit.widgets)
-(defconstant +callback-info+ '((gfw:event-activate . (gfw:event-source symbol)) +(defconstant +callback-info+ '((gfw:event-activate . (gfw:event-source)) (gfw:event-arm . (gfw:event-source)) (gfw:event-select . (gfw:event-source gfs:rectangle))))
Modified: trunk/src/uitoolkit/widgets/event.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event.lisp (original) +++ trunk/src/uitoolkit/widgets/event.lisp Sun Jul 9 11:30:38 2006 @@ -190,7 +190,7 @@ (unless (null menu) (let ((d (dispatcher menu))) (unless (null d) - (event-activate d menu :click))))) ; FIXME: menus can be invoked programmatically, too + (event-activate d menu))))) 0)
(defmethod process-message (hwnd (msg (eql gfs::+wm-menuselect+)) wparam lparam) @@ -349,18 +349,26 @@ (declare (ignore wparam)) (process-mouse-message #'event-mouse-up hwnd lparam :right-button))
+(defmethod process-message (hwnd (msg (eql gfs::+wm-activate+)) wparam lparam) + (declare (ignore lparam)) + (let ((widget (get-widget (thread-context) hwnd))) + (if widget + (ecase wparam + (#.gfs::+wa-active+ (event-activate (dispatcher widget) widget)) + (#.gfs::+wa-clickactive+ (event-activate (dispatcher widget) widget)) + (#.gfs::+wa-inactive+ (event-deactivate (dispatcher widget) widget))))) + 0) + (defmethod process-message (hwnd (msg (eql gfs::+wm-killfocus+)) wparam lparam) (declare (ignore wparam lparam)) - (let* ((tc (thread-context)) - (widget (get-widget tc hwnd))) + (let ((widget (get-widget (thread-context) hwnd))) (if widget (event-focus-loss (dispatcher widget) widget))) 0)
(defmethod process-message (hwnd (msg (eql gfs::+wm-setfocus+)) wparam lparam) (declare (ignore wparam lparam)) - (let* ((tc (thread-context)) - (widget (get-widget tc hwnd))) + (let ((widget (get-widget (thread-context) hwnd))) (if widget (event-focus-gain (dispatcher widget) widget))) 0)
Modified: trunk/src/uitoolkit/widgets/window.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/window.lisp (original) +++ trunk/src/uitoolkit/widgets/window.lisp Sun Jul 9 11:30:38 2006 @@ -199,8 +199,7 @@ (error 'gfs:disposed-error)))
(defmethod give-focus ((win window)) - (if (gfs:null-handle-p (gfs::set-focus (gfs:handle win))) - (error 'gfs:win32-error :detail "set-focus failed"))) + (gfs::set-focus (gfs:handle win)))
(defmethod location ((win window)) (if (gfs:disposed-p win)