+ ;(subtypep (class-name super) 'container-child)
+ t)
+
+
+(defclass container-child ()
+ ((parent :initarg :parent :type container)
+ (child :initarg :child :type widget)))
+
+
+;;;;
+
+(defbinding %container-class-list-child-properties () pointer
+ (class pointer)
+ (n-properties unsigned-int :out))
+
+(defun query-container-class-child-properties (type-number)
+ (let ((class (type-class-ref type-number)))
+ (multiple-value-bind (array length)
+ (%container-class-list-child-properties class)
+ (unwind-protect
+ (map-c-array 'list #'identity array 'param length)
+ (deallocate-memory array)))))
+
+(defun default-container-child-name (container-class)
+ (intern (format nil "~A-CHILD" container-class)))
+
+(defun expand-container-type (type &optional options)
+ (let* ((class (type-from-number type))
+ (super (supertype type))
+ (child-class (default-container-child-name class)))
+ `(progn
+ ,(expand-gobject-type type options)
+ (defclass ,child-class (,(default-container-child-name super))
+ ,(slot-definitions child-class
+ (query-container-class-child-properties type) nil)
+ (:metaclass child-class)
+ (:container ,class)))))