[graphic-forms-cvs] r187 - in trunk: docs/manual src/demos/textedit src/tests/uitoolkit src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Sun Jul 9 15:30:41 UTC 2006
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
- at item generic functions implemented in order to handle system events
- at item functions provided to help implement application message pumps
+ at item generic functions whose methods are to be implemented by application
+code in order to handle system events
+ at item functions provided to help implement message loops
@end itemize
@anchor{default-message-filter}
@@ -861,29 +862,19 @@
@end table
@end defun
- at deffn GenericFunction event-activate dispatcher widget type
+ at anchor{event-activate}
+ at 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.
- at item type
-Provides a hint as to how activation occurred, via one of the following
-keywords:
- at table @code
- at item :click
-Indicates that @var{widget} was activated as the result of a mouse click.
- at 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
- at sc{activate}.
- at end table
@end table
@end deffn
@@ -910,6 +901,19 @@
@end table
@end deffn
+ at anchor{event-deactivate}
+ at 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
+ at ref{dialog}s. @xref{event-activate}.
+ at table @var
+ at event-dispatcher-arg
+ at item widget
+The dialog or window that has been deactivated.
+ at end table
+ at 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)
More information about the Graphic-forms-cvs
mailing list