[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog swank-openmcl.lisp 
Log Message:
* swank-openmcl.lisp (swank-compile-string, compile-temp-file): Use
new parameters to compile-file to adjust source locations.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/29 11:51:45	1.1608
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/29 19:03:20	1.1609
@@ -2,6 +2,8 @@
 
 	* swank-openmcl.lisp (find-definitions, source-locations): Use
 	ccl:find-definition-sources.
+	(swank-compile-string, compile-temp-file): Use new parameters to
+	compile-file to adjust source locations.
 
 2008-12-28  Helmut Eller  <heller at common-lisp.net>
 
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/12/29 11:51:45	1.147
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/12/29 19:03:20	1.148
@@ -369,8 +369,8 @@
    :test 'equal))
 
 (defimplementation swank-compile-string (string &key buffer position directory
-                                                debug)
-  (declare (ignore directory debug))
+                                         debug)
+  (declare (ignore debug))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-offset* position)
@@ -378,10 +378,22 @@
       (unwind-protect
            (with-open-file (s filename :direction :output :if-exists :error)
              (write-string string s))
-        (let ((binary-filename (compile-file filename :load t)))
+        (let ((binary-filename (compile-temp-file
+                                filename
+                                (if directory
+                                    (format nil "~a/~a" directory buffer))
+                                (1- position))))
           (delete-file binary-filename)))
       (delete-file filename))))
 
+(defun compile-temp-file (filename orig-file orig-offset)
+  (if (fboundp 'ccl::function-source-note)
+      (compile-file filename
+                    :load t
+                    :compile-file-original-truename orig-file
+                    :compile-file-original-buffer-offset orig-offset)
+      (compile-file filename :load t)))
+
 ;;; Profiling (alanr: lifted from swank-clisp)
 
 (defimplementation profile (fname)