[slime-cvs] CVS update: slime/swank-lispworks.lisp

[Helmut Eller]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv31807

Modified Files:
	swank-lispworks.lisp 
Log Message:
(make-dspec-location): Handle logical pathnames.
Date: Fri Nov 28 09:28:18 2003
Author: heller

Index: slime/swank-lispworks.lisp
diff -u slime/swank-lispworks.lisp:1.1 slime/swank-lispworks.lisp:1.2
--- slime/swank-lispworks.lisp:1.1	Wed Nov 26 19:36:36 2003
+++ slime/swank-lispworks.lisp	Fri Nov 28 09:28:17 2003
@@ -7,7 +7,7 @@
 ;;; This code has been placed in the Public Domain.  All warranties
 ;;; are disclaimed.
 ;;;
-;;;   $Id: swank-lispworks.lisp,v 1.1 2003/11/27 00:36:36 heller Exp $
+;;;   $Id: swank-lispworks.lisp,v 1.2 2003/11/28 14:28:17 heller Exp $
 ;;;
 
 (in-package :swank)
@@ -296,9 +296,12 @@
     (delete-file filename)))
 
 (defun make-dspec-location (dspec filename &optional tmpfile buffer position)
-  (list :dspec (cond ((and tmpfile (pathname-match-p filename tmpfile))
-		      (list :buffer buffer position))
-		     (t (list :file (namestring filename))))
+  (list :dspec 
+        (cond ((and tmpfile (pathname-match-p filename tmpfile))
+               (list :buffer buffer position))
+              (t 
+               (let ((name (namestring (translate-logical-pathname filename))))
+                 (list :file name))))
 	(string (etypecase dspec
 		  (symbol dspec)
 		  (cons (dspec:dspec-primary-name dspec))))))
@@ -321,7 +324,7 @@
 		(make-dspec-location dspec filename tmpfile buffer position)
 		nil)))
 	   htab))
-  
+
 (defmethod compile-string-for-emacs (string &key buffer position)
   (assert buffer)
   (assert position)
@@ -330,8 +333,9 @@
 	(tmpname (hcl:make-temp-file nil "lisp")))
     (with-compilation-unit ()
       (compile-from-temp-file string tmpname)
+      (format t "~A~%" compiler:*messages*)
       (signal-error-data-base
        compiler::*error-database* tmpname buffer position)
       (signal-undefined-functions compiler::*unknown-functions*
-				  tmpname tmpname buffer position))))
+                                  tmpname tmpname buffer position))))