From 6ed4ce022d70e3b61fe955755de512d5def5eabc Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Tue, 5 Feb 2008 22:02:24 +0100 Subject: Minor cleanups. darcs-hash:6de1e4c4e8804d949fec6d5af4809fbf5a81ae69 --- Lisp/class-definition.lisp | 25 ++++++++++--------------- 1 file changed, 10 insertions(+), 15 deletions(-) (limited to 'Lisp/class-definition.lisp') diff --git a/Lisp/class-definition.lisp b/Lisp/class-definition.lisp index 130677f..d1a4a74 100644 --- a/Lisp/class-definition.lisp +++ b/Lisp/class-definition.lisp @@ -209,23 +209,18 @@ (defmethod initialize-instance :around ((class objective-c-class) &rest args - &key direct-slots - pointer + &key pointer &allow-other-keys) + ;; We scavenge the class and its superclasses for foreign slots and + ;; add them to our :DIRECT-SLOTS keyword argument. (let ((key-args (copy-list args))) - (dolist (objc-slot (objcl-class-direct-slots/pointer pointer)) - (let ((slot-name - (intern (string-upcase (objcl-slot-name objc-slot)) - (find-package '#:objective-c-classes)))) - (when (notany #'(lambda (slot-definition) - (eql slot-name (car slot-definition))) - direct-slots) - (push (list - :name slot-name - :foreign-name (objcl-slot-name objc-slot) - :foreign-type (parse-typespec - (objcl-slot-type objc-slot))) - (getf key-args :direct-slots))))) + (dolist (objc-slot (objcl-class-direct-slots/pointer pointer)) + (pushnew (list :name (intern (string-upcase (objcl-slot-name objc-slot)) + (find-package '#:objective-c-classes)) + :foreign-name (objcl-slot-name objc-slot) + :foreign-type (parse-typespec (objcl-slot-type objc-slot))) + (getf key-args :direct-slots) + :key #'(lambda (slotd) (getf slotd :name)))) (apply #'call-next-method class key-args))) -- cgit v1.2.3