[slime-cvs] CVS slime

[CVS User trittweiler]

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

Modified Files:
	ChangeLog swank-ecl.lisp 
Log Message:
	* swank-ecl.lisp (source-location): Also return EXT::FOO as
	candidate to search through the TAGS file because SI and EXT both
	name the same package, and in ECL's code base, sometimes the
	former, sometimes the latter is used.


--- /project/slime/cvsroot/slime/ChangeLog	2010/03/11 09:05:50	1.2035
+++ /project/slime/cvsroot/slime/ChangeLog	2010/03/16 16:20:07	1.2036
@@ -1,3 +1,10 @@
+2010-03-16  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank-ecl.lisp (source-location): Also return EXT::FOO as
+	candidate to search through the TAGS file because SI and EXT both
+	name the same package, and in ECL's code base, sometimes the
+	former, sometimes the latter is used.
+
 2010-03-10  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* swank.lisp (signal-interrupt): Removed.
--- /project/slime/cvsroot/slime/swank-ecl.lisp	2010/03/11 09:02:29	1.63
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2010/03/16 16:20:08	1.64
@@ -178,7 +178,7 @@
            (fd-stream-alist
             (loop for s in streams
                   for fd = (socket-fd s)
-                  collect (cons (socket-fd s) s)
+                  collect (cons fd s)
                   do (serve-event:add-fd-handler fd :input
                                                  #'(lambda (fd)
                                                      (push fd active-fds))))))
@@ -589,6 +589,9 @@
     (error "No TAGS file ~A found. It should have been installed with ECL."
            +TAGS+)))
 
+(defun package-names (package)
+  (cons (package-name package) (package-nicknames package)))
+
 (defun source-location (object)
   (converting-errors-to-error-location
    (typecase object
@@ -600,13 +603,15 @@
         (multiple-value-bind (flag c-name) (si:mangle-name lisp-name t)
           (assert flag)
           ;; In ECL's code base sometimes the mangled name is used
-          ;; directly, sometimes ECL's DPP magic of @LISP::SYMBOL is used.
-          ;; We cannot predict here, so we just provide two candidates.
-          (let  ((package (package-name (symbol-package lisp-name)))
-                 (symbol  (symbol-name lisp-name)))
-            (make-TAGS-location c-name
-                                (format nil "~A::~A" package symbol)
-                                (format nil "~(~A::~A~)" package symbol))))))
+          ;; directly, sometimes ECL's DPP magic of @SI::SYMBOL or
+          ;; @EXT::SYMBOL is used. We cannot predict here, so we just
+          ;; provide several candidates.
+          (apply #'make-TAGS-location
+                 c-name
+                 (loop with s = (symbol-name lisp-name)
+                       for p in (package-names (symbol-package lisp-name))
+                       collect (format nil "~A::~A" p s)
+                       collect (format nil "~(~A::~A~)" p s))))))
      (function
       (multiple-value-bind (file pos) (ext:compiled-function-file object)
         (cond ((not file)