;; 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.2 2001-05-31 12:36:39 espen Exp $
+;; $Id: gdkevents.lisp,v 1.4 2004-10-31 11:53:30 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
((event-type :reader event-class-type)))
- (defmethod shared-initialize ((class event-class) names
- &rest initargs &key type)
- (declare (ignore initargs names))
+ (defmethod shared-initialize ((class event-class) names &key name type)
(call-next-method)
(setf (slot-value class 'event-type) (first type))
- (setf (gethash (first type) *event-classes*) class))
+ (setf (gethash (first type) *event-classes*) class)
+ (let ((class-name (or name (class-name class))))
+ (register-type class-name 'event)))
(defmethod validate-superclass