summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-02-03 22:36:06 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-02-03 22:36:06 +0100
commit046f4e6ecbe2cbef2079eb8a245895ff70238e92 (patch)
treed0a213d6f7bb3bf5c49f12cb467110d276a7db41
parentb7b5bd2d3ca7f3e339512582179e355d4df71293 (diff)
Automatically set Objective-C wrapper classes' superclasses.
darcs-hash:ef9a71b349ac03e3d80ed89c750f3dd82ad67630
-rw-r--r--Lisp/class-definition.lisp11
-rw-r--r--Lisp/libobjcl.lisp10
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))