[slime-cvs] CVS slime

[heller]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv24401

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
* slime.el (slime-test-find-top-level-restart): New function.
[def-slime-test] (interrupt-at-toplevel, interrupt-in-debugger):
Use it.

--- /project/slime/cvsroot/slime/ChangeLog	2008/09/17 06:20:05	1.1511
+++ /project/slime/cvsroot/slime/ChangeLog	2008/09/17 06:20:34	1.1512
@@ -1,8 +1,8 @@
-2008-09-16  Tobias C. Rittweiler  <tcr at freebits.de>
+2008-09-17  Helmut Eller  <heller at common-lisp.net>
 
-	* slime.el (slime-end-of-list): `backward-down-list' was used
-	there which is defined by paredit.el.
-	Use `(down-list -1)' instead.
+	* slime.el (slime-test-find-top-level-restart): New function.
+	[def-slime-test] (interrupt-at-toplevel, interrupt-in-debugger):
+	Use it.
 
 2008-09-16  Helmut Eller  <heller at common-lisp.net>
 
@@ -34,6 +34,12 @@
 	* swank-lispworks.lisp (skip-comments): New function.
 	(dspec-stream-position): Use it.
 
+2008-09-16  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime.el (slime-end-of-list): `backward-down-list' was used
+	there which is defined by paredit.el.
+	Use `(down-list -1)' instead.
+
 2008-09-15  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-lispworks.lisp (describe-symbol-for-emacs): Revert last
--- /project/slime/cvsroot/slime/slime.el	2008/09/17 06:20:09	1.1019
+++ /project/slime/cvsroot/slime/slime.el	2008/09/17 06:20:39	1.1020
@@ -9405,9 +9405,17 @@
                                (get-buffer-window (sldb-get-default-buffer))))
                         5)
   (with-current-buffer (sldb-get-default-buffer)
-    (sldb-quit))
+    (sldb-invoke-restart (slime-test-find-top-level-restart)))
   (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."
@@ -9459,7 +9467,7 @@
                             (lambda () (equal (sldb-level) level))
                             2)))
   (with-current-buffer (sldb-get-default-buffer)
-    (sldb-quit))
+    (sldb-invoke-restart (slime-test-find-top-level-restart)))
   (slime-sync-to-top-level 1))
     
 (def-slime-test disconnect
--- /project/slime/cvsroot/slime/swank.lisp	2008/09/15 10:41:03	1.589
+++ /project/slime/cvsroot/slime/swank.lisp	2008/09/17 06:20:39	1.590
@@ -2347,7 +2347,8 @@
 (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 (find-restart *sldb-quit-restart*)))
+  (let ((restart (and (not (symbolp *sldb-quit-restart*))
+                      (find-restart *sldb-quit-restart*))))
     (cond (restart (invoke-restart restart))
           (t (format nil
                      "Restart not found: ~a"