[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog swank.lisp 
Log Message:
* swank.lisp (condition-message): New. Binds *print-cirlce.
(safe-condition-message): Move binding of printer vars to
condition-message.
(*sldb-condition-printer*): Set it to #'condition-message.

--- /project/slime/cvsroot/slime/ChangeLog	2012/11/02 08:14:28	1.2361
+++ /project/slime/cvsroot/slime/ChangeLog	2012/11/02 08:14:42	1.2362
@@ -1,5 +1,12 @@
 2012-11-02  Helmut Eller  <heller at common-lisp.net>
 
+	* swank.lisp (condition-message): New. Binds *print-cirlce.
+	(safe-condition-message): Move binding of printer vars to
+	condition-message.
+	(*sldb-condition-printer*): Set it to #'condition-message.
+
+2012-11-02  Helmut Eller  <heller at common-lisp.net>
+
 	* swank-allegro.lisp (frame-source-location, ldb-code-to-src-loc):
 	Use function-source-location for some cases that used to cause
 	errors.
--- /project/slime/cvsroot/slime/swank.lisp	2012/10/27 17:53:39	1.794
+++ /project/slime/cvsroot/slime/swank.lisp	2012/11/02 08:14:42	1.795
@@ -2158,24 +2158,28 @@
     (send-to-emacs `(:debug-condition ,(current-thread-id)
                                       ,(princ-to-string real-condition)))))
 
-(defvar *sldb-condition-printer* #'format-sldb-condition
+(defun condition-message (condition)
+  (let ((*print-pretty* t)
+        (*print-right-margin* 65)
+        (*print-circle* t))
+    (format-sldb-condition condition)))
+
+(defvar *sldb-condition-printer* #'condition-message
   "Function called to print a condition to an SLDB buffer.")
 
 (defun safe-condition-message (condition)
   "Safely print condition to a string, handling any errors during
 printing."
-  (let ((*print-pretty* t) (*print-right-margin* 65)
-        (*print-length* 1000) (*print-level* 200))
-    (truncate-string
-     (handler-case
-         (funcall *sldb-condition-printer* condition)
-       (error (cond)
-         ;; Beware of recursive errors in printing, so only use the condition
-         ;; if it is printable itself:
-         (format nil "Unable to display error condition~@[: ~A~]"
-                 (ignore-errors (princ-to-string cond)))))
-     (ash 1 16)
-     "...")))
+  (truncate-string
+   (handler-case
+       (funcall *sldb-condition-printer* condition)
+     (error (cond)
+       ;; Beware of recursive errors in printing, so only use the condition
+       ;; if it is printable itself:
+       (format nil "Unable to display error condition~@[: ~A~]"
+               (ignore-errors (princ-to-string cond)))))
+   (ash 1 16)
+   "..."))
 
 (defun debugger-condition-for-emacs ()
   (list (safe-condition-message *swank-debugger-condition*)