[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
* swank.lisp (safe-condition-message): Truncate the string after 64KB.

--- /project/slime/cvsroot/slime/ChangeLog	2012/10/27 17:17:19	1.2357
+++ /project/slime/cvsroot/slime/ChangeLog	2012/10/27 17:53:39	1.2358
@@ -1,7 +1,8 @@
 2012-10-27  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (report-condition-with-circular-list): New test.
-	* swank.lisp (safe-condition-message): Bind *print-length*.
+	* swank.lisp (safe-condition-message): Bind *print-length* and
+	truncate the string after 64KB.
 
 2012-10-20  Stas Boukarev  <stassats at gmail.com>
 
--- /project/slime/cvsroot/slime/slime.el	2012/10/27 17:17:19	1.1417
+++ /project/slime/cvsroot/slime/slime.el	2012/10/27 17:53:39	1.1418
@@ -8218,7 +8218,9 @@
     (format-control format-argument)
     "Test conditions involving circular lists."
     '(("~a" "(let ((x (cons nil nil))) (setf (cdr x) x))")
-      ("~a" "(let ((x (cons nil nil))) (setf (car x) x))"))
+      ("~a" "(let ((x (cons nil nil))) (setf (car x) x))")
+      ("~a" "(let ((x (cons (make-string 100000 :initial-element #\\X) nil)))\
+                (setf (cdr x) x))"))
   (slime-check-top-level)
   (lexical-let ((done nil))
     (let ((sldb-hook (lambda () (sldb-continue) (setq done t))))
@@ -9366,7 +9368,7 @@
 (provide 'slime)
 (run-hooks 'slime-load-hook)
 
-;; Local Variables: 
+;; Local Variables:
 ;; lexical-binding: t
 ;; outline-regexp: ";;;;+"
 ;; indent-tabs-mode: nil
--- /project/slime/cvsroot/slime/swank.lisp	2012/10/27 17:17:20	1.793
+++ /project/slime/cvsroot/slime/swank.lisp	2012/10/27 17:53:39	1.794
@@ -2166,13 +2166,16 @@
 printing."
   (let ((*print-pretty* t) (*print-right-margin* 65)
         (*print-length* 1000) (*print-level* 200))
-    (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)))))))
+    (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*)