[slime-devel] Allegro/CMUCL patch for presentations.lisp

[Alan Ruttenberg]

Hi Matthias

Thanks for the patches!
I apologize for the delay in merging them. I've been rather busy but 
hope to address them in the next couple of days.

Thanks again,
Alan

On Jun 28, 2005, at 9:22 AM, Matthias Koeppe wrote:

> I am sending another patch related to presentations.  It contains
> improvements specific to CMUCL and Allegro CL.
>
> Would someone like to handle this (and the previous) patch?
>
> Cheers,
> Matthias
>
> 2005-06-28  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
>
> 	* present.lisp (slime-stream-p) [cmu]: Handle indenting-streams
> 	whose base streams are SLIME streams.  These occur in logical
> 	blocks in pretty-printing.
> 	[allegro]: Handle xp-simple-streams whose base streams are SLIME
> 	streams.
>
> 	* present.lisp (presenting-object-1) [allegro]: Unconfuse the
> 	pretty printer.
>
> 	* present.lisp [allegro]: Add fwrappers for printing pathnames and
> 	unreadable objects as presentations.
>
> --- present.lisp.~1.4.~	2005-05-24 04:42:01.000000000 +0200
> +++ present.lisp	2005-06-28 15:04:16.680297000 +0200
> @@ -82,8 +82,13 @@
>  					;(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)
> +			     (slime-stream-p (pretty-print::pretty-stream-target  
> stream))))
> +		    #+allegro
> +		    (and (typep stream 'excl:xp-simple-stream)
> +			 (slime-stream-p (excl::stream-output-handle stream)))
>  		    (loop for connection in *connections*
>  			  thereis (or (eq stream (connection.dedicated-output connection))
>  				      (eq stream (connection.socket-io connection))
> @@ -94,20 +99,39 @@
>    (declare (ignore stream))
>    *enable-presenting-readable-objects*)
>
> +;; If we are printing to an XP (pretty printing) stream, printing the
> +;; escape sequences directly would mess up the layout because column
> +;; counting is disturbed.  Use "annotations" instead.
> +#+allegro
> +(defmacro annotating ((base-stream stream) &body body)
> +  `(if (typep ,stream 'excl:xp-simple-stream)
> +       (excl::schedule-annotation ,stream (lambda (.ignore. 
> ,base-stream .ignore2.)
> +					    (declare (ignore .ignore. .ignore2.))
> +					    , at body)
> +				  nil)
> +       (let ((,base-stream ,stream))
> +	 , at body)))
> +#-allegro
> +(defmacro annotating ((base-stream stream) &body body)
> +  `(let ((,base-stream ,stream))
> +     , at body))
> +
>  (defun presenting-object-1 (object stream continue)
>    "Uses the bridge mechanism with two messages >id and <id. The first 
> one
>  says that I am starting to print an object with this id. The second 
> says I am finished"
>    (if (and *record-repl-results* *can-print-presentation*
>  	   (slime-stream-p stream))
>        (let ((pid (swank::save-presented-object object)))
> -	(write-string "<" stream)
> -	(prin1 pid stream)
> -	(write-string "" stream)
> +	(annotating (base-stream stream)
> +	  (write-string "<" base-stream)
> +	  (prin1 pid base-stream)
> +	  (write-string "" base-stream))
>  	(multiple-value-prog1
>  	    (funcall continue)
> -	  (write-string ">" stream)
> -	  (prin1 pid stream)
> -	  (write-string "" stream)))
> +	  (annotating (base-stream stream)
> +	    (write-string ">" base-stream)
> +	    (prin1 pid base-stream)
> +	    (write-string "" base-stream))))
>        (funcall continue)))
>
>  ;; enable presentations inside listener eval, when compiling, when 
> evaluating
> @@ -371,3 +395,15 @@
>    (fwrappers::fwrap 'lisp::%print-pathname  
> #'presenting-pathname-wrapper)
>    (fwrappers::fwrap 'lisp::%print-unreadable-object  
> #'presenting-unreadable-wrapper)
>    )
> +
> +#+allegro
> +(progn
> +  (excl:def-fwrapper presenting-unreadable-wrapper (object stream 
> type identity continuation)
> +    (swank::presenting-object object stream 
> (excl:call-next-fwrapper)))
> +  (excl:def-fwrapper presenting-pathname-wrapper (pathname stream 
> depth)
> +    (presenting-object-if (can-present-readable-objects stream) 
> pathname stream
> +      (excl:call-next-fwrapper)))
> +  (excl:fwrap 'excl::print-unreadable-object-1
> +	      'print-unreadable-present 'presenting-unreadable-wrapper)
> +  (excl:fwrap 'excl::pathname-printer
> +	      'print-pathname-present 'presenting-pathname-wrapper))
>
>
> -- 
> Matthias Koeppe -- http://www.math.uni-magdeburg.de/~mkoeppe
> _______________________________________________
> slime-devel site list
> slime-devel at common-lisp.net
> http://common-lisp.net/mailman/listinfo/slime-devel