- (:element-type (array-element-type
- (fill-pointer-output-stream-string stream)))))
-\f
-;;;; indenting streams
-
-(defstruct (indenting-stream (:include ansi-stream
- (out #'indenting-out)
- (sout #'indenting-sout)
- (misc #'indenting-misc))
- (:constructor make-indenting-stream (stream))
- (:copier nil))
- ;; the stream we're based on
- stream
- ;; how much we indent on each line
- (indentation 0))
-
-#!+sb-doc
-(setf (fdocumentation 'make-indenting-stream 'function)
- "Return an output stream which indents its output by some amount.")
-
-;;; INDENTING-INDENT writes the correct number of spaces needed to indent
-;;; output on the given STREAM based on the specified SUB-STREAM.
-(defmacro indenting-indent (stream sub-stream)
- ;; KLUDGE: bare magic number 60
- `(do ((i 0 (+ i 60))
- (indentation (indenting-stream-indentation ,stream)))
- ((>= i indentation))
- (%write-string
- #.(make-string 60 :initial-element #\Space)
- ,sub-stream
- 0
- (min 60 (- indentation i)))))
-
-;;; INDENTING-OUT writes a character to an indenting stream.
-(defun indenting-out (stream char)
- (let ((sub-stream (indenting-stream-stream stream)))
- (write-char char sub-stream)
- (if (char= char #\newline)
- (indenting-indent stream sub-stream))))
-
-;;; INDENTING-SOUT writes a string to an indenting stream.
-(defun indenting-sout (stream string start end)
- (declare (simple-string string) (fixnum start end))
- (do ((i start)
- (sub-stream (indenting-stream-stream stream)))
- ((= i end))
- (let ((newline (position #\newline string :start i :end end)))
- (cond (newline
- (%write-string string sub-stream i (1+ newline))
- (indenting-indent stream sub-stream)
- (setq i (+ newline 1)))
- (t
- (%write-string string sub-stream i end)
- (setq i end))))))
-
-;;; INDENTING-MISC just treats just the :LINE-LENGTH message
-;;; differently. INDENTING-CHARPOS says the charpos is the charpos of
-;;; the base stream minus the stream's indentation.
-(defun indenting-misc (stream operation &optional arg1 arg2)
- (let ((sub-stream (indenting-stream-stream stream)))
- (if (ansi-stream-p sub-stream)
- (let ((method (ansi-stream-misc sub-stream)))
- (case operation
- (:line-length
- (let ((line-length (funcall method sub-stream operation)))
- (if line-length
- (- line-length (indenting-stream-indentation stream)))))
- (:charpos
- (let ((charpos (funcall method sub-stream operation)))
- (if charpos
- (- charpos (indenting-stream-indentation stream)))))
- (t
- (funcall method sub-stream operation arg1 arg2))))
- ;; must be Gray streams FUNDAMENTAL-STREAM
- (case operation
- (:line-length
- (let ((line-length (stream-line-length sub-stream)))
- (if line-length
- (- line-length (indenting-stream-indentation stream)))))
- (:charpos
- (let ((charpos (stream-line-column sub-stream)))
- (if charpos
- (- charpos (indenting-stream-indentation stream)))))
- (t
- (stream-misc-dispatch sub-stream operation arg1 arg2))))))
-
-(declaim (maybe-inline read-char unread-char read-byte listen))