From 5cd4ba9e9cd3c64dffbbef3b154511eee704ceb0 Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Sun, 3 Feb 2008 00:18:51 +0100
Subject: Use Objective-C metaclasses as CLOS metaclasses.

darcs-hash:dd0a1476e5412105a56b7c7de18f7d14f7af2696
---
 Lisp/class-definition.lisp | 7 ++++++-
 Lisp/data-types.lisp       | 2 +-
 Lisp/libobjcl.lisp         | 7 +++++--
 3 files changed, 12 insertions(+), 4 deletions(-)

diff --git a/Lisp/class-definition.lisp b/Lisp/class-definition.lisp
index 049d521..45e6956 100644
--- a/Lisp/class-definition.lisp
+++ b/Lisp/class-definition.lisp
@@ -40,6 +40,11 @@
   ())
 
 
+(defmethod c2mop:validate-superclass ((class objective-c-meta-class)
+                                      (superclass standard-class))
+  t)
+
+
 (defmethod c2mop:direct-slot-definition-class ((class objective-c-class)
                                          &rest initargs)
   (if (some #'(lambda (symbol) (let ((nada '#:nada))
@@ -160,5 +165,5 @@
    (nothing :accessor ns-string-nothing
             :initarg :ns-string
             :initform 100))
-  (:metaclass objective-c-class)
+  (:metaclass objective-c-classes::%ns-string)
   (:wrapped-foreign-class "NSString"))
diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp
index 6c696f4..0b5865d 100644
--- a/Lisp/data-types.lisp
+++ b/Lisp/data-types.lisp
@@ -93,7 +93,7 @@ a suitable class method instead as you would in Objective-C.
   ())
 
 
-(defclass objective-c-meta-class (standard-class c-pointer-wrapper)
+(defclass objective-c-meta-class (objective-c-class)
   ())
 
 
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index 40c41ec..16a300f 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -233,7 +233,9 @@ conventional case for namespace identifiers in Objective-C."
         (let ((class-name (objc-class-name->symbol class-name-string)))
           (or (find-class class-name nil)
               (c2mop:ensure-class class-name
-                                  :metaclass 'objective-c-class
+                                  :metaclass (class-name
+                                              (find-objc-meta-class
+                                               class-name-string))
                                   :pointer class-ptr
                                   :wrapped-foreign-class class-name-string))))))
 
@@ -258,7 +260,8 @@ conventional case for namespace identifiers in Objective-C."
           (or (find-class class-name nil)
               (c2mop:ensure-class class-name
                                   :metaclass 'objective-c-meta-class
-                                  :pointer class-ptr))))))
+                                  :pointer class-ptr
+                                  :direct-superclasses '(objective-c-class)))))))
 
 
 (defun objc-pointer-null (pointer)
-- 
cgit v1.2.3