[slime-cvs] CVS slime

[nsiivola]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv1914

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
Make M-. work better with hotpatched SBCL sources.

--- /project/slime/cvsroot/slime/ChangeLog	2007/03/29 17:08:47	1.1087
+++ /project/slime/cvsroot/slime/ChangeLog	2007/03/29 17:12:38	1.1088
@@ -1,5 +1,13 @@
 2007-03-29  Nikodemus Siivola <nikodemus at random-state.net>
 
+	* swank-sbcl.lisp (swank-compile-string): save the original
+	directory into the source plist as :emacs-directory.
+	(make-definition-source-location): use the :emacs-directory from
+	the source plist and guess-readtable-for-filename to determine the
+	correct readtable for string-compiled definitions.
+
+2007-03-29  Nikodemus Siivola <nikodemus at random-state.net>
+
 	* swank.lisp (*macroexpand-printer-bindings*): add *print-lines*
 	to defaults (NIL).
 	(find-definitions-for-emacs): use unless instead of cond.
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2007/01/10 23:53:47	1.175
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2007/03/29 17:12:38	1.176
@@ -416,7 +416,6 @@
   (concatenate 'string (tmpnam nil) ".lisp"))
 
 (defimplementation swank-compile-string (string &key buffer position directory)
-  (declare (ignore directory))
   (let ((*buffer-name* buffer)
         (*buffer-offset* position)
         (*buffer-substring* string)
@@ -425,6 +424,7 @@
              (with-compilation-hooks ()
                (with-compilation-unit
                    (:source-plist (list :emacs-buffer buffer
+                                        :emacs-directory directory
                                         :emacs-string string
                                         :emacs-position position))
                  (funcall fn (compile-file filename))))))
@@ -480,22 +480,23 @@
                (sb-introspect::definition-source-description source-location))
         (if *debug-definition-finding*
             (make-definition-source-location source-location type name)
-            (handler-case (make-definition-source-location source-location
-                                                           type name)
+            (handler-case
+                (make-definition-source-location source-location type name)
               (error (e)
-                     (list :error (format nil "Error: ~A" e)))))))
+                (list :error (format nil "Error: ~A" e)))))))
 
 (defun make-definition-source-location (definition-source type name)
   (with-struct (sb-introspect::definition-source-
                    pathname form-path character-offset plist
                    file-write-date)
       definition-source
-    (destructuring-bind (&key emacs-buffer emacs-position
+    (destructuring-bind (&key emacs-buffer emacs-position emacs-directory
                               emacs-string &allow-other-keys)
         plist
       (cond
         (emacs-buffer
-         (let* ((pos (if form-path
+         (let* ((*readtable* (guess-readtable-for-filename emacs-directory))
+                (pos (if form-path
                          (with-debootstrapping
                            (source-path-string-position form-path emacs-string))
                          character-offset))