[slime-cvs] CVS slime

[CVS User trittweiler]

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv12238

Modified Files:
	swank-sbcl.lisp ChangeLog 
Log Message:
	* swank-sbcl.lisp (compiling-from-buffer-p),
	(compiling-from-file-p)
	(compiling-from-generated-code-p): New helpers; extracted from
	LOCATE-COMPILER-NOTE.
	(locate-compiler-note): Use them.
	(compiler-note-location): Use them, too, to handle reader-errors
	when compiling from file. This completes 2009-02-27.

	Reported by Christian Lynbech.


--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/02/26 23:41:41	1.235
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/03/07 10:14:42	1.236
@@ -408,27 +408,40 @@
             (compiler-source-path context)
             (sb-c::compiler-error-context-original-source context)))
           ((typep condition 'reader-error)
-           (let ((stream (stream-error-stream condition)))
-             (unless (open-stream-p stream) (bailout))
-             (make-location (list :buffer *buffer-name*)
-                            (list :offset *buffer-offset*
-                                  (file-position stream)))))
+           (let* ((stream (stream-error-stream condition))
+                  (file   (pathname stream)))
+             (unless (open-stream-p stream)
+               (bailout))
+             (if (compiling-from-buffer-p file)
+                 (make-location (list :buffer *buffer-name*)
+                                (list :offset *buffer-offset*
+                                      (file-position stream)))
+                 (progn
+                   (assert (compiling-from-file-p file))
+                   (make-location (list :file (namestring file))
+                                  (list :position (file-position stream)))))))
           (t (bailout)))))
 
+(defun compiling-from-buffer-p (filename)
+  (and (not (eq filename :lisp)) *buffer-name*))
+
+(defun compiling-from-file-p (filename)
+  (and (pathnamep filename) (null *buffer-name*)))
+
+(defun compiling-from-generated-code-p (filename source)
+  (and (eq filename :lisp) (stringp source)))
+
 (defun locate-compiler-note (file source-path source)
-  (cond ((and (not (eq file :lisp)) *buffer-name*)
-         ;; Compiling from a buffer
+  (cond ((compiling-from-buffer-p file)
          (make-location (list :buffer *buffer-name*)
                         (list :offset  *buffer-offset* 
                               (source-path-string-position
                                source-path *buffer-substring*))))
-        ((and (pathnamep file) (null *buffer-name*))
-         ;; Compiling from a file
+        ((compiling-from-file-p file)
          (make-location (list :file (namestring file))
                         (list :position (1+ (source-path-file-position
                                              source-path file)))))
-        ((and (eq file :lisp) (stringp source))
-         ;; Compiling macro generated code
+        ((compiling-from-generated-code-p file source)
          (make-location (list :source-form source)
                         (list :position 1)))
         (t
--- /project/slime/cvsroot/slime/ChangeLog	2009/03/06 23:23:52	1.1709
+++ /project/slime/cvsroot/slime/ChangeLog	2009/03/07 10:14:42	1.1710
@@ -1,3 +1,15 @@
+2009-03-08  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-sbcl.lisp (compiling-from-buffer-p),
+	(compiling-from-file-p)
+	(compiling-from-generated-code-p): New helpers; extracted from
+	LOCATE-COMPILER-NOTE.
+	(locate-compiler-note): Use them.
+	(compiler-note-location): Use them, too, to handle reader-errors
+	when compiling from file. This completes 2009-02-27.
+
+	Reported by Christian Lynbech.
+
 2009-03-07  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime.el ([portability] getf): Redefine `getf' on Emacs21 to