+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defclass ginterface-class (virtual-slots-class)
+ ()))
+
+(defmethod direct-slot-definition-class ((class ginterface-class) &rest initargs)
+ (case (getf initargs :allocation)
+ (:property (find-class 'direct-property-slot-definition))
+ (t (call-next-method))))
+
+(defmethod effective-slot-definition-class ((class ginterface-class) &rest initargs)
+ (case (getf initargs :allocation)
+ (:property (find-class 'effective-property-slot-definition))
+ (t (call-next-method))))
+
+(defmethod compute-effective-slot-definition-initargs ((class ginterface-class) direct-slotds)
+ (if (eq (most-specific-slot-value direct-slotds 'allocation) :property)
+ (nconc
+ (list :pname (signal-name-to-string
+ (most-specific-slot-value direct-slotds 'pname))
+ :readable (most-specific-slot-value direct-slotds 'readable)
+ :writable (most-specific-slot-value direct-slotds 'writable)
+ :construct (most-specific-slot-value direct-slotds 'construct))
+ (call-next-method))
+ (call-next-method)))
+
+
+(defmethod shared-initialize ((class ginterface-class) names &key name gtype)
+ (declare (ignore names))
+ (let ((class-name (or name (class-name class))))
+ (unless (find-type-number class-name)
+ (register-type class-name
+ (or (first gtype) (default-type-init-name class-name)))))
+ (call-next-method))