[slime-cvs] CVS update: slime/present.lisp

[Matthias Koeppe]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv29367

Modified Files:
	present.lisp 
Log Message:
(slime-stream-p) 
[cmu]: Allow printing presentations through pretty printing
streams, if CMUCL has annotations support and we are using the
bridge-less protocol.
[sbcl]: Allow printing presentations through indenting streams.

Date: Thu Aug  4 22:13:07 2005
Author: mkoeppe

Index: slime/present.lisp
diff -u slime/present.lisp:1.8 slime/present.lisp:1.9
--- slime/present.lisp:1.8	Thu Aug  4 21:54:43 2005
+++ slime/present.lisp	Thu Aug  4 22:13:07 2005
@@ -79,8 +79,21 @@
 					;(slime-stream-p (ccl::xp-base-stream (slot-value stream 'ccl::xp-structure)))
 			 (slime-stream-p (ccl::%svref (slot-value stream 'ccl::xp-structure) 1)))
 		    #+cmu
-		    (and (typep stream 'pretty-print::pretty-stream)
-			 (slime-stream-p (pretty-print::pretty-stream-target  stream)))
+		    (or (and (typep stream 'lisp::indenting-stream)
+			     (slime-stream-p (lisp::indenting-stream-stream stream)))
+			(and (typep stream 'pretty-print::pretty-stream)
+			     (fboundp 'pretty-print::enqueue-annotation)
+			     (not *use-dedicated-output-stream*)
+			     ;; Printing through CMUCL pretty streams
+			     ;; is only cleanly possible if we are
+			     ;; using the bridge-less protocol with
+			     ;; annotations, because the bridge escape
+			     ;; sequences disturb the pretty printer
+			     ;; layout.
+			     (slime-stream-p (pretty-print::pretty-stream-target  stream))))
+		    #+sbcl
+		    (and (typep stream 'sb-impl::indenting-stream)
+			 (slime-stream-p (sb-impl::indenting-stream-stream stream)))
 		    #+allegro
 		    (and (typep stream 'excl:xp-simple-stream)
 			 (slime-stream-p (excl::stream-output-handle stream)))
@@ -102,7 +115,13 @@
   (if (typep stream 'excl:xp-simple-stream)
       (excl::schedule-annotation stream function arg)
       (funcall function arg stream nil)))
-#-allegro
+#+cmu
+(defun write-annotation (stream function arg)
+  (if (and (typep stream 'pp:pretty-stream)
+	   (fboundp 'pp::enqueue-annotation))
+      (pp::enqueue-annotation stream function arg)
+      (funcall function arg stream nil)))
+#-(or allegro cmu)
 (defun write-annotation (stream function arg)
   (funcall function arg stream nil))