Changeset 13272 for trunk/abcl/src/org


Ignore:
Timestamp:
04/27/11 20:30:26 (10 years ago)
Author:
Mark Evenson
Message:

Fix pprint routines using SYS:OUTPUT-OBJECT to a GRAY-STREAM.

Correct the renaming of ABCL SYSTEM functions that aren't part of the
ANSI standard.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/gray-streams.lisp

    r13255 r13272  
    165165(defvar *ansi-write-string* #'write-string)
    166166(defvar *ansi-write-line* #'write-line)
    167 (defvar *ansi-force-output* #'sys::%force-output)
    168 (defvar *ansi-finish-output* #'sys::%finish-output)
    169 (defvar *ansi-clear-output* #'sys::%clear-output)
     167(defvar *sys-%force-output* #'sys::%force-output)
     168(defvar *sys-%finish-output* #'sys::%finish-output)
     169(defvar *sys-%clear-output* #'sys::%clear-output)
     170(defvar *sys-%output-object* #'sys::%output-object)
    170171(defvar *ansi-clear-input* #'clear-input)
    171172(defvar *ansi-read-byte* #'read-byte)
     
    462463        (stream-clear-input stream))))
    463464
     465(defun gray-output-object (object stream)
     466  (if (ansi-streamp stream)
     467      (funcall *sys-%output-object* object stream)
     468      (stream-write-string stream
     469                           (with-output-to-string (s)
     470                             (funcall *sys-%output-object* object s)))))
     471
    464472(defun gray-read-char-no-hang (&optional input-stream (eof-errorp t)
    465473                                         eof-value recursive-p)
     
    506514  (let ((stream (decode-print-arg output-stream)))
    507515    (if (ansi-streamp stream)
    508         (funcall *ansi-force-output* stream)
     516        (funcall *sys-%force-output* stream)
    509517        (stream-force-output stream))))
    510518
     
    512520  (let ((stream (decode-print-arg output-stream)))
    513521    (if (ansi-streamp stream)
    514         (funcall *ansi-finish-output* stream)
     522        (funcall *sys-%finish-output* stream)
    515523        (stream-finish-output stream))))
    516524
     
    518526  (let ((stream (decode-print-arg output-stream)))
    519527    (if (ansi-streamp stream)
    520         (funcall *ansi-clear-output* stream)
     528        (funcall *sys-%clear-output* stream)
    521529        (stream-clear-output stream))))
    522530
     
    618626(setf (symbol-function 'sys::%finish-output) #'gray-finish-output)
    619627(setf (symbol-function 'sys::%clear-output) #'gray-clear-output)
     628(setf (symbol-function 'sys::%output-object) #'gray-output-object)
    620629(setf (symbol-function 'common-lisp::read-byte) #'gray-read-byte)
    621630(setf (symbol-function 'common-lisp::write-byte) #'gray-write-byte)
Note: See TracChangeset for help on using the changeset viewer.