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

[Helmut Eller]

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

Modified Files:
	swank.lisp 
Log Message:
(spawn-repl-thread): Use *default-worker-thread-bindings* just like
spawn-worker-thread.

(wrap-sldb-vars): New function.  When evaluating a form in a frame,
Allegro uses the "old" dynamic context, i.e., dynamic variables like
*sldb-level* and the like are reset to the values in those frames.
But if *sldb-level* is reset to 0, Emacs doesn't notice when a
(recursive) error occurs while evaluating the form in the old frame.
wrap-sldb-vars saves the debugger related variables to avoid such
confusion.
(eval-string-in-frame, pprint-eval-string-in-frame): Use it.


Date: Fri Apr  1 21:55:18 2005
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.290 slime/swank.lisp:1.291
--- slime/swank.lisp:1.290	Wed Mar 23 13:23:05 2005
+++ slime/swank.lisp	Fri Apr  1 21:55:18 2005
@@ -496,8 +496,8 @@
     (if (thread-alive-p thread) 
         thread
         (setf (connection.repl-thread connection)
-              (spawn (lambda () (repl-loop connection))
-                     :name "new-repl-thread")))))
+              (spawn-repl-thread connection "new-repl-thread")))))
+
 
 (defun find-worker-thread (id)
   (etypecase id
@@ -530,6 +530,12 @@
              (handle-request connection)))
          :name "worker"))
 
+(defun spawn-repl-thread (connection name)
+  (spawn (lambda () 
+           (with-bindings *default-worker-thread-bindings*
+             (repl-loop connection)))
+         :name name))
+
 (defun dispatch-event (event socket-io)
   "Handle an event triggered either by Emacs or within Lisp."
   (log-event "DISPATCHING: ~S~%" event)
@@ -579,8 +585,7 @@
                                     (read-loop control-thread socket-io
                                                connection)))
                                 :name "reader-thread"))
-          (repl-thread (spawn (lambda () (repl-loop connection))
-                              :name "repl-thread")))
+          (repl-thread (spawn-repl-thread connection "repl-thread")))
       (setf (connection.reader-thread connection) reader-thread)
       (setf (connection.repl-thread connection) repl-thread)
       connection)))
@@ -1797,12 +1802,11 @@
 then waits to handle further requests from Emacs. Eventually returns
 after Emacs causes a restart to be invoked."
   (declare (ignore hook))
-  (flet ((debug-it () (debug-in-emacs condition)))
-    (cond (*emacs-connection*
-           (debug-it))
-          ((default-connection)
-           (with-connection ((default-connection))
-             (debug-in-emacs condition))))))
+  (cond (*emacs-connection*
+         (debug-in-emacs condition))
+        ((default-connection)
+         (with-connection ((default-connection))
+           (debug-in-emacs condition)))))
 
 (defvar *global-debugger* t
   "Non-nil means the Swank debugger hook will be installed globally.")
@@ -1850,15 +1854,15 @@
   (unwind-protect
        (catch 'sldb-enter-default-debugger
          (send-to-emacs 
-          (list* :debug (current-thread) *sldb-level* 
+          (list* :debug (current-thread) level
                  (debugger-info-for-emacs 0 *sldb-initial-frames*)))
          (loop (catch 'sldb-loop-catcher
                  (with-simple-restart (abort "Return to sldb level ~D." level)
                    (send-to-emacs (list :debug-activate (current-thread)
-                                        *sldb-level*))
+                                        level))
                    (handler-bind ((sldb-condition #'handle-sldb-condition))
                      (read-from-emacs))))))
-    (send-to-emacs `(:debug-return 
+    (send-to-emacs `(:debug-return
                      ,(current-thread) ,level ,*sldb-stepping-p*))))
 
 (defun handle-sldb-condition (condition)
@@ -1979,13 +1983,18 @@
   (when (= sldb-level *sldb-level*)
     (invoke-nth-restart n)))
 
+(defun wrap-sldb-vars (form)
+  `(let ((*sldb-level* ,*sldb-level*))
+     ,form))
+
 (defslimefun eval-string-in-frame (string index)
-  (to-string (eval-in-frame (from-string string) index)))
+  (to-string (eval-in-frame (wrap-sldb-vars (from-string string))
+                            index)))
 
 (defslimefun pprint-eval-string-in-frame (string index)
   (swank-pprint
    (multiple-value-list 
-    (eval-in-frame (from-string string) index))))
+    (eval-in-frame (wrap-sldb-vars (from-string string)) index))))
 
 (defslimefun frame-locals-for-emacs (index)
   "Return a property list ((&key NAME ID VALUE) ...) describing