Skip to content
Snippets Groups Projects
stream.lisp 40.8 KiB
Newer Older
ram's avatar
ram committed

;;;; Indenting streams:

(defstruct (indenting-stream (:include stream
				       (out #'indenting-out)
				       (sout #'indenting-sout)
				       (misc #'indenting-misc))
			     (:print-function %print-indenting-stream)
			     (:constructor make-indenting-stream (stream)))
  ;; The stream we're based on:
  stream
  ;; How much we indent on each line:
  (indentation 0))

(setf (documentation 'make-indenting-stream 'function)
 "Returns an ouput stream which indents its output by some amount.")

(defun %print-indenting-stream (s stream d)
  (declare (ignore s d))
  (write-string "#<Indenting Stream>" stream))

;;; Indenting-Indent writes the right number of spaces needed to indent output on
;;; the given Stream based on the specified Sub-Stream.

(defmacro indenting-indent (stream sub-stream)
  `(do ((i 0 (+ i 60))
	(indentation (indenting-stream-indentation ,stream)))
       ((>= i indentation))
     (funcall (stream-sout ,sub-stream) ,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)))
    (funcall (stream-out sub-stream) sub-stream char)
    (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
	     (funcall (stream-sout sub-stream) sub-stream string i (1+ newline))
	     (indenting-indent stream sub-stream)
	     (setq i (+ newline 1)))
	    (t
	     (funcall (stream-sout sub-stream) sub-stream string 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))
	 (method (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* ((sub-stream (indenting-stream-stream stream))
	      (charpos (funcall method sub-stream operation)))
	 (if charpos
	     (- charpos (indenting-stream-indentation stream)))))       
      (t
       (funcall method sub-stream operation arg1 arg2)))))

(proclaim '(notinline read-char unread-char read-byte listen))