Skip to content

Instantly share code, notes, and snippets.

@luismbo
Last active August 29, 2015 14:21
Show Gist options
  • Save luismbo/edbff74733812f57c5d9 to your computer and use it in GitHub Desktop.
Save luismbo/edbff74733812f57c5d9 to your computer and use it in GitHub Desktop.
Failed attempt at tracking output
(defun tracking-pprint-to-string/sbcl (object)
(let ((positions nil)
(original-table *print-pprint-dispatch*)
(table (copy-pprint-dispatch)))
(values (with-output-to-string (stream)
(set-pprint-dispatch 'cons
(lambda (stream cons)
(push (list (+ (sb-pretty::pretty-stream-buffer-fill-pointer stream)
(sb-pretty::pretty-stream-buffer-offset stream))
cons)
positions)
(funcall (pprint-dispatch cons original-table) stream cons))
most-positive-fixnum
table)
(write object
:stream stream
:pretty t
:pprint-dispatch table))
positions)))
(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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment