[slime-cvs] CVS slime

[CVS User heller]

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv25043

Modified Files:
	ChangeLog swank-openmcl.lisp 
Log Message:
* swank-openmcl.lisp (who-specializes): Simplify.

--- /project/slime/cvsroot/slime/ChangeLog	2009/05/17 13:00:24	1.1762
+++ /project/slime/cvsroot/slime/ChangeLog	2009/05/17 14:21:55	1.1763
@@ -9,6 +9,7 @@
 	src-locs than ccl::callers.
 	(canonicalize-location, remove-filename-quoting)
 	(maybe-method-location): Deleted.  No longer used.
+	(who-specializes): Simplify.
 
 2009-05-17  Helmut Eller  <heller at common-lisp.net>
 
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/05/17 13:00:24	1.168
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/05/17 14:21:55	1.169
@@ -170,23 +170,19 @@
 
 (defimplementation accept-connection (socket &key external-format
                                              buffering timeout)
-  (declare (ignore buffering timeout
-                   #-openmcl-unicode-strings external-format))
-  #+openmcl-unicode-strings
+  (declare (ignore buffering timeout))
   (when external-format
     (let ((keys (ccl::socket-keys socket)))
       (setf (getf keys :external-format) external-format
             (slot-value socket 'ccl::keys) keys)))
   (ccl:accept-connection socket :wait t))
 
-#+openmcl-unicode-strings
 (defvar *external-format-to-coding-system*
   '((:iso-8859-1 
      "latin-1" "latin-1-unix" "iso-latin-1-unix" 
      "iso-8859-1" "iso-8859-1-unix")
     (:utf-8 "utf-8" "utf-8-unix")))
 
-#+openmcl-unicode-strings
 (defimplementation find-external-format (coding-system)
   (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
                   *external-format-to-coding-system*)))
@@ -324,20 +320,10 @@
    :test 'equal))
 
 (defimplementation who-specializes (class)
-  (if (symbolp class) (setq class (find-class class)))
-  (remove-duplicates
-   (append (mapcar (lambda(m)
-                     (let ((location (function-source-location (ccl::method-function m))))
-                       (if (eq (car location) :error)
-                           (setq location nil ))
-                       `((method ,(ccl::method-name m)
-                                 ,(mapcar #'specializer-name (ccl::method-specializers m))
-                                 ,@(ccl::method-qualifiers m))
-                         ,location)))
-                   (ccl::%class.direct-methods class))
-           (mapcan 'who-specializes (ccl::%class-direct-subclasses class)))
-   :test 'equal))
-
+  (mapcar (lambda (m)
+            (destructuring-bind ((loc . name)) (source-locations m)
+              (list name loc)))
+          (ccl::%class.direct-methods (find-class class))))
 
 (defimplementation list-callees (name)
   (remove-duplicates