[slime-devel] Allegro/CMUCL patch for presentations.lisp
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@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.)) + ,@body) + nil) + (let ((,base-stream ,stream)) + ,@body))) +#-allegro +(defmacro annotating ((base-stream stream) &body body) + `(let ((,base-stream ,stream)) + ,@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
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@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.)) + ,@body) + nil) + (let ((,base-stream ,stream)) + ,@body))) +#-allegro +(defmacro annotating ((base-stream stream) &body body) + `(let ((,base-stream ,stream)) + ,@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@common-lisp.net http://common-lisp.net/mailman/listinfo/slime-devel
participants (2)
-
Alan Ruttenberg -
Matthias Koeppe