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

[Helmut Eller]

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

Modified Files:
	swank-sbcl.lisp 
Log Message:
(locate-compiler-note): Handle errors in macros better.
Date: Mon Mar 21 12:03:12 2005
Author: heller

Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.126 slime/swank-sbcl.lisp:1.127
--- slime/swank-sbcl.lisp:1.126	Mon Mar 21 01:57:27 2005
+++ slime/swank-sbcl.lisp	Mon Mar 21 12:03:11 2005
@@ -279,11 +279,13 @@
 
 (defun compiler-note-location (context)
   (if context
-      (with-struct (sb-c::compiler-error-context- file-name) context
-        (locate-compiler-note file-name (compiler-source-path context)))
+      (locate-compiler-note
+       (sb-c::compiler-error-context-file-name context)
+       (compiler-source-path context)
+       (sb-c::compiler-error-context-original-source context))
       (list :error "No error location available")))
 
-(defun locate-compiler-note (file source-path)
+(defun locate-compiler-note (file source-path source)
   (cond ((and (pathnamep file) *buffer-name*)
          ;; Compiling from a buffer
          (let ((position (+ *buffer-offset*
@@ -297,6 +299,10 @@
                         (list :position
                               (1+ (source-path-file-position 
                                    source-path file)))))
+        ((and (eq file :lisp) (stringp source))
+         ;; Compiling macro generated code
+         (make-location (list :source-form source)
+                        (list :position 1)))
         (t
          (error "unhandled case"))))
 
@@ -459,7 +465,7 @@
       (find-function-source-location function)))
 
 (defun find-function-source-location (function)
-  (cond #+(or) ;; doesn't work unknown reasons
+  (cond #+(or) ;; doesn't work for unknown reasons
         ((function-has-start-location-p function)
          (code-location-source-location (function-start-location function)))
         ((not (function-source-filename function))