[slime-cvs] CVS update: slime/swank-lispworks.lisp

[Helmut Eller]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv23507

Modified Files:
	swank-lispworks.lisp 
Log Message:
(swank-compile-string): Bind *print-radix* to t, to avoid problems if
somebody uses different values for *print-base* and *read-base*.
Reported by Alain Picard.

(emacs-connected): Add default methods for
environment-display-notifier and environment-display-debugger.

Date: Tue Mar 22 11:12:20 2005
Author: heller

Index: slime/swank-lispworks.lisp
diff -u slime/swank-lispworks.lisp:1.67 slime/swank-lispworks.lisp:1.68
--- slime/swank-lispworks.lisp:1.67	Tue Mar  1 00:32:06 2005
+++ slime/swank-lispworks.lisp	Tue Mar 22 11:12:19 2005
@@ -520,9 +520,12 @@
          (tmpname (hcl:make-temp-file nil "lisp")))
     (with-swank-compilation-unit (location)
       (compile-from-temp-file 
-       (format nil "~S~%~A" `(eval-when (:compile-toplevel)
-                              (setq dspec::*location* (list , at location)))
-               string)
+       (with-output-to-string (s)
+         (let ((*print-radix* t))
+           (print `(eval-when (:compile-toplevel)
+                     (setq dspec::*location* (list , at location)))
+                  s))
+         (write-string string s))
        tmpname))))
 
 ;;; xref
@@ -535,7 +538,7 @@
 (defxref who-macroexpands hcl:who-calls) ; macros are in the calls table too
 (defxref calls-who      hcl:calls-who)
 (defxref list-callers   list-callers-internal)
-(defxref list-callees   list-callees-internal)
+;; (defxref list-callees   list-callees-internal)
 
 (defun list-callers-internal (name)
   (let ((callers (make-array 100
@@ -700,7 +703,16 @@
 (defimplementation emacs-connected ()
   (when (eq (eval (swank-sym :*communication-style*))
             nil)
-    (set-sigint-handler)))
+    (set-sigint-handler))
+  ;; pop up the slime debugger by default
+  (let ((lw:*handle-warn-on-redefinition* :warn))
+    (defmethod env-internals:environment-display-notifier 
+        (env &key restarts condition)
+      (declare (ignore restarts))
+      (funcall (find-symbol (string :swank-debugger-hook) :swank)
+               condition *debugger-hook*))
+    (defmethod env-internals:environment-display-debugger (env)
+      *debug-io*)))
 
 (defimplementation make-stream-interactive (stream)
   (unless (find-method #'stream:stream-soft-force-output nil `((eql ,stream))