[slime-cvs] CVS slime

[CVS User trittweiler]

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

Modified Files:
	ChangeLog swank-allegro.lisp 
Log Message:
	* swank-allegro.lisp (redefinition-p, redefinition): New.
	(handle-compiler-warning): Add :severity for redefinitions,
	style-warnings, errors.


--- /project/slime/cvsroot/slime/ChangeLog	2010/01/22 00:02:08	1.1969
+++ /project/slime/cvsroot/slime/ChangeLog	2010/01/25 10:50:10	1.1970
@@ -1,3 +1,9 @@
+2010-01-25  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank-allegro.lisp (redefinition-p, redefinition): New.
+	(handle-compiler-warning): Add :severity for redefinitions,
+	style-warnings, errors.
+
 2010-01-21  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-ccl.lisp (with-frame): Put this macro before it's used.
--- /project/slime/cvsroot/slime/swank-allegro.lisp	2009/12/11 03:37:17	1.130
+++ /project/slime/cvsroot/slime/swank-allegro.lisp	2010/01/25 10:50:10	1.131
@@ -233,12 +233,19 @@
 (defun compiler-note-p (object)
   (member (type-of object) '(excl::compiler-note compiler::compiler-note)))
 
+(defun redefinition-p (condition)
+  (and (typep condition 'style-warning)
+       (every #'char-equal "redefin" (princ-to-string condition))))
+
 (defun compiler-undefined-functions-called-warning-p (object)
   (typep object 'excl:compiler-undefined-functions-called-warning))
 
 (deftype compiler-note ()
   `(satisfies compiler-note-p))
 
+(deftype redefinition ()
+  `(satisfies redefinition-p))
+
 (defun signal-compiler-condition (&rest args)
   (signal (apply #'make-condition 'compiler-condition args)))
 
@@ -251,9 +258,12 @@
          (signal-compiler-condition
           :original-condition condition
           :severity (etypecase condition
-                      (warning :warning)
+                      (redefinition  :redefinition)
+                      (style-warning :style-warning)
+                      (warning       :warning)
                       (compiler-note :note)
-                      (reader-error :read-error))
+                      (reader-error  :read-error)
+                      (error         :error))
           :message (format nil "~A" condition)
           :location (if (typep condition 'reader-error) 
                         (location-for-reader-error condition)