[slime-devel] Suppressing function redefinition warnings with SBCL

[Zach Beane]

Here's a patch that makes the SBCL backend honor
*tramp-load-time-warnings* again. It makes the the "Style Warning:
redefining FUNK in DEFUN" warning less annoying.

Zach

Index: ChangeLog
===================================================================
RCS file: /project/slime/cvsroot/slime/ChangeLog,v
retrieving revision 1.729
diff -u -r1.729 ChangeLog
--- ChangeLog	29 Jul 2005 12:34:56 -0000	1.729
+++ ChangeLog	3 Aug 2005 19:03:50 -0000
@@ -1,3 +1,8 @@
+2005-08-03  Zach Beane  <xach at gwi.net>
+
+	* swank-sbcl.lisp (swank-compile-string): Restore honoring of
+	*trap-load-time-warnings*.
+
 2005-07-29  Marco Baringer  <mb at bese.it>
 
 	* doc/slime.texi (Other configurables): Document
Index: swank-sbcl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-sbcl.lisp,v
retrieving revision 1.138
diff -u -r1.138 swank-sbcl.lisp
--- swank-sbcl.lisp	26 Jul 2005 14:59:45 -0000	1.138
+++ swank-sbcl.lisp	3 Aug 2005 19:03:50 -0000
@@ -458,20 +458,21 @@
 #+swank-backend::source-plist
 (defimplementation swank-compile-string (string &key buffer position directory)
   (declare (ignore directory))
-  (let ((*buffer-name* buffer)
-        (*buffer-offset* position)
-        (*buffer-substring* string))
-      (with-compilation-hooks ()
-        (with-compilation-unit (:source-plist
-                                (list :emacs-buffer buffer 
-                                      :emacs-string string
-                                      :emacs-position position))
-        #+nil
-        (with-input-from-string (stream string)
-          (load stream))
-        (funcall (compile nil
-                          `(lambda ()
-                            ,(read-from-string string))))))))
+  (flet ((compileit (cont)
+           (let ((*buffer-name* buffer)
+                 (*buffer-offset* position)
+                 (*buffer-substring* string))
+             (with-compilation-hooks ()
+               (with-compilation-unit (:source-plist
+                                       (list :emacs-buffer buffer 
+                                             :emacs-string string
+                                             :emacs-position position))
+                 (funcall cont (compile nil
+                                        `(lambda ()
+                                          ,(read-from-string string)))))))))
+    (if *trap-load-time-warnings*
+        (compileit #'funcall)
+        (funcall (compileit #'identity)))))
 
 ;;;; Definitions