[slime-cvs] CVS slime

[CVS User mevenson]

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

Modified Files:
	ChangeLog swank-abcl.lisp 
Log Message:
Use *INVOKE-DEBUGGER-HOOK* introduced in ABCL by analogy to SBCL (Tobias Rittweiler).


--- /project/slime/cvsroot/slime/ChangeLog	2009/09/18 21:29:59	1.1858
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/20 09:04:53	1.1859
@@ -1,3 +1,11 @@
+2009-09-20  Mark Evenson  <evenson at panix.com>
+
+	Use *INVOKE-DEBUGGER-HOOK* introduced in ABCL by analogy to SBCL
+	 (Tobias Rittweiler).
+
+	* swank-abcl.lisp (sys::break): Conditionally redefine SYS::BREAK
+	only if SYS::INVOKE-DEUBBGER-HOOK is not present.
+
 2009-09-18  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* slime.el (slime-parent-bindings): Define M-? as
--- /project/slime/cvsroot/slime/swank-abcl.lisp	2009/09/17 15:51:52	1.72
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2009/09/20 09:04:53	1.73
@@ -14,6 +14,10 @@
   (require :collect) ;just so that it doesn't spoil the flying letters
   (require :pprint))
 
+;;; The introduction of SYS::*INVOKE-DEBUGGER-HOOK* obliterates the
+;;; need for redefining BREAK. The following should thus be removed at
+;;; some point in the future.
+#-#.(swank-backend::with-symbol '*invoke-debugger-hook* 'sys)
 (defun sys::break (&optional (format-control "BREAK called") 
                    &rest format-arguments)
   (let ((sys::*saved-backtrace* 
@@ -283,6 +287,28 @@
 
 ;;;; Debugger
 
+;;; Copied from swank-sbcl.lisp.
+(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.)
+      (if *debugger-hook*
+          (funcall *debugger-hook* condition old-hook)
+          (funcall hook condition old-hook))))
+
+(defimplementation call-with-debugger-hook (hook fun)
+  (let ((*debugger-hook* hook)
+        #+#.(swank-backend::with-symbol '*invoke-debugger-hook* 'sys)
+        (sys::*invoke-debugger-hook* (make-invoke-debugger-hook hook)))
+    (funcall fun)))
+
+(defimplementation install-debugger-globally (function)
+  (setq *debugger-hook* function)
+  #+#.(swank-backend::with-symbol '*invoke-debugger-hook* 'sys)
+  (setq sys::*invoke-debugger-hook* (make-invoke-debugger-hook function)))
+
 (defvar *sldb-topframe*)
 
 (defimplementation call-with-debugging-environment (debugger-loop-fn)