[slime-cvs] CVS slime

[CVS User trittweiler]

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

Modified Files:
	swank-sbcl.lisp ChangeLog 
Log Message:
	* swank-sbcl.lisp (set-break-hook): New.
	(call-with-break-hook): New, too. Both extracted from elsewhere.
	(install-debugger-globally, call-with-debugger-hook): Use them.
	(make-invoke-debugger-hook): Adapted not to call *debugger-hook*
	on its own; it should rather decline because *debugger-hook* is
	tried after *invoke-debugger-hook* anyway. Previously, a
	custom *debugger-hook* (which declines itself) would have been
	executed twice.


--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/12/02 17:34:37	1.256
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/12/10 20:51:33	1.257
@@ -911,20 +911,29 @@
 
 ;;; Debugging
 
-(defvar *sldb-stack-top*)
+;;; Notice that SB-EXT:*INVOKE-DEBUGGER-HOOK* is slightly stronger
+;;; than just a hook into BREAK. In particular, it'll make
+;;; (LET ((*DEBUGGER-HOOK* NIL)) ..error..) drop into SLDB rather
+;;; than the native debugger. That should probably be considered a
+;;; feature.
 
 (defun make-invoke-debugger-hook (hook)
-  #'(lambda (condition old-hook)
-      ;; Notice that *INVOKE-DEBUGGER-HOOK* is tried before
-      ;; *DEBUGGER-HOOK*, so we have to make sure that the latter gets
-      ;; run when it was established locally by a user (i.e. changed meanwhile.)
+  #'(sb-int:named-lambda swank-invoke-debugger-hook
+        (condition old-hook)
       (if *debugger-hook*
-          (funcall *debugger-hook* condition old-hook)
+          nil           ; decline, *DEBUGGER-HOOK* will be tried next.
           (funcall hook condition old-hook))))
 
+(defun set-break-hook (hook)
+  (setq sb-ext:*invoke-debugger-hook* (make-invoke-debugger-hook hook)))
+
+(defun call-with-break-hook (hook continuation)
+  (let ((sb-ext:*invoke-debugger-hook* (make-invoke-debugger-hook hook)))
+    (funcall continuation)))
+
 (defimplementation install-debugger-globally (function)
   (setq *debugger-hook* function)
-  (setq sb-ext:*invoke-debugger-hook* (make-invoke-debugger-hook function)))
+  (set-break-hook function))
 
 (defimplementation condition-extras (condition)
   (cond #+#.(swank-backend::sbcl-with-new-stepper-p)
@@ -946,6 +955,8 @@
             ref)
            (t (symbol-name ref))))))
 
+(defvar *sldb-stack-top*)
+
 (defimplementation call-with-debugging-environment (debugger-loop-fn)
   (declare (type function debugger-loop-fn))
   (let* ((*sldb-stack-top* (or sb-debug:*stack-top-hint* (sb-di:top-frame)))
@@ -972,9 +983,7 @@
     (invoke-restart 'sb-ext:step-out)))
 
 (defimplementation call-with-debugger-hook (hook fun)
-  (let ((*debugger-hook* hook)
-        (sb-ext:*invoke-debugger-hook* (and hook (make-invoke-debugger-hook hook)))
-        #+#.(swank-backend::sbcl-with-new-stepper-p)
+  (let (#+#.(swank-backend::sbcl-with-new-stepper-p)
         (sb-ext:*stepper-hook*
          (lambda (condition)
            (typecase condition
@@ -983,7 +992,7 @@
                 (sb-impl::invoke-debugger condition)))))))
     (handler-bind (#+#.(swank-backend::sbcl-with-new-stepper-p)
                    (sb-ext:step-condition #'sb-impl::invoke-stepper))
-      (funcall fun))))
+      (call-with-break-hook hook fun))))
 
 (defun nth-frame (index)
   (do ((frame *sldb-stack-top* (sb-di:frame-down frame))
--- /project/slime/cvsroot/slime/ChangeLog	2009/12/07 05:55:37	1.1928
+++ /project/slime/cvsroot/slime/ChangeLog	2009/12/10 20:51:33	1.1929
@@ -1,3 +1,14 @@
+2009-12-10  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank-sbcl.lisp (set-break-hook): New.
+	(call-with-break-hook): New, too. Both extracted from elsewhere.
+	(install-debugger-globally, call-with-debugger-hook): Use them.
+	(make-invoke-debugger-hook): Adapted not to call *debugger-hook*
+	on its own; it should rather decline because *debugger-hook* is
+	tried after *invoke-debugger-hook* anyway. Previously, a
+	custom *debugger-hook* (which declines itself) would have been
+	executed twice.
+
 2009-12-07  Stas Boukarev  <stassats at gmail.com>
 
 	* slime.el (slime-parse-toplevel-form): Use