[slime-cvs] CVS slime

[CVS User nsiivola]

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

Modified Files:
	swank-sbcl.lisp 
Log Message:
sbcl: get compilation notes for recursive entry to compilation right

  When C-c C-c'ing eg. an (EVAL-WHEN ... (REQUIRE :FOO)) form,
  previously we tried to find the position for the note from
  the tempfile.


--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2011/06/09 17:48:47	1.281
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2011/06/14 14:00:37	1.282
@@ -410,6 +410,7 @@
 
 
 (defvar *buffer-name* nil)
+(defvar *buffer-tmpfile* nil)
 (defvar *buffer-offset*)
 (defvar *buffer-substring* nil)
 
@@ -492,11 +493,15 @@
 (defun compiling-from-buffer-p (filename)
   (and *buffer-name*
        ;; The following is to trigger COMPILING-FROM-GENERATED-CODE-P
-       ;; in LOCATE-COMPILER-NOTE.
-       (not (eq filename :lisp))))
+       ;; in LOCATE-COMPILER-NOTE, and allows handling nested
+       ;; compilation from eg. hitting C-C on (eval-when ... (require ..))).
+       (pathnamep filename)
+       (string= (namestring filename) *buffer-tmpfile*)))
 
 (defun compiling-from-file-p (filename)
-  (and (pathnamep filename) (null *buffer-name*)))
+  (and (pathnamep filename)
+       (or (null *buffer-name*)
+           (string/= (namestring filename) *buffer-tmpfile*))))
 
 (defun compiling-from-generated-code-p (filename source)
   (and (eq filename :lisp) (stringp source)))
@@ -629,7 +634,7 @@
   (let ((*buffer-name* buffer)
         (*buffer-offset* position)
         (*buffer-substring* string)
-        (temp-file-name (temp-file-name)))
+        (*buffer-tmpfile* (temp-file-name)))
     (flet ((load-it (filename)
              (when filename (load filename)))
            (compile-it (cont)
@@ -642,11 +647,11 @@
                     :source-namestring filename
                     :allow-other-keys t)
                  (multiple-value-bind (output-file warningsp failurep)
-                     (compile-file temp-file-name)
+                     (compile-file *buffer-tmpfile*)
                    (declare (ignore warningsp))
                    (unless failurep
                      (funcall cont output-file)))))))
-      (with-open-file (s temp-file-name :direction :output :if-exists :error)
+      (with-open-file (s *buffer-tmpfile* :direction :output :if-exists :error)
         (write-string string s))
       (unwind-protect
            (with-compiler-policy policy
@@ -654,8 +659,8 @@
                 (compile-it #'load-it)
                 (load-it (compile-it #'identity))))
         (ignore-errors
-          (delete-file temp-file-name)
-          (delete-file (compile-file-pathname temp-file-name)))))))
+          (delete-file *buffer-tmpfile*)
+          (delete-file (compile-file-pathname *buffer-tmpfile*)))))))
 
 ;;;; Definitions