Changeset 13508

Timestamp:

Mar 9, 2010, 11:56:34 AM (15 years ago)

Author:

gz

Message:

From trunk: r13368 (stream-line-length, error message printing tweak)

Location:

branches/working-0711/ccl

Files:

• . (modified) (1 prop)
• level-1/l1-readloop-lds.lisp (modified) (1 diff)
• level-1/l1-streams.lisp (modified) (3 diffs)
• lib/streams.lisp (modified) (1 diff)

branches/working-0711/ccl/level-1/l1-readloop-lds.lisp

@@ -561 +561 @@
         (*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)))

branches/working-0711/ccl/level-1/l1-streams.lisp

@@ -4236 +4236 @@
 (defstruct (string-output-stream-ioblock (:include string-stream-ioblock))
   (index 0)
-  freelist)
+  freelist
+  (line-length 80))
 
 (defstatic *string-output-stream-class* (make-built-in-class 'string-output-stream 'string-stream 'basic-character-output-stream))
@@ -4253 +4254 @@
 (defmethod stream-clear-output ((s string-output-stream))
   nil)
+
+(defmethod stream-line-length ((s string-output-stream))
+  (let* ((ioblock (basic-stream-ioblock s)))
+    (string-output-stream-ioblock-line-length ioblock)))
+
+(defmethod (setf stream-line-length) (newlen (s string-output-stream))
+  (let* ((ioblock (basic-stream-ioblock s)))
+    (setf (string-output-stream-ioblock-line-length ioblock) newlen)))
+
 
 ;;; Should only be used for a stream whose class is exactly
@@ -4290 +4300 @@
                                    (ioblock-device data) -1
                                    (ioblock-charpos data) 0
-                                   (string-output-stream-ioblock-index data) 0))
+                                   (string-output-stream-ioblock-index data) 0
+                                   (string-output-stream-ioblock-line-length data) 80))
                            data)))))
     (or recycled (apply #'make-string-output-stream-ioblock keys))))

branches/working-0711/ccl/lib/streams.lisp

@@ -131 +131 @@
 
 (defun line-length (stream)
-  (declare (ignore stream))
-  80)
+  (or (stream-line-length stream) 80))
 
 (defun write-byte (byte stream)