[slime-cvs] CVS slime

[aruttenberg]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv23601/slime

Modified Files:
	ChangeLog swank-abcl.lisp 
Log Message:
2006-06-09  Alan Ruttenberg <alanr-l at mumble.net>
	* swank-abcl: Update to cvs version of abcl and warnings errors
	when compiling in a buffer will now be properly caught by slime vs
	current behavior of always saying 0 errors 0 warnings and printing
	them in the repl instead


--- /project/slime/cvsroot/slime/ChangeLog	2006/05/31 19:27:31	1.904
+++ /project/slime/cvsroot/slime/ChangeLog	2006/06/10 03:27:03	1.905
@@ -1,3 +1,9 @@
+2006-06-09  Alan Ruttenberg <alanr-l at mumble.net>
+	* swank-abcl: Update to cvs version of abcl and warnings errors
+	when compiling in a buffer will now be properly caught by slime vs
+	current behavior of always saying 0 errors 0 warnings and printing
+	them in the repl instead
+	
 2006-05-31  Nathan Bird <nathan at acceleration.net>
 
 	* swank.lisp (*sldb-quit-restart*): New variable.
--- /project/slime/cvsroot/slime/swank-abcl.lisp	2006/05/27 04:18:13	1.37
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2006/06/10 03:27:03	1.38
@@ -277,46 +277,55 @@
 (defvar *buffer-string*)
 (defvar *compile-filename*)
 
+(in-package :swank-backend)
+
 (defun handle-compiler-warning (condition)
-  #+nil
-  (let ((loc (getf (slot-value condition 'excl::plist) :loc)))
-    (signal (make-condition
-             'compiler-condition
-             :original-condition condition
-             :severity :warning
-             :message (format nil "~A" condition)
-             :location (cond (*buffer-name*
-                              (make-location 
-                               (list :buffer *buffer-name*)
-                               (list :position *buffer-start-position*)))
-                             (loc
-                              (destructuring-bind (file . pos) loc
+  (let ((loc nil));(getf (slot-value condition 'excl::plist) :loc)))
+    (unless (member condition *abcl-signaled-conditions*) ; filter condition signaled more than once.
+      (push condition *abcl-signaled-conditions*) 
+      (signal (make-condition
+               'compiler-condition
+               :original-condition condition
+               :severity :warning
+               :message (format nil "~A" condition)
+               :location (cond (*buffer-name*
+                                (make-location 
+                                 (list :buffer *buffer-name*)
+                                 (list :position *buffer-start-position*)))
+                               (loc
+                                (destructuring-bind (file . pos) loc
+                                  (make-location
+                                   (list :file (namestring (truename file)))
+                                   (list :position (1+ pos)))))
+                               (t  
                                 (make-location
-                                 (list :file (namestring (truename file)))
-                                 (list :position (1+ pos)))))
-                             (t  
-                              (make-location
-                               (list :file *compile-filename*)
-                               (list :position 1))))))))
+                                 (list :file *compile-filename*)
+                                 (list :position 1)))))))))
+
+(defvar *abcl-signaled-conditions*)
 
 (defimplementation swank-compile-file (filename load-p
                                        &optional external-format)
   (declare (ignore external-format))
-  (handler-bind ((warning #'handle-compiler-warning))
-    (let ((*buffer-name* nil)
-          (*compile-filename* filename))
-      (multiple-value-bind (fn warn fail) (compile-file filename)
-        (when (and load-p (not fail))
-          (load fn))))))
+  (let ((jvm::*resignal-compiler-warnings* t)
+        (*abcl-signaled-conditions* nil))
+    (handler-bind ((warning #'handle-compiler-warning))
+      (let ((*buffer-name* nil)
+            (*compile-filename* filename))
+        (multiple-value-bind (fn warn fail) (compile-file filename)
+          (when (and load-p (not fail))
+            (load fn)))))))
 
 (defimplementation swank-compile-string (string &key buffer position directory)
   (declare (ignore directory))
-  (handler-bind ((warning #'handle-compiler-warning))
-    (let ((*buffer-name* buffer)
-          (*buffer-start-position* position)
-          (*buffer-string* string))
-      (funcall (compile nil (read-from-string
-                             (format nil "(~S () ~A)" 'lambda string)))))))
+  (let ((jvm::*resignal-compiler-warnings* t)
+        (*abcl-signaled-conditions* nil))
+    (handler-bind ((warning #'handle-compiler-warning))                 
+      (let ((*buffer-name* buffer)
+            (*buffer-start-position* position)
+            (*buffer-string* string))
+        (funcall (compile nil (read-from-string
+                               (format nil "(~S () ~A)" 'lambda string))))))))
 
 #|
 ;;;; Definition Finding