diff options
| -rw-r--r-- | Lisp/defpackage.lisp | 1 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 26 | ||||
| -rw-r--r-- | Lisp/method-definition.lisp | 6 | ||||
| -rw-r--r-- | Lisp/reader-syntax.lisp | 2 | ||||
| -rw-r--r-- | Objective-C/libobjcl.m | 48 |
5 files changed, 80 insertions, 3 deletions
diff --git a/Lisp/defpackage.lisp b/Lisp/defpackage.lisp index 3cacf12..da289ee 100644 --- a/Lisp/defpackage.lisp +++ b/Lisp/defpackage.lisp @@ -39,6 +39,7 @@ #:define-returns-boolean-exception #:undefine-returns-boolean-exception #:collect-classes + #:collect-methods ;; Generic functions #:objc-eql diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index d038c62..af8b66c 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -196,6 +196,13 @@ (defcfun ("objcl_test_foo" objcl-test-foo) :void) +(defcfun ("objcl_method_selector" %objcl-method-selector) :pointer + (method :pointer)) + +(defcfun ("objcl_class_methods" %objcl-class-methods) :pointer + (class :pointer) + (count-out :pointer)) + (defcvar *objcl-current-exception-lock* :pointer) (defcvar *objcl-current-exception* :pointer) @@ -920,6 +927,25 @@ separating parts by hyphens works nicely in all of the `:INVERT`, (not (zerop (%objcl-objc2-p)))) +;;;; (@* "Registry update and maintenance") +(defcallback collect-class-methods :void ((class :pointer)) + (flet ((collect-methods (class) + (with-foreign-object (count-buf :unsigned-int) + (let ((method-array (%objcl-class-methods class count-buf))) + (unwind-protect + (dotimes (i (mem-ref count-buf :unsigned-int)) + (intern-pointer-wrapper 'selector + :pointer + (%objcl-method-selector + (mem-aref method-array :void i)))) + (foreign-free method-array)))))) + (collect-methods class) + (collect-methods (%objcl-class-metaclass class)))) + +(defun collect-methods () + (%objcl-for-each-class-do (callback collect-class-methods))) + + ;;;; (@* "Slot access") (defun objcl-slot-type (slot) (%objcl-slot-type slot)) diff --git a/Lisp/method-definition.lisp b/Lisp/method-definition.lisp index 41f1f84..cbfc344 100644 --- a/Lisp/method-definition.lisp +++ b/Lisp/method-definition.lisp @@ -69,7 +69,8 @@ else collect :id into type-specifiers finally (return - `(defmethod ,name + `(defmethod ,(intern (symbol-name name) + '#:objective-c-methods) argtypes-start ,@type-specifiers argtypes-end ,@qualifiers ,lambda-list ,@body))))))) @@ -80,7 +81,8 @@ (defmacro define-objective-c-generic-function (name lambda-list &body options) - `(defgeneric ,name ,lambda-list + `(defgeneric ,(intern (symbol-name name) '#:objective-c-methods) + ,lambda-list ,@(unless (position :generic-function-class options :key #'car) diff --git a/Lisp/reader-syntax.lisp b/Lisp/reader-syntax.lisp index 9f0bcb7..ddf9edc 100644 --- a/Lisp/reader-syntax.lisp +++ b/Lisp/reader-syntax.lisp @@ -78,7 +78,7 @@ Method __selector__s have to be interned prior to use. As this reader macro is not capable of interning new __selector__s, you have to ensure that __intern-selector__ is called before the respective __selector__ is used. This is not a problem for __selector__s known at load-time nor for -__selector__s registered by way of __collect-selectors__. +__selector__s registered by way of __collect-methods__. ## See also: diff --git a/Objective-C/libobjcl.m b/Objective-C/libobjcl.m index d32a37c..0b1719f 100644 --- a/Objective-C/libobjcl.m +++ b/Objective-C/libobjcl.m @@ -1053,6 +1053,54 @@ objcl_for_each_class_do (void (*function) (Class)) } +void ** +objcl_class_methods (Class class, unsigned int *count) +{ +#ifdef __NEXT_RUNTIME__ + return (void **) class_copyMethodList (class, count); +#else + size_t buflen = 0; + void **buf = NULL; + MethodList_t list = class->methods; + + *count = 0; + + while (list) + { + int i; + unsigned int position = *count; + *count += list->method_count; + + if (buflen < *count) + { + buflen = *count; + buf = realloc (buf, buflen * sizeof (void *)); + } + + for (i = 0; i < list->method_count; i++) + { + buf[position + i] = &list->method_list[i]; + } + + list = list->method_next; + } + + return buf; +#endif +} + + +SEL +objcl_method_selector (void *method) +{ +#ifdef __NEXT_RUNTIME__ + return method_getName ((Method) method); +#else + return ((Method_t) method)->method_name; +#endif +} + + /* The function objcl_test_foo is a general-purpose debugging tool that can be adapted as needed. */ @interface MLKTestStringHelper |