summaryrefslogtreecommitdiff
path: root/Lisp
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-02-17 15:45:39 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-02-17 15:45:39 +0100
commit3dc931431a122de70b9c1d2d7b7bd7becfc46d7f (patch)
tree4479a7f9b1a85db77e857c848ae1339e2b6f2bc0 /Lisp
parentb5e4426cc60b55e0c38edfbf4757363a224cb4b7 (diff)
Minor cleanups.
darcs-hash:8202cbfdf90281074ec97355c948315e0151cf0b
Diffstat (limited to 'Lisp')
-rw-r--r--Lisp/class-definition.lisp15
-rw-r--r--Lisp/instance-management.lisp4
2 files changed, 10 insertions, 9 deletions
diff --git a/Lisp/class-definition.lisp b/Lisp/class-definition.lisp
index c09c7be..dcb27d5 100644
--- a/Lisp/class-definition.lisp
+++ b/Lisp/class-definition.lisp
@@ -193,13 +193,11 @@
(defmethod c2mop:slot-makunbound-using-class ((class objective-c-class)
instance
- effective-slot-definition)
+ (effective-slot-definition
+ foreign-effective-slot-definition))
(declare (ignore instance))
- (etypecase effective-slot-definition
- (c2mop:standard-effective-slot-definition (call-next-method))
- (foreign-effective-slot-definition
- (cerror "Continue without doing anything"
- "Tried to SLOT-MAKUNBOUND a foreign slot"))))
+ (cerror "Continue without doing anything"
+ "Tried to SLOT-MAKUNBOUND a foreign slot"))
(defmethod c2mop:compute-slots ((class objective-c-class))
@@ -258,8 +256,9 @@
(unless (eq (intern (symbol-name name) '#:objective-c-classes) name)
(setf (find-class name) class)
(setf (find-class (intern (symbol-name (class-name metaclass))))
- metaclass)
- class)))
+ metaclass))
+ (%objcl-class-set-backed-by-lisp-class new-class-pointer 1)
+ class))
(defmethod make-instance ((class objective-c-meta-class)
diff --git a/Lisp/instance-management.lisp b/Lisp/instance-management.lisp
index c8abb44..ab2e0bb 100644
--- a/Lisp/instance-management.lisp
+++ b/Lisp/instance-management.lisp
@@ -24,7 +24,9 @@
(let ((key (cffi:pointer-address pointer)))
(or (gethash key *lisp-managed-instances* nil)
(apply #'make-instance
- (intern-pointer-wrapper (%objcl-object-get-class pointer))
+ (intern-pointer-wrapper
+ 'class
+ :pointer (%objcl-object-get-class pointer))
initargs))))
(defun unintern-lisp-managed-foreign-instance (instance)