[graphic-forms-cvs] r189 - in trunk: docs/manual src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Sun Jul 9 20:38:16 UTC 2006
Author: junrue
Date: Sun Jul 9 16:38:15 2006
New Revision: 189
Modified:
trunk/docs/manual/api.texinfo
trunk/docs/manual/reference.texinfo
trunk/src/uitoolkit/widgets/control.lisp
trunk/src/uitoolkit/widgets/event-source.lisp
trunk/src/uitoolkit/widgets/menu-item.lisp
trunk/src/uitoolkit/widgets/menu-language.lisp
trunk/src/uitoolkit/widgets/menu.lisp
trunk/src/uitoolkit/widgets/widget-classes.lisp
Log:
abstracted :callback setup somewhat for controls; added related documentation
Modified: trunk/docs/manual/api.texinfo
==============================================================================
--- trunk/docs/manual/api.texinfo (original)
+++ trunk/docs/manual/api.texinfo Sun Jul 9 16:38:15 2006
@@ -178,12 +178,22 @@
classes.
@anchor{button}
- at deftp Class button
-This @ref{control} class represents selectable controls that invoke
-the @ref{event-select} method defined for an @ref{event-dispatcher}
-associated with the @code{button}.
+ at deftp Class button callback-event-name
+This @ref{control} class represents selectable controls that generate
+an event when clicked.
+ at table @var
+ at item callback-event-name
+This is an (@code{:allocation :class}) slot that holds a symbol
+identifying an event function (e.g., @ref{event-select}). See
+ at ref{event-source} for more details on this slot.
+ at end table
+ at deffn Initarg :callback
+The @sc{function} value supplied via this initarg will be
+used as the implementation of @ref{event-select} in an
+ at ref{event-dispatcher} configured for the @code{button}.
+ at end deffn
@deffn Initarg :image
-Supplies an image to be used as the @code{button} label.
+Supplies an image to be used as the @code{button}'s label.
@end deffn
@deffn Initarg :style
@table @code
@@ -229,7 +239,43 @@
@anchor{control}
@deftp Class control brush-color brush-handle font pixel-point maximum-size minimum-size text-color
The base class for widgets having pre-defined native behavior. It derives from
- at ref{widget}.
+ at ref{widget}.@*@*
+ at strong{Note:} application code should not manipulate @code{control} slots
+directly, unless defining a new @code{control} type as an extension to
+Graphic-Forms.
+ at table @var
+ at item brush-color
+If set, this @ref{color} object is used as the @code{control}'s background color
+when the @code{control} needs to be redrawn.
+ at item brush-handle
+This is a native handle for a Win32 @sc{brush} that is used when customizing
+the @code{control}'s background color.
+ at item font
+This is a @ref{font} object for customizing the text of a @code{control}.
+ at item pixel-point
+This is a @ref{point} object specifying a pixel in an @ref{image}
+associated with a @code{control}, for the purpose of determining what
+color to use for transparency.
+ at item maximum-size
+This is a @ref{size} object that places a maximum constraint on the
+size that a @ref{layout-manager} may set for the @code{control}. It
+may be @sc{nil} if no such constraint has been set.
+ at item minimum-size
+This is a @ref{size} object that places a minimum constraint on the
+size that a @ref{layout-manager} may set for the @code{control}. It
+may be @sc{nil} if no such constraint has been set.
+ at item text-color
+If set, this color object is used as the @code{control}'s foreground text
+color when the @code{control} needs to be redrawn.
+ at end table
+ at deffn Initarg :callback
+This initarg associates a @sc{function} with an @ref{event-dispatcher}
+subclass that is generated behind the scenes and then instantiated to
+serve as the @code{control}'s event dispatcher. Each @code{control}
+subclass specifies the particular event function (e.g., @ref{event-select})
+that this callback will implement; see the documentation for specific
+ at code{control} subclasses for more information on this initarg.
+ at end deffn
@end deftp
@anchor{dialog}
@@ -281,13 +327,24 @@
@end deftp
@anchor{edit}
- at deftp Class edit
+ at deftp Class edit callback-event-name
This subclass of @ref{control} represents a rectangular area that
permits the user to enter and edit text. The @ref{event-focus-gain}
and @ref{event-focus-loss} methods of each @code{edit control}'s
@ref{event-dispatcher} are invoked when focus is given or taken
away. The @ref{event-modify} method is invoked when the user edits
content.
+ at table @var
+ at item callback-event-name
+This is an (@code{:allocation :class}) slot that holds a symbol
+identifying an event function (e.g., @ref{event-modify}). See
+ at ref{event-source} for more details on this slot.
+ at end table
+ at deffn Initarg :callback
+The @sc{function} value supplied via this initarg will be
+used as the implementation of @ref{event-modify} in an
+ at ref{event-dispatcher} configured for the @code{edit control}.
+ at end deffn
@deffn Initarg :style
@table @code
@item :auto-hscroll
@@ -346,15 +403,33 @@
behalf of @ref{widget}s. Applications define subclasses of
@code{event-dispatcher} and implement one or more of the @ref{event
functions} specializing on each such application-defined subclass in
-order to implement desired behavior.
+order to implement desired behavior. @xref{event-source}.
@end deftp
@anchor{event-source}
- at deftp Class event-source dispatcher
+ at deftp Class event-source callback-event-name dispatcher
This is the base class for user interface objects that generate
-events. It derives from @ref{native-object}. The @code{dispatcher}
-slot holds an instance of @ref{event-dispatcher} that is responsible
-for processing events on behalf of an @code{event-source}.
+events at footnote{Actually, events are generated by underlying
+native window objects, which are represented in the class hierarchy by
+the event-source class}. It derives from @ref{native-object}.
+ at table @var
+ at item callback-event-name
+This is an (@code{:allocation :class}) slot that holds a symbol
+identifying an event function (e.g., @ref{event-select}), to be
+supplied along with a function pointer in calls to the internal
+ at code{define-dispatcher} function. The purpose of this is to
+facilitate implementation of shortcuts for defining dispatchers where
+definition of a primary event function is sufficient, as is the case
+when a @ref{control} class wants to support a @code{:callback}
+initarg. The choice of event function is determined by each subclass,
+hence this slot is shadowed by each such subclass. Application code
+typically is not concerned with this slot, except when an application
+defines new kinds of event sources.
+ at item dispatcher
+This slot holds a reference to an instance of @ref{event-dispatcher},
+which has responsibility for handling events on behalf of the event
+source object.
+ at end table
@deffn Initarg :callbacks
The @code{:callbacks} initarg value specifies an association list
where the @code{CAR} of each entry is the symbol of an @code{event-*}
@@ -362,10 +437,6 @@
pointer. As such, this constitutes a specification for a new
@ref{event-dispatcher} class and associated methods.
@end deffn
- at deffn Initarg :dispatcher
- at end deffn
- at deffn Accessor dispatcher
- at end deffn
@end deftp
@anchor{file-dialog}
@@ -634,13 +705,13 @@
@end deftp
@deftp Class menu-item
-A subclass of @ref{item} representing a menu item.
+A subclass of @ref{item} representing a @ref{menu} item.
@end deftp
@anchor{panel}
@deftp Class panel
Base class for @ref{window}s that are children of @ref{top-level}
- at ref{window}s (or other panels).
+windows, @ref{dialog}s, or other @code{panel}s.
@end deftp
@anchor{root-window}
@@ -666,7 +737,7 @@
@end deftp
@anchor{timer}
- at deftp Class timer
+ at deftp Class timer id initial-delay delay
A timer is a non-windowed object that generates events at a regular
(adjustable) frequency. Applications handle timer events by
implementing the @ref{event-timer} generic function. This class
Modified: trunk/docs/manual/reference.texinfo
==============================================================================
--- trunk/docs/manual/reference.texinfo (original)
+++ trunk/docs/manual/reference.texinfo Sun Jul 9 16:38:15 2006
@@ -149,6 +149,8 @@
@end copying
@c %**end of header
+ at footnotestyle end
+
@titlepage
@title Graphic-Forms Programming Reference
@c @subtitle Version 0.5
Modified: trunk/src/uitoolkit/widgets/control.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/control.lisp (original)
+++ trunk/src/uitoolkit/widgets/control.lisp Sun Jul 9 16:38:15 2006
@@ -148,11 +148,11 @@
(defmethod give-focus ((self control))
(gfs::set-focus (gfs:handle self)))
-(defmethod initialize-instance :after ((self control) &key callback callbacks disp parent &allow-other-keys)
+(defmethod initialize-instance :after ((self control) &key callback callbacks dispatcher parent &allow-other-keys)
(if (gfs:disposed-p parent)
(error 'gfs:disposed-error))
- (unless (or disp callbacks (not (functionp callback)))
- (let ((class (define-dispatcher `((event-select . ,callback)))))
+ (unless (or dispatcher callbacks (not (functionp callback)))
+ (let ((class (define-dispatcher (class-name (class-of self)) callback)))
(setf (dispatcher self) (make-instance (class-name class))))))
(defmethod (setf maximum-size) :after (max-size (self control))
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 16:38:15 2006
@@ -35,6 +35,7 @@
(defconstant +callback-info+ '((gfw:event-activate . (gfw:event-source))
(gfw:event-arm . (gfw:event-source))
+ (gfw:event-modify . (gfw:event-source))
(gfw:event-select . (gfw:event-source))))
(defun make-specializer-list (disp-class arg-info)
@@ -42,10 +43,10 @@
(push disp-class tmp)
tmp))
-(defun define-dispatcher (callbacks)
- (let* ((*print-gensym* nil)
- (class (clos:ensure-class (gentemp "EDCLASS" :gfgen)
- :direct-superclasses '(event-dispatcher))))
+(defun define-dispatcher-for-callbacks (callbacks)
+ (let ((*print-gensym* nil)
+ (class (clos:ensure-class (gentemp "EDCLASS" :gfgen)
+ :direct-superclasses '(event-dispatcher))))
(loop for pair in callbacks
do (let* ((method-sym (car pair))
(fn (cdr pair))
@@ -65,13 +66,17 @@
:specializers (make-specializer-list class arg-info))))
class))
+(defun define-dispatcher (classname callback)
+ (let ((proto (c2mop:class-prototype (find-class classname))))
+ (define-dispatcher-for-callbacks `((,(callback-event-name-of proto) . ,callback)))))
+
;;;
;;; methods
;;;
-(defmethod initialize-instance :after ((self event-source) &key callbacks disp &allow-other-keys)
- (unless (or disp (null callbacks))
- (let ((class (define-dispatcher callbacks)))
+(defmethod initialize-instance :after ((self event-source) &key callbacks dispatcher &allow-other-keys)
+ (unless (or dispatcher (null callbacks))
+ (let ((class (define-dispatcher-for-callbacks callbacks)))
(setf (dispatcher self) (make-instance (class-name class))))))
(defmethod owner :before ((self event-source))
Modified: trunk/src/uitoolkit/widgets/menu-item.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/menu-item.lisp (original)
+++ trunk/src/uitoolkit/widgets/menu-item.lisp Sun Jul 9 16:38:15 2006
@@ -172,7 +172,7 @@
((null disp)
(setf item (make-instance 'menu-item :handle hmenu)))
((functionp disp)
- (setf item (make-instance 'menu-item :handle hmenu :callbacks `((gfw:event-select . ,disp)))))
+ (setf item (make-instance 'menu-item :handle hmenu :callback disp)))
((typep disp 'gfw:event-dispatcher)
(setf item (make-instance 'menu-item :handle hmenu :dispatcher disp)))
(t
@@ -220,6 +220,12 @@
gfs::+mfs-enabled+)
gfs::+mfs-enabled+))
+(defmethod initialize-instance :after ((self menu-item) &key callback &allow-other-keys)
+ (when callback
+ (unless (typep callback 'function)
+ (error 'gfs:toolkit-error :detail ":callback value must be a function"))
+ (setf (dispatcher self) (make-instance (define-dispatcher 'menu-item callback)))))
+
(defmethod owner ((it menu-item))
(let ((hmenu (gfs:handle it)))
(if (gfs:null-handle-p hmenu)
Modified: trunk/src/uitoolkit/widgets/menu-language.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/menu-language.lisp (original)
+++ trunk/src/uitoolkit/widgets/menu-language.lisp Sun Jul 9 16:38:15 2006
@@ -150,8 +150,8 @@
(if (null callback)
(error 'gfs:toolkit-error :detail "missing callback argument"))
(if sub
- (setf disp `(make-instance (define-dispatcher `((gfw:event-activate . ,,callback)))))
- (setf disp `(make-instance (define-dispatcher `((gfw:event-select . ,,callback)))))))
+ (setf disp `(make-instance (define-dispatcher 'gfw:menu ,callback)))
+ (setf disp `(make-instance (define-dispatcher 'gfw:menu-item ,callback)))))
(when disp
(if sep
(error 'gfs:toolkit-error :detail "dispatchers cannot be set for separators"))
Modified: trunk/src/uitoolkit/widgets/menu.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/menu.lisp (original)
+++ trunk/src/uitoolkit/widgets/menu.lisp Sun Jul 9 16:38:15 2006
@@ -131,7 +131,7 @@
(cond
((null disp))
((functionp disp)
- (let ((class (define-dispatcher `((event-activate . ,disp)))))
+ (let ((class (define-dispatcher 'gfw:menu disp)))
(setf (dispatcher submenu) (make-instance (class-name class)))))
((typep disp 'gfw:event-dispatcher)
(setf (dispatcher submenu) disp))
Modified: trunk/src/uitoolkit/widgets/widget-classes.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/widget-classes.lisp (original)
+++ trunk/src/uitoolkit/widgets/widget-classes.lisp Sun Jul 9 16:38:15 2006
@@ -72,14 +72,22 @@
((dispatcher
:accessor dispatcher
:initarg :dispatcher
- :initform (make-instance 'event-dispatcher)))
+ :initform (make-instance 'event-dispatcher))
+ (callback-event-name
+ :accessor callback-event-name-of
+ :initform nil
+ :allocation :class)) ; subclasses will shadow this slot
(:documentation "This is the base class for user interface objects that generate events."))
(defclass item (event-source)
((item-id
:accessor item-id
:initarg :item-id
- :initform 0))
+ :initform 0)
+ (callback-event-name
+ :accessor callback-event-name-of
+ :initform 'event-select
+ :allocation :class)) ; shadowing same slot from event-source
(:documentation "The item class is the base class for all non-windowed user interface objects."))
(defclass menu-item (item) ()
@@ -121,10 +129,18 @@
:initform nil))
(:documentation "The base class for widgets having pre-defined native behavior."))
-(defclass button (control) ()
+(defclass button (control)
+ ((callback-event-name
+ :accessor callback-event-name-of
+ :initform 'event-select
+ :allocation :class)) ; shadowing same slot from event-source
(:documentation "This class represents selectable controls that issue notifications when clicked."))
-(defclass edit (control) ()
+(defclass edit (control)
+ ((callback-event-name
+ :accessor callback-event-name-of
+ :initform 'event-modify
+ :allocation :class)) ; shadowing same slot from event-source
(:documentation "This class represents a control in which the user may enter and edit text."))
(defclass label (control) ()
@@ -146,7 +162,11 @@
:initform (make-array 7 :fill-pointer 0 :adjustable t)))
(:documentation "The widget-with-items class is the base class for objects composed of sub-items."))
-(defclass menu (widget-with-items) ()
+(defclass menu (widget-with-items)
+ ((callback-event-name
+ :accessor callback-event-name-of
+ :initform 'event-activate
+ :allocation :class)) ; shadowing same slot from event-source
(:documentation "The menu class represents a container for menu items (and submenus)."))
(defclass window (widget layout-managed)
More information about the Graphic-forms-cvs
mailing list