Changeset 13387 for release/1.4/source/level-1/l1-readloop-lds.lisp

Timestamp:

Jan 14, 2010, 8:49:15 AM (11 years ago)

Author:

gb

Message:

Propagate r13368 to 1.4. See ticket:642 .

File:

• release/1.4/source/level-1/l1-readloop-lds.lisp (modified) (1 diff)

release/1.4/source/level-1/l1-readloop-lds.lisp

@@ -555 +555 @@
         (*print-right-margin* nil)
         (*signal-printing-errors* nil)
-        (s (make-indenting-string-output-stream prefixchar nil)))
+        (s (make-indenting-string-output-stream prefixchar nil))
+        (sub (make-string-output-stream))
+        (indent 0))
     (format s "~A ~A: " prefixchar msg)
-    (setf (indenting-string-output-stream-indent s) (column s))
+    (setf (indenting-string-output-stream-indent s) (setq indent (column s)))
+    (decf (stream-line-length sub) indent)
     ;(format s "~A" condition) ; evil if circle
-    (report-condition condition s)
+    (report-condition condition sub)
+    (format s "~A" (get-output-stream-string sub))
     (if (not (and (typep condition 'simple-program-error)
                   (simple-program-error-context condition)))