[slime-cvs] CVS slime
CVS User trittweiler
trittweiler at common-lisp.net
Thu Dec 10 23:15:42 UTC 2009
Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv10273
Modified Files:
swank.lisp slime.el ChangeLog
Log Message:
Add `M-x slime-toggle-debug-on-swank-error'.
In "Debug on SWANK error" mode, errors which are normally caught
to not annoy the user, will now drop into the debugger.
Additionally, the backend won't do any backtrace magic so you'll
see the full backtrace with all its glory details.
SBCL only so far.
* slime.el (slime-toggle-debug-on-swank-error): New.
* swank.lisp (toggle-debug-on-swank-error): New slimefun.
(debug-on-swank-error): New function. SETFable.
(invoke-default-debugger): Use CALL-WITH-DEBUGGER-HOOK so we're
trapped into the native debugger on SBCL (previously we weren't
due to SB-EXT:*INVOKE-DEBUGGER-HOOK*.)
* swank.lisp: Rename SWANK-ERROR to SWANK-PROTOCOL-ERROR.
--- /project/slime/cvsroot/slime/swank.lisp 2009/11/13 20:23:57 1.673
+++ /project/slime/cvsroot/slime/swank.lisp 2009/12/10 23:15:42 1.674
@@ -44,8 +44,9 @@
#:*sldb-printer-bindings*
#:*swank-pprint-bindings*
#:*record-repl-results*
- #:*debug-on-swank-error*
#:*inspector-verbose*
+ ;; This is SETFable.
+ #:debug-on-swank-error
;; These are re-exported directly from the backend:
#:buffer-first-change
#:frame-source-location
@@ -330,15 +331,15 @@
(defslimefun ping (tag)
tag)
-;; A conditions to include backtrace information
-(define-condition swank-error (error)
- ((condition :initarg :condition :reader swank-error.condition)
- (backtrace :initarg :backtrace :reader swank-error.backtrace))
+;; A condition to include backtrace information
+(define-condition swank-protocol-error (error)
+ ((condition :initarg :condition :reader swank-protocol-error.condition)
+ (backtrace :initarg :backtrace :reader swank-protocol-error.backtrace))
(:report (lambda (condition stream)
- (princ (swank-error.condition condition) stream))))
+ (princ (swank-protocol-error.condition condition) stream))))
-(defun make-swank-error (condition)
- (make-condition 'swank-error :condition condition
+(defun make-swank-protocol-error (condition)
+ (make-condition 'swank-protocol-error :condition condition
:backtrace (safe-backtrace)))
(defun safe-backtrace ()
@@ -346,23 +347,28 @@
(call-with-debugging-environment
(lambda () (backtrace 0 nil)))))
-(defvar *debug-on-swank-error* nil
- "When non-nil invoke the system debugger on swank internal errors.
-Do not set this to T unless you want to debug swank internals.")
+(defvar *debug-on-swank-protocol-error* nil
+ "When non-nil invoke the system debugger on errors that were
+signalled during decoding/encoding the wire protocol. Do not set this
+to T unless you want to debug swank internals.")
-(defmacro with-swank-error-handler ((connection) &body body)
+(defmacro with-swank-protocol-error-handler ((connection) &body body)
(let ((var (gensym)))
`(let ((,var ,connection))
(handler-case
- (handler-bind ((swank-error
+ (handler-bind ((swank-protocol-error
(lambda (condition)
- (when *debug-on-swank-error*
+ (format t "~&+++ SWANK-PROTOCOL-ERROR: ~S ~S~%"
+ *debug-on-swank-protocol-error*
+ condition)
+ (when *debug-on-swank-protocol-error*
+ (format t "~&+++ INVOKE-DEFAULT-DEBUGGER +++ ~S~%" condition)
(invoke-default-debugger condition)))))
(progn , at body))
- (swank-error (condition)
+ (swank-protocol-error (condition)
(close-connection ,var
- (swank-error.condition condition)
- (swank-error.backtrace condition)))))))
+ (swank-protocol-error.condition condition)
+ (swank-protocol-error.backtrace condition)))))))
(defmacro with-panic-handler ((connection) &body body)
(let ((var (gensym)))
@@ -445,7 +451,7 @@
(let ((*emacs-connection* connection)
(*pending-slime-interrupts* '()))
(without-slime-interrupts
- (with-swank-error-handler (*emacs-connection*)
+ (with-swank-protocol-error-handler (*emacs-connection*)
(with-io-redirection (*emacs-connection*)
(call-with-debugger-hook #'swank-debugger-hook function)))))))
@@ -1055,11 +1061,14 @@
(defun read-loop (connection)
(let ((input-stream (connection.socket-io connection))
(control-thread (connection.control-thread connection)))
- (with-swank-error-handler (connection)
+ (with-swank-protocol-error-handler (connection)
(loop (send control-thread (decode-message input-stream))))))
(defun dispatch-loop (connection)
(let ((*emacs-connection* connection))
+ ;; FIXME: Why do we use WITH-PANIC-HANDLER here, and why is it not
+ ;; appropriate here to use WITH-SWANK-PROTOCOL-ERROR-HANDLER?
+ ;; I think this should be documented.
(with-panic-handler (connection)
(loop (dispatch-event (receive))))))
@@ -1326,7 +1335,7 @@
(let* ((stdin (real-input-stream *standard-input*))
(*standard-input* (make-repl-input-stream connection
stdin)))
- (with-swank-error-handler (connection)
+ (with-swank-protocol-error-handler (connection)
(simple-repl)))))))
(close-connection connection nil (safe-backtrace))))
@@ -1706,7 +1715,7 @@
"Read an S-expression from STREAM using the SLIME protocol."
;;(log-event "decode-message~%")
(let ((*swank-state-stack* (cons :read-next-form *swank-state-stack*)))
- (handler-bind ((error (lambda (c) (error (make-swank-error c)))))
+ (handler-bind ((error (lambda (c) (error (make-swank-protocol-error c)))))
(let ((packet (read-packet stream)))
(handler-case (values (read-form packet) nil)
(reader-error (c)
@@ -1750,7 +1759,7 @@
(send-to-emacs object))
(defun encode-message (message stream)
- (handler-bind ((error (lambda (c) (error (make-swank-error c)))))
+ (handler-bind ((error (lambda (c) (error (make-swank-protocol-error c)))))
(let* ((string (prin1-to-string-for-emacs message))
(length (length string)))
(log-event "WRITE: ~A~%" string)
@@ -1887,6 +1896,17 @@
(finish-output *trace-output*)
nil))
+(defun debug-on-swank-error ()
+ (assert (eq *debug-on-swank-protocol-error* *debug-swank-backend*))
+ *debug-on-swank-protocol-error*)
+
+(defun (setf debug-on-swank-error) (new-value)
+ (setf *debug-on-swank-protocol-error* new-value)
+ (setf *debug-swank-backend* new-value))
+
+(defslimefun toggle-debug-on-swank-error ()
+ (setf (debug-on-swank-error) (not (debug-on-swank-error))))
+
;;;; Reading and printing
@@ -2479,8 +2499,7 @@
(invoke-default-debugger condition))))
(defun invoke-default-debugger (condition)
- (let ((*debugger-hook* nil))
- (invoke-debugger condition)))
+ (call-with-debugger-hook nil (lambda () (invoke-debugger condition))))
(defvar *global-debugger* t
"Non-nil means the Swank debugger hook will be installed globally.")
--- /project/slime/cvsroot/slime/slime.el 2009/12/07 05:55:37 1.1255
+++ /project/slime/cvsroot/slime/slime.el 2009/12/10 23:15:42 1.1256
@@ -1458,6 +1458,12 @@
(assert (integerp port))
port))))
+(defun slime-toggle-debug-on-swank-error ()
+ (interactive)
+ (if (slime-eval `(swank:toggle-debug-on-swank-error))
+ (message "Debug on SWANK error enabled.")
+ (message "Debug on SWANK error disabled.")))
+
;;; Words of encouragement
(defun slime-user-first-name ()
--- /project/slime/cvsroot/slime/ChangeLog 2009/12/10 23:07:38 1.1931
+++ /project/slime/cvsroot/slime/ChangeLog 2009/12/10 23:15:42 1.1932
@@ -1,5 +1,27 @@
2009-12-11 Tobias C. Rittweiler <tcr at freebits.de>
+ Add `M-x slime-toggle-debug-on-swank-error'.
+
+ In "Debug on SWANK error" mode, errors which are normally caught
+ to not annoy the user, will now drop into the debugger.
+
+ Additionally, the backend won't do any backtrace magic so you'll
+ see the full backtrace with all its glory details.
+
+ SBCL only so far.
+
+ * slime.el (slime-toggle-debug-on-swank-error): New.
+
+ * swank.lisp (toggle-debug-on-swank-error): New slimefun.
+ (debug-on-swank-error): New function. SETFable.
+ (invoke-default-debugger): Use CALL-WITH-DEBUGGER-HOOK so we're
+ trapped into the native debugger on SBCL (previously we weren't
+ due to SB-EXT:*INVOKE-DEBUGGER-HOOK*.)
+
+ * swank.lisp: Rename SWANK-ERROR to SWANK-PROTOCOL-ERROR.
+
+2009-12-11 Tobias C. Rittweiler <tcr at freebits.de>
+
* swank-sbcl.lisp (call-with-debugger-hook): Oops, removed the
binding for *DEBUGGER-HOOK*. Fix that.
(make-invoke-debugger-hook): Do nothing if hook is NIL.
More information about the slime-cvs
mailing list