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

[Luke Gorrie]

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

Modified Files:
	swank-openmcl.lisp 
Log Message:
(ccl::force-break-in-listener): Support for interrupting the Lisp subjob
(by Alan Ruttenberg).

Date: Mon Dec 15 10:58:45 2003
Author: lgorrie

Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.35 slime/swank-openmcl.lisp:1.36
--- slime/swank-openmcl.lisp:1.35	Sun Dec 14 03:24:21 2003
+++ slime/swank-openmcl.lisp	Mon Dec 15 10:58:45 2003
@@ -13,7 +13,7 @@
 ;;; The LLGPL is also available online at
 ;;; http://opensource.franz.com/preamble.html
 ;;;
-;;;   $Id: swank-openmcl.lisp,v 1.35 2003/12/14 08:24:21 heller Exp $
+;;;   $Id: swank-openmcl.lisp,v 1.36 2003/12/15 15:58:45 lgorrie Exp $
 ;;;
 
 ;;;
@@ -89,30 +89,34 @@
                          "Swank" #'accept-loop server-socket close)))
              ;; tell openmcl which process you want to be interrupted when
              ;; sigint is received
-             ;; (setq ccl::*interactive-abort-process* swank))
+             (setq ccl::*interactive-abort-process* swank))
              swank))
           (t
            (accept-loop server-socket close)))))
 
-#+(or)
-(defun ccl::force-break-in-listener (p)
-  (ccl::process-interrupt 
-   p (lambda ()
-       (ccl::ignoring-without-interrupts
-        (let ((*swank-debugger-stack-frame* nil)
-              (previous-p nil))
-          (block find-frame
-            (map-backtrace
-             (lambda (frame-number p tcr lfun pc)
-               (declare (ignore frame-number tcr
-                                pc))
-               (when (eq (ccl::lfun-name lfun) 'swank::eval-region)
-                 (setq
-                  *swank-debugger-stack-frame* previous-p)
-                 (return-from find-frame))
-               (setq previous-p p))))
-          (invoke-debugger)
-          (clear-input *terminal-io*))))))
+(let ((ccl::*warn-if-redefine-kernel* nil))
+   (defun ccl::force-break-in-listener (p)
+     (ccl::process-interrupt p
+                             #'(lambda ()
+                                 (ccl::ignoring-without-interrupts
+                                  (let ((*swank-debugger-stack-frame*
+                                  nil)
+                                        (previous-p nil))
+                                    (block find-frame
+                                      (map-backtrace
+                                       #'(lambda(frame-number p tcr
+                                        lfun pc)
+                                           (declare (ignore
+                                           frame-number tcr pc))
+                                           (when (eq (ccl::lfun-name
+                                           lfun) 'swank::eval-region)
+                                             (setq
+                                             *swank-debugger-stack-frame*
+                                             previous-p)
+                                             (return-from find-frame))
+                                           (setq previous-p p))))
+                                    (invoke-debugger)
+                                    (clear-input *terminal-io*)))))))
 
 (defun accept-loop (server-socket close)
   (unwind-protect (cond (close (accept-one-client server-socket))