From 03ec54a9e951319730e64f7da6c7d157c5d49b0e Mon Sep 17 00:00:00 2001 From: "Tarn W. Burton" Date: Sat, 14 Jan 2023 16:14:35 -0500 Subject: [PATCH] Move inravina client --- src/lisp/kernel/lsp/format-pprint.lisp | 24 ++++++------------------ src/lisp/kernel/lsp/pprint.lisp | 2 +- 2 files changed, 7 insertions(+), 19 deletions(-) diff --git a/src/lisp/kernel/lsp/format-pprint.lisp b/src/lisp/kernel/lsp/format-pprint.lisp index 861c3791c1..2751216309 100644 --- a/src/lisp/kernel/lsp/format-pprint.lisp +++ b/src/lisp/kernel/lsp/format-pprint.lisp @@ -20,21 +20,6 @@ (in-package "SYS") -;;; The guts of print-unreadable-object, inspired by SBCL. This is -;;; a redefinition of the function in iolib.lisp which add support -;;; for pprint-logical-block. -(defun %print-unreadable-object (object stream type identity body) - (cond (*print-readably* - (error 'print-not-readable :object object)) - ((and *print-pretty* (inravina:pretty-stream-p inravina:*client* stream)) - (pprint-logical-block (stream nil :prefix "#<" :suffix ">") - (print-unreadable-object-contents object stream type identity body))) - (t - (write-string "#<" stream) - (print-unreadable-object-contents object stream type identity body) - (write-char #\> stream))) - nil) - ;;;; Format directive definition macros and runtime support. (defmacro expander-pprint-next-arg (string offset) @@ -84,7 +69,7 @@ (write-string spaces stream :end n))) (defun format-relative-tab (stream colrel colinc) - (if (inravina:pretty-stream-p inravina:*client* stream) + (if (inravina:pretty-stream-p inravina-intrinsic:*client* stream) (pprint-tab :line-relative colrel colinc stream) (let* ((cur (#-(or ecl clasp) sys::charpos #+(or ecl clasp) sys::file-column stream)) (spaces (if (and cur (plusp colinc)) @@ -93,7 +78,7 @@ (output-spaces stream spaces)))) (defun format-absolute-tab (stream colnum colinc) - (if (inravina:pretty-stream-p inravina:*client* stream) + (if (inravina:pretty-stream-p inravina-intrinsic:*client* stream) (pprint-tab :line colnum colinc stream) (let ((cur (#-(or ecl clasp) sys::charpos #+(or ecl clasp) sys:file-column stream))) (cond ((null cur) @@ -483,7 +468,10 @@ (error 'format-error :complaint "No corresponding open bracket.")) -(setf inravina:*client* (make-instance 'incless-native:native-client) +(defclass printer-client (incless-native:native-client inravina-intrinsic:intrinsic-client) + ()) + +(setf inravina-intrinsic:*client* (make-instance 'printer-client) (first (cdr si::+io-syntax-progv-list+)) inravina-intrinsic:*standard-pprint-dispatch*) diff --git a/src/lisp/kernel/lsp/pprint.lisp b/src/lisp/kernel/lsp/pprint.lisp index c87241d0bf..b5bef64d44 100644 --- a/src/lisp/kernel/lsp/pprint.lisp +++ b/src/lisp/kernel/lsp/pprint.lisp @@ -18,7 +18,7 @@ (defun %print-unreadable-object (object stream type identity body) (cond (*print-readably* (error 'print-not-readable :object object)) - ((and *print-pretty* (inravina:pretty-stream-p inravina:*client* stream)) + ((and *print-pretty* (inravina:pretty-stream-p inravina-intrinsic:*client* stream)) (pprint-logical-block (stream nil :prefix "#<" :suffix ">") (print-unreadable-object-contents object stream type identity body))) (t