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

[Luke Gorrie]

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

Modified Files:
	swank-cmucl.lisp 
Log Message:
(source-location-from-code-location): Fixed a bug where the
source-file-cache was not really used.  Now always report the location
based on source file (cached or not) even if modified -- not falling
back on regexps, which was probably a misfeature.

Date: Tue May  4 04:09:20 2004
Author: lgorrie

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.99 slime/swank-cmucl.lisp:1.100
--- slime/swank-cmucl.lisp:1.99	Sat May  1 22:19:35 2004
+++ slime/swank-cmucl.lisp	Tue May  4 04:09:20 2004
@@ -1,7 +1,5 @@
 ;;;; -*- indent-tabs-mode: nil; outline-regexp: ";;;;+" -*-
 
-(declaim (optimize (debug 2)))
-
 (in-package :swank-backend)
 
 (in-package :lisp)
@@ -590,14 +588,19 @@
            ;; Cache miss.
            (if (equal (file-write-date filename) date)
                ;; File on disk has the correct version.
-               (with-open-file (s filename :direction :input)
-                 (let ((string (make-string (file-length s))))
-                   (read-sequence string s)
-                   (setf (gethash filename *source-file-cache*)
-                         (make-source-cache-entry string date))
-                   string))
+               (let ((source (read-file filename)))
+                 (setf (gethash filename *source-file-cache*)
+                       (make-source-cache-entry source date))
+                 source)
                nil)))))
 
+(defun read-file (filename)
+  "Return the entire contents of FILENAME as a string."
+  (with-open-file (s filename :direction :input)
+    (let ((string (make-string (file-length s))))
+      (read-sequence string s)
+      string)))
+
 (defmacro safe-definition-finding (&body body)
   "Execute BODY ignoring errors.  Return the source location returned
 by BODY or if an error occurs a description of the error.  The second
@@ -1134,18 +1137,19 @@
       (:file 
        (let* ((code-date (di:debug-source-created debug-source))
               (source (source-cache-get name code-date)))
-         (if (null source)
-             ;; We don't have up-to-date sourcecode. Emacs will have
-             ;; to make a regexp search.
-             ;; XXX Leave position blank. Emacs will plug in the function name.
-             (make-location (list :file (unix-truename name)) nil)
-             (with-open-file (s name :direction :input)
-               (make-location (list :file (unix-truename name))
-                              (list :position
-                                    (1+ (code-location-stream-position
-                                         code-location s)))
-                              `(:snippet ,(read-snippet s)))))))
-      (:stream 
+         (when (null source)
+           ;; We don't have up-to-date sourcecode. Just read the
+           ;; file that we have on disk.
+           ;; XXX Maybe the right solution, but needs code cleanup anyway.
+           (setf source (read-file name)))
+         (make-location (list :file (unix-truename name)) nil)
+         (with-input-from-string (s source)
+           (make-location (list :file (unix-truename name))
+                          (list :position
+                                (1+ (code-location-stream-position
+                                     code-location s)))
+                          `(:snippet ,(read-snippet s))))))
+    (:stream 
        (assert (debug-source-info-from-emacs-buffer-p debug-source))
        (let* ((info (c::debug-source-info debug-source))
               (string (getf info :emacs-buffer-string))