Improvement of GObject class mapping:

if class specifies a NIL g-type-name then this class maps to an instance of GObject class that is mapped to by its superclass

diff --git a/glib/gobject.meta.lisp b/glib/gobject.meta.lisp
index e4fc5e3..086a5ac 100644 (file)
--- a/glib/gobject.meta.lisp
+++ b/glib/gobject.meta.lisp
@@ -1,9 +1,9 @@
 (in-package :gobject)
 
 (defclass gobject-class (standard-class)
-  ((g-type-name :initform (error "G-TYPE-NAME must be specified")
+  ((g-type-name :initform nil
                 :initarg :g-type-name
-                :reader gobject-class-g-type-name)
+                :accessor gobject-class-g-type-name)
    (g-type-initializer :initform nil
                        :initarg :g-type-initializer
                        :reader gobject-class-g-type-initializer)
@@ -36,9 +36,18 @@
               (gobject-class-g-type-name class) (class-name class)))))
 
 (defmethod initialize-instance :after ((object gobject-class) &key &allow-other-keys)
-  (register-object-type (gobject-class-g-type-name object) (class-name object))
+  (when (gobject-class-g-type-name object)
+    (register-object-type (gobject-class-g-type-name object) (class-name object)))
   (at-init (object) (initialize-gobject-class-g-type object)))
 
+(defmethod finalize-inheritance :after ((class gobject-class))
+  (unless (gobject-class-g-type-name class)
+    (let ((gobject-superclass (iter (for superclass in (class-direct-superclasses class))
+                                    (finding superclass such-that (typep superclass 'gobject-class)))))
+      (assert gobject-superclass)
+      (setf (gobject-class-g-type-name class)
+            (gobject-class-g-type-name gobject-superclass)))))
+
 (defclass gobject-direct-slot-definition (standard-direct-slot-definition)
   ((g-property-type :initform nil
                     :initarg :g-property-type
@@ -82,9 +91,6 @@
 (defmethod validate-superclass ((class gobject-class) (superclass standard-class))
   t)
 
-(defmethod validate-superclass ((class standard-class) (superclass gobject-class))
-  t)
-
 (defmethod compute-class-precedence-list ((class gobject-class))
   (let ((classes (call-next-method)))
     (if (member (find-class 'g-object) classes)