|
(in-package :swank-macrostep) |
|
|
|
(defparameter *dbg* nil) |
|
|
|
(defclass tracking-string-output-stream |
|
(swank/gray:fundamental-character-output-stream) |
|
((output :initarg :output :accessor output-of |
|
:initform (make-array 30 |
|
:adjustable t |
|
:fill-pointer 0 |
|
:element-type 'character)) |
|
(position :initform 0 :accessor position-of))) |
|
|
|
(defmethod swank/gray:stream-write-char ((stream tracking-string-output-stream) |
|
character) |
|
(vector-push-extend character (output-of stream)) |
|
(push (incf (position-of stream)) *dbg*)) |
|
|
|
(let ((result) |
|
(position 0) |
|
(stream (make-instance 'tracking-string-output-stream)) |
|
(table (copy-pprint-dispatch))) |
|
(set-pprint-dispatch 'cons |
|
(lambda (stream cons) |
|
(push cons *dbg*) |
|
(pprint-fill stream cons)) |
|
0 |
|
table) |
|
(write '(unless t (foo)) |
|
:stream stream |
|
:pretty t |
|
:pprint-dispatch table) |
|
*dbg*) |
|
; => |
|
((UNLESS T (FOO)) (FOO) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16) |