[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog swank.lisp 
Log Message:
* swank.lisp (*sldb-pprint-dispatch-table*): Honor *print-escape*

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/08 06:45:37	1.1646
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/08 06:45:45	1.1647
@@ -1,5 +1,9 @@
 2009-01-07  Helmut Eller  <heller at common-lisp.net>
 
+	* swank.lisp (*sldb-pprint-dispatch-table*): Honor *print-escape*
+
+2009-01-07  Helmut Eller  <heller at common-lisp.net>
+
 	* swank-cmucl.lisp (frame-locals, frame-debug-vars): Remove
 	non-valid variables.
 	(debug-var-value): Compute the location from the frame arg.
--- /project/slime/cvsroot/slime/swank.lisp	2009/01/05 11:14:13	1.625
+++ /project/slime/cvsroot/slime/swank.lisp	2009/01/08 06:45:45	1.626
@@ -116,16 +116,21 @@
                        (write bit :stream stream))))
            (sldb-string-pprint (stream string)
              ;;; Truncate strings according to *SLDB-STRING-LENGTH*.
-             (if (or (not *print-array*) (not *print-length*))
-                 (let ((*print-pprint-dispatch* initial-table))
-                   (write string :stream stream))
-                 (loop initially (write-char #\" stream)
-                       for i from 0 and char across string do
-                       (when (= i *sldb-string-length*)
-                         (write-string "..." stream)
-                         (loop-finish))
-                       (write-char char stream)
-                       finally (write-char #\" stream)))))
+             (cond ((or (not *print-array*) (not *print-length*))
+                    (let ((*print-pprint-dispatch* initial-table))
+                      (write string :stream stream)))
+                   ((not *print-escape*)
+                    (write-string string stream))
+                   (t
+                    (loop initially (write-char #\" stream)
+                          for i from 0 and char across string do
+                          (cond ((= i *sldb-string-length*)
+                                 (write-string "..." stream)
+                                 (loop-finish))
+                                ((char= char #\")
+                                 (write-string "\\\"" stream))
+                                (t (write-char char stream)))
+                          finally (write-char #\" stream))))))
       (set-pprint-dispatch 'bit-vector #'sldb-bitvector-pprint 0 result-table)
       (set-pprint-dispatch 'string #'sldb-string-pprint 0 result-table)
       result-table)))