[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog swank-lispworks.lisp 
Log Message:
Improve source locations for compiler messages in Lispworks.

* swank-lispworks.lisp (map-error-database)
(signal-error-data-base, make-dspec-progenitor-location): Pass the
edit-path along.
(signal-undefined-functions): No edit-path available so just use
nil.

--- /project/slime/cvsroot/slime/ChangeLog	2010/11/12 19:42:51	1.2164
+++ /project/slime/cvsroot/slime/ChangeLog	2010/11/13 11:18:03	1.2165
@@ -1,3 +1,13 @@
+2010-11-13  Helmut Eller  <heller at common-lisp.net>
+
+	Improve source locations for compiler messages in Lispworks.
+
+	* swank-lispworks.lisp (map-error-database)
+	(signal-error-data-base, make-dspec-progenitor-location): Pass the
+	edit-path along.
+	(signal-undefined-functions): No edit-path available so just use
+	nil.
+
 2010-11-12  Helmut Eller  <heller at common-lisp.net>
 
 	Improve frame-source-location for Lispworks.
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2010/11/12 19:42:51	1.139
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2010/11/13 11:18:03	1.140
@@ -520,8 +520,10 @@
 (defun map-error-database (database fn)
   (loop for (filename . defs) in database do
 	(loop for (dspec . conditions) in defs do
-	      (dolist (c conditions) 
-		(funcall fn filename dspec (if (consp c) (car c) c))))))
+	      (dolist (c conditions)
+                (multiple-value-bind (condition path)
+                    (if (consp c) (values (car c) (cdr c)) (values c nil))
+                  (funcall fn filename dspec condition path))))))
 
 (defun lispworks-severity (condition)
   (cond ((not condition) :warning)
@@ -649,23 +651,25 @@
                       (dspec-function-name-position dspec `(:offset ,offset 0))
                       hints)))))
 
-(defun make-dspec-progenitor-location (dspec location)
+(defun make-dspec-progenitor-location (dspec location edit-path)
   (let ((canon-dspec (dspec:canonicalize-dspec dspec)))
     (make-dspec-location
      (if canon-dspec
          (if (dspec:local-dspec-p canon-dspec)
              (dspec:dspec-progenitor canon-dspec)
-           canon-dspec)
-       nil)
-     location)))
+             canon-dspec)
+         nil)
+     location
+     (if edit-path
+         (list :edit-path (edit-path-to-cmucl-source-path edit-path))))))
 
 (defun signal-error-data-base (database &optional location)
   (map-error-database 
    database
-   (lambda (filename dspec condition)
+   (lambda (filename dspec condition edit-path)
      (signal-compiler-condition
       (format nil "~A" condition)
-      (make-dspec-progenitor-location dspec (or location filename))
+      (make-dspec-progenitor-location dspec (or location filename) edit-path)
       condition))))
 
 (defun unmangle-unfun (symbol)
@@ -680,10 +684,11 @@
 	     (dolist (dspec dspecs)
 	       (signal-compiler-condition 
 		(format nil "Undefined function ~A" (unmangle-unfun unfun))
-		(make-dspec-progenitor-location dspec
-                                                (or filename
-                                                    (gethash (list unfun dspec)
-                                                             *undefined-functions-hash*)))
+		(make-dspec-progenitor-location 
+                 dspec
+                 (or filename
+                     (gethash (list unfun dspec) *undefined-functions-hash*))
+                 nil)
 		nil)))
 	   htab))