anchor.diff:    (subtypep (class-name super) 'container-child))
   
   
  +(defclass container-child ()
  +  ((parent :initarg :parent :type container)
  +   (child :initarg :child :type widget)))
  +
  +
  +;;;;
  +
  +(defbinding %container-query-child-args () arg
  +  (type-number type-number)
  +  (nil null)
  +  (n-args unsigned-int :out))
  +
  +(defun query-container-type-dependencies (type-number)
  +  (let ((child-slot-types ()))
  +    (multiple-value-bind (args n-args)
  +	(%container-query-child-args type-number)
  +      (dotimes (i n-args)
  +	(push (arg-type (arg-array-ref args i)) child-slot-types)))
  +    (delete-duplicates
  +     (append (query-object-type-dependencies type-number) child-slot-types))))
  +
  +(defun default-container-child-name (container-class)
  +  (intern (format nil "~A-CHILD" container-class)))
  +
  +(defun expand-container-type (type-number &optional slots)
  +  (let* ((class (type-from-number type-number))
  +	 (super (supertype type-number))
  +	 (child-class (default-container-child-name class))
  +	 (child-slots ()))
  +    (multiple-value-bind (args n-args)
  +	(%container-query-child-args type-number)
  +      (dotimes (i n-args)
  +	(let* ((arg (arg-array-ref args i))
  +	       (arg-name (arg-name arg))
  +	       (slot-name (default-slot-name
  +			    (subseq arg-name (+ (position #\: arg-name) 2))))
  +	       (type (type-from-number (arg-type arg) #|t|#)))
  +	  (push
  +	   `(,slot-name
  +	     :allocation :arg
  +	     :arg-name ,arg-name
  +	     :accessor ,(default-slot-accessor child-class slot-name type)
  +	     :initarg ,(intern (string slot-name) "KEYWORD")
  +	     :type ,type)
  +	   child-slots)))
  +      `(progn
  +	 ,(expand-gobject-type type-number slots)
  +	 (defclass ,child-class
  +	   (,(default-container-child-name super))
  +	   ,child-slots
  +	   (:metaclass child-class)
  +	   (:container ,class))))))
  +
  +(register-derivable-type
  + 'container "GtkContainer"
  + :query 'query-container-type-dependencies
  + :expand 'expand-container-type)
  
positive.code: ;; 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: gtkobject.lisp,v 1.8 2001-01-28 14:23:38 espen Exp $
  
  
  (in-package "GTK")
  
  
  ;;;; Initializing
  
  (setf (alien-type-name 'pointer) "gpointer")
  
  
  ;;;; Misc utils
  
  (defun name-to-string (name)
    (substitute #\_ #\- (string-downcase (string name))))
  
  (defun string-to-name (name &optional (package "KEYWORD"))
    (intern (substitute #\- #\_ (string-upcase name)) package))
  
  
  ;;; Argument stuff - to be removed soon
  
negative.code: (defconstant +arg-value-offset+ 8)
  (defconstant +arg-size+ 16)
  
  (defbinding arg-new () arg
    (type type-number))
  
  (defbinding %arg-free () nil
    (arg arg)
    (free-contents boolean))
  
  