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

[Helmut Eller]

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

Modified Files:
	swank-cmucl.lisp 
Log Message:
(read-error-location, signal-compiler-condition): Handle read-errors.

(swank-compile-file): Don't load the file if there was an error.
Date: Tue Oct 26 02:32:08 2004
Author: heller

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.124 slime/swank-cmucl.lisp:1.125
--- slime/swank-cmucl.lisp:1.124	Mon Oct 25 18:17:57 2004
+++ slime/swank-cmucl.lisp	Tue Oct 26 02:32:08 2004
@@ -293,10 +293,11 @@
   (with-compilation-hooks ()
     (let ((*buffer-name* nil))
       (multiple-value-bind (output-file warnings-p failure-p)
-          (compile-file filename :load load-p)
+          (compile-file filename)
         (unless failure-p
           ;; Cache the latest source file for definition-finding.
-          (source-cache-get filename (file-write-date filename)))
+          (source-cache-get filename (file-write-date filename))
+          (load output-file))
         (values output-file warnings-p failure-p)))))
 
 (defimplementation swank-compile-string (string &key buffer position directory)
@@ -333,7 +334,9 @@
            :severity (severity-for-emacs condition)
            :short-message (brief-compiler-message-for-emacs condition)
            :message (long-compiler-message-for-emacs condition context)
-           :location (compiler-note-location context))))
+           :location (if (eq (type-of condition) 'c::compiler-read-error)
+                         (read-error-location condition)
+                         (compiler-note-location context)))))
 
 (defun severity-for-emacs (condition)
   "Return the severity of CONDITION."
@@ -358,6 +361,18 @@
                   (c::compiler-error-context-source error-context)))
     (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~^~%~}~]~A"
             enclosing source condition)))
+
+(defun read-error-location (condition)
+  (let* ((finfo (car (c::source-info-current-file c::*source-info*)))
+         (file (c::file-info-name finfo))
+         (pos (c::compiler-read-error-position condition)))
+    (cond ((and (eq file :stream) *buffer-name*)
+           (make-location (list :buffer *buffer-name*)
+                          (list :position *buffer-start-position* pos)))
+          ((and (pathnamep file) (not *buffer-name*))
+           (make-location (list :file (unix-truename file))
+                          (list :position pos)))
+          (t (break)))))
 
 (defun compiler-note-location (context)
   "Derive the location of a complier message from its context.