From e49008a9a4b7d9a0ab7e31f2ff53ff4e497b8d0b Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Mon, 3 Mar 2008 17:46:03 +0100 Subject: Introduce function INTERN-CALLBACK-NAME. darcs-hash:5f2cb0e84fcace08fc832adaf3e48728fd76356c --- Lisp/method-definition.lisp | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) (limited to 'Lisp/method-definition.lisp') diff --git a/Lisp/method-definition.lisp b/Lisp/method-definition.lisp index b4ba605..a3ebaef 100644 --- a/Lisp/method-definition.lisp +++ b/Lisp/method-definition.lisp @@ -75,6 +75,20 @@ ,@body))))))) +(defvar *callback-names* (make-hash-table :test #'eql)) + +(defun intern-callback-name (method) + (or (gethash method *callback-names* nil) + (setf (gethash method *callback-names* nil) + (intern (format nil "~A (~A)" + (generic-function-name + (method-generic-function method)) + (sort (copy-list (method-qualifiers method)) + #'string< + :key #'string)) + '#:objective-cl)))) + + (defmethod add-method :after ((gf objective-c-generic-function) (method objective-c-method)) ;; FIXME: Support &REST arguments. @@ -90,7 +104,7 @@ (return-typestring (print-typespec-to-string return-type)) (arg-typestrings (mapcar #'print-typespec-to-string argument-types)) - (callback-name (gensym (selector-name method-name))) + (callback-name (intern-callback-name method)) (arg-symbols (mapcar #'(lambda (x) (declare (ignore x)) (gensym "ARG")) -- cgit v1.2.3