From 620a94200d9d7a33e41afd77c275599feb259ebd Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Sun, 17 Feb 2008 11:20:27 +0100 Subject: Implement FOREIGN-CLASS-ENSURE-REGISTERED. darcs-hash:cc3448394e3e337be716275c3e4016a542860fd1 --- Lisp/class-definition.lisp | 61 ++++++---------------------------------------- 1 file changed, 7 insertions(+), 54 deletions(-) (limited to 'Lisp/class-definition.lisp') diff --git a/Lisp/class-definition.lisp b/Lisp/class-definition.lisp index 28e97dd..61648a6 100644 --- a/Lisp/class-definition.lisp +++ b/Lisp/class-definition.lisp @@ -217,7 +217,7 @@ (let ((key-args (copy-list args))) (cond ((or (null pointer) (null-pointer-p pointer)) - (setf (slot-value class 'registered-p) nil) + (setf (foreign-class-registered-p class) nil) (let* ((ivars (remove-if-not #'(lambda (c) (typep c 'foreign-direct-slot-definition)) direct-slots)) @@ -238,7 +238,7 @@ ivars)))) (setf (getf key-args :pointer) new-class-pointer))) (t - (setf (slot-value class 'registered-p) t) + (setf (foreign-class-registered-p class) t) ;; We scavenge the class and its superclasses for foreign slots and ;; add them to our :DIRECT-SLOTS keyword argument. (dolist (objc-slot (objcl-class-direct-slots/pointer pointer)) @@ -250,56 +250,6 @@ :key #'(lambda (slotd) (getf slotd :name)))))) (apply #'call-next-method class key-args))) -(defmethod initialize-instance ((class objective-c-class) - &key documentation - name - plist - direct-superclasses - direct-slots - direct-default-initargs - pointer - wrapped-foreign-class) - (declare (ignore documentation name plist direct-superclasses direct-slots - direct-default-initargs pointer wrapped-foreign-class)) - (call-next-method)) - -(defmethod reinitialize-instance ((class objective-c-class) - &key documentation - name - plist - direct-superclasses - direct-slots - direct-default-initargs - pointer - wrapped-foreign-class) - (declare (ignore documentation name plist direct-superclasses direct-slots - direct-default-initargs pointer wrapped-foreign-class)) - (call-next-method)) - -(defmethod initialize-instance ((class objective-c-meta-class) - &key documentation - name - plist - direct-superclasses - direct-slots - direct-default-initargs - pointer) - (declare (ignore documentation name plist direct-superclasses direct-slots - direct-default-initargs pointer)) - (call-next-method)) - -(defmethod reinitialize-instance ((class objective-c-meta-class) - &key documentation - name - plist - direct-superclasses - direct-slots - direct-default-initargs - pointer) - (declare (ignore documentation name plist direct-superclasses direct-slots - direct-default-initargs pointer)) - (call-next-method)) - (defmethod make-instance :before ((class objective-c-class) &key @@ -308,8 +258,11 @@ (defun foreign-class-ensure-registered (class) - ;; FIXME - ) + (with-exclusive-access (class) + (unless (foreign-class-registered-p class) + (setf (foreign-class-registered-p class) t) + (%objcl-finalise-class (pointer-to class)))) + class) ;;;; (@* "Quick tests") -- cgit v1.2.3