X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/e0808c472145fc81e52898bc9ac289e10c4f4f41..77d83e015f7cd280b385ad53c486e2c27ad6152f:/src/utilities.lisp

diff --git a/src/utilities.lisp b/src/utilities.lisp
index 17260f4..6663441 100644
--- a/src/utilities.lisp
+++ b/src/utilities.lisp
@@ -714,6 +714,28 @@
 	     (,print))
 	   (,print)))))
 
+(export 'print-ugly-stuff)
+(defun print-ugly-stuff (stream func)
+  "Print not-pretty things to the stream underlying STREAM.
+
+   The Lisp pretty-printing machinery, notably `pprint-logical-block', may
+   interpose additional streams between its body and the original target
+   stream.  This makes it difficult to make use of the underlying stream's
+   special features, whatever they might be."
+
+  ;; This is unpleasant.  Hacky hacky.
+  #.(or #+sbcl '(if (typep stream 'sb-pretty:pretty-stream)
+		  (let ((target (sb-pretty::pretty-stream-target stream)))
+		    (pprint-newline :mandatory stream)
+		    (funcall func target))
+		  (funcall func stream))
+	#+cmu '(if (typep stream 'pp:pretty-stream)
+		  (let ((target (pp::pretty-stream-target stream)))
+		    (pprint-newline :mandatory stream)
+		    (funcall func target))
+		  (funcall func stream))
+	'(funcall func stream)))
+
 ;;;--------------------------------------------------------------------------
 ;;; Iteration macros.