Automatically set Objective-C wrapper classes' superclasses.

darcs-hash:ef9a71b349ac03e3d80ed89c750f3dd82ad67630

2 files changed, 18 insertions, 3 deletions

diff --git a/Lisp/class-definition.lisp b/Lisp/class-definition.lisp
index ffeca02..e331d83 100644
--- a/Lisp/class-definition.lisp
+++ b/Lisp/class-definition.lisp
@@ -116,6 +116,17 @@
   (let ((class (call-next-method)))
     class))
 
+#+(or)
+(defmethod c2mop:class-direct-superclasses ((class objective-c-class))
+  (list (objcl-class-superclass class)))
+
+
+#+(or)
+(defmethod shared-initialize :after ((class objective-c-class)
+                                     slot-names
+                                     &rest initargs)
+  )
+
 (defmethod initialize-instance ((class objective-c-class)
                                 &key documentation
                                      name
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index 93ecaef..c973828 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -240,7 +240,8 @@ conventional case for namespace identifiers in Objective-C."
                                               (find-objc-meta-class
                                                class-name-string))
                                   :pointer class-ptr
-                                  :wrapped-foreign-class class-name-string))))))
+                                  :wrapped-foreign-class class-name-string
+                                  :direct-superclasses (list (objcl-class-superclass/pointer class-ptr))))))))
 
 
 (defun find-objc-meta-class (meta-class-name &optional errorp)
@@ -580,12 +581,15 @@ separating parts by hyphens works nicely in all of the `:INVERT`,
   (find-objc-meta-class-by-name
    (%objcl-class-name (%objcl-object-get-class (pointer-to obj)))))
 
-(defun objcl-class-superclass (class)
-  (let ((superclass-ptr (%objcl-class-superclass (pointer-to class))))
+(defun objcl-class-superclass/pointer (class-ptr)
+  (let ((superclass-ptr (%objcl-class-superclass class-ptr)))
     (if (and superclass-ptr (%objcl-object-is-class superclass-ptr))
         (make-pointer-wrapper t :pointer superclass-ptr)
         nil)))
 
+(defun objcl-class-superclass (class)
+  (objcl-class-superclass/pointer (pointer-to class)))
+
 (defun objc-class-of (obj)
   (cond ((object-is-meta-class-p obj)
          (error "Tried to get the class of meta class ~S." obj))