[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog swank-abcl.lisp 
Log Message:
* swank-abcl.lisp (handle-compiler-warning): Report source
location position when we can.
Use NAMESTRING for *compile-filename*.

--- /project/slime/cvsroot/slime/ChangeLog	2008/10/19 20:03:12	1.1564
+++ /project/slime/cvsroot/slime/ChangeLog	2008/10/19 20:03:21	1.1565
@@ -1,3 +1,9 @@
+2008-10-19  Mark Evenson <evenson at panix.com>
+
+	* swank-abcl.lisp (handle-compiler-warning): Report source
+	location position when we can.
+	Use NAMESTRING for *compile-filename*.
+
 2008-10-19  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-clisp.lisp (filename-to-pathname, parse-cygwin-filename):
--- /project/slime/cvsroot/slime/swank-abcl.lisp	2008/10/17 21:26:53	1.58
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2008/10/19 20:03:22	1.59
@@ -127,7 +127,6 @@
 (defimplementation local-port (socket)
   (java:jcall (java:jmethod "java.net.ServerSocket" "getLocalPort") socket))
 
-
 (defimplementation close-socket (socket)
   (ext:server-socket-close socket))
 
@@ -263,7 +262,6 @@
 (defimplementation frame-locals (index)
   `(,(list :name "??" :id 0 :value "??")))
 
-
 (defimplementation frame-catch-tags (index)
   (declare (ignore index))
   nil)
@@ -306,8 +304,11 @@
 (in-package :swank-backend)
 
 (defun handle-compiler-warning (condition)
-  (let ((loc nil));(getf (slot-value condition 'excl::plist) :loc)))
-    (unless (member condition *abcl-signaled-conditions*) ; filter condition signaled more than once.
+  (let ((loc (when (and jvm::*compile-file-pathname* 
+                        system::*source-position*)
+               (cons jvm::*compile-file-pathname* system::*source-position*))))
+    ;; filter condition signaled more than once.
+    (unless (member condition *abcl-signaled-conditions*) 
       (push condition *abcl-signaled-conditions*) 
       (signal (make-condition
                'compiler-condition
@@ -325,7 +326,7 @@
                                    (list :position (1+ pos)))))
                                (t  
                                 (make-location
-                                 (list :file *compile-filename*)
+                                 (list :file (namestring *compile-filename*))
                                  (list :position 1)))))))))
 
 (defvar *abcl-signaled-conditions*)