anchor.diff:  ;; 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.5 2004-11-06 21:39:58 espen Exp $
  +;; $Id: gdkevents.lisp,v 1.6 2004-12-20 00:09:57 espen Exp $
   
   (in-package "GDK")
   
   
   (defvar *event-classes* (make-hash-table))
  +
  +
  +;;;; Metaclass for event classes
  +
  +(eval-when (:compile-toplevel :load-toplevel :execute)
  +  (defclass event-class (boxed-class)
  +    ((event-type :reader event-class-type)))
  +
  +  (defmethod validate-superclass ((class event-class) (super standard-class))
  +    ;(subtypep (class-name super) 'event)
  +    t))
  +
  +
  +(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)
  +  (let ((class-name (or name (class-name class))))
  +    (register-type class-name 'event)))
  +  
  +(let ((reader (reader-function 'event-type)))
  +  (defun %event-class (location)
  +    (gethash (funcall reader location 0) *event-classes*)))
  +
  +(defmethod ensure-proxy-instance ((class event-class) location)
  +  (declare (ignore class))
  +  (let ((class (%event-class location)))
  +    (make-instance class :location location)))
  +
  +
  +;;;;
   
   (eval-when (:compile-toplevel :load-toplevel :execute)
     (defclass event (boxed)
  
positive.code:   (:metaclass event-class)
    (:type :3button-press))
  
  (defclass button-release-event (button-press-event)
    ()
    (:metaclass event-class)
    (:type :button-release))
  
  (defclass key-press-event (event)
    ()
    (:metaclass event-class)
    (:type :key-press))
  
  (defclass key-release-event (event)
    ()
    (:metaclass event-class)
    (:type :key-release))
  
  (defclass enter-notify-event (event)
    ()
    (:metaclass event-class)
    (:type :enter-notify))
  
  (defclass leave-notify-event (event)
    ()
    (:metaclass event-class)
    (:type :leave-notify))
  
  (defclass focus-change-event (event)
    ()
    (:metaclass event-class)
    (:type :focus-change))
  
  
negative.code:   (:metaclass event-class)
    (:type :motion-notify))
    
  (defclass button-event (input-event)
    ((button
      :allocation :alien
      :accessor event-button
      :initarg :button
  