From d907d3d250c9a0f43b3497dcf5fa354be4ffc83f Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Wed, 5 Mar 2008 02:13:26 +0100
Subject: Add function COLLECT-METHODS.

darcs-hash:4c78479b2d67157304f041d700fceb34a3ed7721
---
 Lisp/defpackage.lisp        |  1 +
 Lisp/libobjcl.lisp          | 26 ++++++++++++++++++++++++
 Lisp/method-definition.lisp |  6 ++++--
 Lisp/reader-syntax.lisp     |  2 +-
 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
-- 
cgit v1.2.3