;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-;; $Id: gdkevents.lisp,v 1.1 2001-05-11 16:20:20 espen Exp $
+;; $Id: gdkevents.lisp,v 1.3 2001-10-21 23:02:40 espen Exp $
(in-package "GDK")
(defmethod initialize-instance ((event event) &rest initargs)
(declare (ignore initargs))
- (with-slots (location %type) event
- (setf location (%event-new))
- (setf %type (event-class-type (class-of event))))
- (call-next-method))
+ (call-next-method)
+ (setf (slot-value event '%type) (event-class-type (class-of event))))
(deftype-method translate-from-alien
event (type-spec location &optional weak-ref)
(unless (null-pointer-p location)
(ensure-proxy-instance (%type-of-event location) location ,weak-ref))))
-(defbinding %event-new () pointer)
-
;;;; Metaclass for event classes
(eval-when (:compile-toplevel :load-toplevel :execute)
(defclass event-class (proxy-class)
- ((event-type :reader event-class-type))))
-
-
-(defmethod shared-initialize ((class event-class) names
- &rest initargs &key type)
- (declare (ignore initargs names))
- (call-next-method)
- (setf (slot-value class 'event-type) (first type))
- (setf (gethash (first type) *event-classes*) class))
+ ((event-type :reader event-class-type)))
+
+ (defmethod shared-initialize ((class event-class) names
+ &rest initargs &key type)
+ (declare (ignore initargs names))
+ (call-next-method)
+ (setf (slot-value class 'event-type) (first type))
+ (setf (gethash (first type) *event-classes*) class))
+
-(defmethod validate-superclass
- ((class event-class) (super pcl::standard-class))
- (subtypep (class-name super) 'event))
+ (defmethod validate-superclass
+ ((class event-class) (super pcl::standard-class))
+ (subtypep (class-name super) 'event)))
;;;;