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

diff --git a/src/utilities.lisp b/src/utilities.lisp
index dfe2454..6663441 100644
--- a/src/utilities.lisp
+++ b/src/utilities.lisp
@@ -7,7 +7,7 @@
 
 ;;;----- Licensing notice ---------------------------------------------------
 ;;;
-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; This file is part of the Sensible Object Design, an object system for C.
 ;;;
 ;;; SOD is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
@@ -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.