[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
* swank.lisp (debug-in-emacs): Bind *sldb-quit-restart*
here, if necessary to the next abort retstart.

--- /project/slime/cvsroot/slime/ChangeLog	2008/10/30 09:28:51	1.1574
+++ /project/slime/cvsroot/slime/ChangeLog	2008/10/31 14:13:10	1.1575
@@ -1,3 +1,8 @@
+2008-10-31  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (debug-in-emacs): Bind *sldb-quit-restart*
+	here, if necessary to the next abort retstart.
+
 2008-10-30  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-sbcl.lisp (wait-for-input): Return streams which are at
--- /project/slime/cvsroot/slime/slime.el	2008/10/30 09:28:43	1.1055
+++ /project/slime/cvsroot/slime/slime.el	2008/10/31 14:13:10	1.1056
@@ -9503,17 +9503,9 @@
                                (get-buffer-window (sldb-get-default-buffer))))
                         5)
   (with-current-buffer (sldb-get-default-buffer)
-    (sldb-invoke-restart (slime-test-find-top-level-restart)))
+    (sldb-quit))
   (slime-sync-to-top-level 5))
 
-(defun slime-test-find-top-level-restart ()
-  (let ((case-fold-search t))
-    (or (loop for i from 0  for (name str) in sldb-restarts 
-              when (string-match "SLIME's top level" str) return i)
-        (loop for i from 0  for (name str) in sldb-restarts 
-              when (and (string-match "abort" name) (string-match "top" str))
-              return i))))
-
 (def-slime-test interrupt-in-blocking-read
     ()
     "Let's see what happens if we interrupt a blocking read operation."
@@ -9565,7 +9557,7 @@
                             (lambda () (equal (sldb-level) level))
                             2)))
   (with-current-buffer (sldb-get-default-buffer)
-    (sldb-invoke-restart (slime-test-find-top-level-restart)))
+    (sldb-quit))
   (slime-sync-to-top-level 1))
     
 (def-slime-test disconnect
--- /project/slime/cvsroot/slime/swank.lisp	2008/10/19 20:03:34	1.607
+++ /project/slime/cvsroot/slime/swank.lisp	2008/10/31 14:13:10	1.608
@@ -2197,6 +2197,9 @@
 (defun debug-in-emacs (condition)
   (let ((*swank-debugger-condition* condition)
         (*sldb-restarts* (compute-restarts condition))
+        (*sldb-quit-restart* (if (boundp '*sldb-quit-restart*)
+                                 *sldb-quit-restart*
+                                 (find-restart 'abort)))
         (*package* (or (and (boundp '*buffer-package*)
                             (symbol-value '*buffer-package*))
                        *package*))
@@ -2355,12 +2358,9 @@
 (defslimefun throw-to-toplevel ()
   "Invoke the ABORT-REQUEST restart abort an RPC from Emacs.
 If we are not evaluating an RPC then ABORT instead."
-  (let ((restart (and (not (symbolp *sldb-quit-restart*))
-                      (find-restart *sldb-quit-restart*))))
+  (let ((restart (find-restart *sldb-quit-restart*)))
     (cond (restart (invoke-restart restart))
-          (t (format nil
-                     "Restart not found: ~a"
-                     *sldb-quit-restart*)))))
+          (t "Toplevel restart found"))))
 
 (defslimefun invoke-nth-restart-for-emacs (sldb-level n)
   "Invoke the Nth available restart.