(FILECREATED "25-Jun-86 16:02:38" {ERIS}<LISPCORE>LIBRARY>CMLPRINT.;22
 8900   

      changes to:  (VARS CMLPRINTCOMS)
                   (FUNCTIONS WRITE-LINE)

      previous date: "17-Jun-86 14:32:00" {ERIS}<LISPCORE>LIBRARY>CMLPRINT.;21)


(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT CMLPRINTCOMS)

(RPAQQ CMLPRINTCOMS
 [(FNS WRITE \WRITE1 WRITE-CHAR CL:PRIN1 CL:PRINT CL:TERPRI FRESH-LINE 
                          FINISH-OUTPUT FORCE-OUTPUT CLEAR-OUTPUT PPRINT PRINC)
                     (FNS WRITE-TO-STRING PRIN1-TO-STRING PRINC-TO-STRING)
                     (FUNCTIONS WRITE-LINE)
                     (* WRITE-STRING is in CMLSTREAMS)
                     (INITVARS (*PRINT-STRUCTURE*))
                     (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
                            (ADDVARS (NLAMA)
                                   (NLAML)
                                   (LAMA WRITE-TO-STRING PRINC PPRINT CL:PRINT CL:PRIN1 WRITE-CHAR 
                                         \WRITE1 WRITE])
(DEFINEQ

(WRITE

  (CL:LAMBDA (OBJECT &KEY (STREAM *STANDARD-OUTPUT*)
                    ((:ESCAPE *PRINT-ESCAPE*)
                     *PRINT-ESCAPE*)
                    ((:RADIX *PRINT-RADIX*)
                     *PRINT-RADIX*)
                    ((:BASE *PRINT-BASE*)
                     *PRINT-BASE*)
                    ((:LEVEL *PRINT-LEVEL*)
                     *PRINT-LEVEL*)
                    ((:LENGTH *PRINT-LENGTH*)
                     *PRINT-LENGTH*)
                    ((:CASE *PRINT-CASE*)
                     *PRINT-CASE*)
                    ((:GENSYM *PRINT-GENSYM*)
                     *PRINT-GENSYM*)
                    ((:ARRAY *PRINT-ARRAY*)
                     *PRINT-ARRAY*)
                    ((:PRETTY *PRINT-PRETTY*)
                     *PRINT-PRETTY*)
                    ((:CIRCLE *PRINT-CIRCLE*)
                     *PRINT-CIRCLE*))
                        (* jrb: "17-Jun-86 13:59")

         (DECLARE
 (SPECIAL *PRINT-ESCAPE* *PRINT-RADIX* *PRINT-BASE* *PRINT-LEVEL* *PRINT-LENGTH* 
                         *PRINT-CASE* *PRINT-GENSYM* *PRINT-ARRAY* *PRINT-PRETTY* *PRINT-CIRCLE* 
                         *PRINT-CIRCLE-HASHTABLE* *PRINT-CIRCLE-NUMBER* THERE-ARE-CIRCLES))
         (CL:IF *PRINT-CIRCLE* (CL:IF *PRINT-CIRCLE-HASHTABLE* (\WRITE1
 OBJECT STREAM)
                                      (LET ((*PRINT-CIRCLE-NUMBER* 1)
                                            (*PRINT-CIRCLE-HASHTABLE* (MAKE-HASH-TABLE))
                                            THERE-ARE-CIRCLES)
                                           (DECLARE
 (SPECIAL *PRINT-CIRCLE-NUMBER* 
                                                           *PRINT-CIRCLE-HASHTABLE* THERE-ARE-CIRCLES
                                                           ))
                                           (PRINT-CIRCLE-SCAN OBJECT)
                                           (CL:IF (NOT THERE-ARE-CIRCLES)
                                                  (CL:SETQ *PRINT-CIRCLE-HASHTABLE* NIL))
                                           (\WRITE1
 OBJECT STREAM)))
                (\WRITE1
 OBJECT STREAM))
         OBJECT))

(\WRITE1

  [CL:LAMBDA (OBJECT STREAM)
         (DECLARE
 (SPECIAL *PRINT-ESCAPE* *PRINT-RADIX* *PRINT-BASE* *PRINT-LEVEL* *PRINT-LENGTH* 
                         *PRINT-CASE* *PRINT-GENSYM* *PRINT-ARRAY* *PRINT-PRETTY* *PRINT-CIRCLE* 
                         \THISFILELINELENGTH))
               (* jrb: "17-Jun-86 14:05")

         (CL:BLOCK \WRITE1 (COND
                              (*PRINT-PRETTY*                (* 

                                 "For the moment, *PRINT-PRETTY* overrides *PRINT-CIRCLE* completely")

                                     (PRINTDEF OBJECT NIL NIL NIL NIL STREAM))
                              (T (LET (\THISFILELINELENGTH)
                                      (DECLARE
 (SPECIAL \THISFILELINELENGTH))
                                                             (* CommonLisp streams do not observe 

                                                             line length)

                                      (\PRINDATUM OBJECT (\GETSTREAM STREAM (QUOTE OUTPUT))
                                             0])

(WRITE-CHAR

  (CL:LAMBDA (CHARACTER &OPTIONAL (OUTPUT-STREAM *STANDARD-OUTPUT*))

                                                             (* jrb: "15-May-86 18:17")

    (\OUTCHAR (\GETSTREAM OUTPUT-STREAM (QUOTE OUTPUT))
           (CHAR-INT CHARACTER))
    CHARACTER))

(CL:PRIN1

  (CL:LAMBDA (OBJECT &OPTIONAL (OUTPUT-STREAM *STANDARD-OUTPUT*))

                                                             (* lmm " 4-May-86 03:15")

    (WRITE
 OBJECT :STREAM OUTPUT-STREAM :ESCAPE T)))

(CL:PRINT

  (CL:LAMBDA (OBJECT &OPTIONAL (OUTPUT-STREAM *STANDARD-OUTPUT*))

                                                             (* lmm " 4-May-86 03:15")

    (TERPRI OUTPUT-STREAM)
    (PROG1 (CL:PRIN1
 OBJECT OUTPUT-STREAM)
           (SPACES 1 OUTPUT-STREAM))))

(CL:TERPRI

  [LAMBDA (OUTPUT-STREAM)
                                    (* bvm: "19-May-86 15:53")

    (TERPRI (OR OUTPUT-STREAM *STANDARD-OUTPUT*])

(FRESH-LINE

  [LAMBDA (OUTPUT-STREAM)
                                    (* bvm: "19-May-86 15:53")

    (FRESHLINE (OR OUTPUT-STREAM *STANDARD-OUTPUT*])

(FINISH-OUTPUT

  [LAMBDA (OUTPUT-STREAM)
                                    (* bvm: "19-May-86 15:53")

    (FORCEOUTPUT (OR OUTPUT-STREAM *STANDARD-OUTPUT*)
           T)
    NIL])

(FORCE-OUTPUT

  [LAMBDA (OUTPUT-STREAM)
                                    (* bvm: "19-May-86 15:53")

    (FORCEOUTPUT (OR OUTPUT-STREAM *STANDARD-OUTPUT*))
    NIL])

(CLEAR-OUTPUT

  [LAMBDA (OUTPUT-STREAM)
                                    (* bvm: "19-May-86 15:38")

    NIL])

(PPRINT

  (CL:LAMBDA (OBJECT &OPTIONAL (OUTPUT-STREAM *STANDARD-OUTPUT*))

                                                             (* lmm " 4-May-86 03:19")

    (TERPRI OUTPUT-STREAM)
    (WRITE
 OBJECT :STREAM OUTPUT-STREAM :ESCAPE T :PRETTY T)
    (VALUES)))

(PRINC

  (CL:LAMBDA (OBJECT &OPTIONAL (OUTPUT-STREAM *STANDARD-OUTPUT*))

                                                             (* lmm " 4-May-86 03:20")

    (WRITE
 OBJECT :STREAM OUTPUT-STREAM :ESCAPE NIL)))
)
(DEFINEQ

(WRITE-TO-STRING

  (CL:LAMBDA (OBJECT &KEY ((:ESCAPE *PRINT-ESCAPE*)
                           *PRINT-ESCAPE*)
                    ((:RADIX *PRINT-RADIX*)
                     *PRINT-RADIX*)
                    ((:BASE *PRINT-BASE*)
                     *PRINT-BASE*)
                    ((:CIRCLE *PRINT-CIRCLE*)
                     *PRINT-CIRCLE*)
                    ((:PRETTY *PRINT-PRETTY*)
                     *PRINT-PRETTY*)
                    ((:LEVEL *PRINT-LEVEL*)
                     *PRINT-LEVEL*)
                    ((:LENGTH *PRINT-LENGTH*)
                     *PRINT-LENGTH*)
                    ((:CASE *PRINT-CASE*)
                     *PRINT-CASE*)
                    ((:ARRAY *PRINT-ARRAY*)
                     *PRINT-ARRAY*)
                    ((:GENSYM *PRINT-GENSYM*)
                     *PRINT-GENSYM*))
                        (* bvm: "13-May-86 15:38")

    "Returns the printed representation of OBJECT as a string."
    (\PRINDATUM.TO.STRING OBJECT)))

(PRIN1-TO-STRING

  [LAMBDA (OBJECT)
                                           (* bvm: "13-May-86 15:24")

          
          (* * Produces a string consisting of the output of

          (CL:PRIN1 OBJECT))


    (LET ((*PRINT-ESCAPE* T))
         (\PRINDATUM.TO.STRING OBJECT])

(PRINC-TO-STRING

  [LAMBDA (OBJECT)
                                           (* bvm: "13-May-86 15:23")

          
          (* * A lot like MKSTRING, but not quite.

          Produces a string consisting of the output of

          (PRINC OBJECT))


    (LET ((*PRINT-ESCAPE* NIL))
         (\PRINDATUM.TO.STRING OBJECT])
)
(DEFUN WRITE-LINE
 (STRING &OPTIONAL (STREAM *STANDARD-OUTPUT*)
                         &KEY
                         (START 0)
                         (END (CL:LENGTH STRING))) (PROG1 (WRITE-STRING STRING STREAM :START START 
                                                                 :END END)
                                                          (CL:TERPRI STREAM)))




(* WRITE-STRING is in CMLSTREAMS)



(RPAQ? *PRINT-STRUCTURE*
 )
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 WRITE-TO-STRING PRINC PPRINT CL:PRINT CL:PRIN1 WRITE-CHAR \WRITE1 WRITE)
)
(PUTPROPS CMLPRINT COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1082 6494 (WRITE 1092 . 3251) (\WRITE1 3253 . 4343) (WRITE-CHAR 4345 . 4630) (CL:PRIN1 
4632 . 4863) (CL:PRINT 4865 . 5152) (CL:TERPRI 5154 . 5314) (FRESH-LINE 5316 . 5480) (FINISH-OUTPUT 
5482 . 5674) (FORCE-OUTPUT 5676 . 5854) (CLEAR-OUTPUT 5856 . 5979) (PPRINT 5981 . 6260) (PRINC 6262 . 
6492)) (6495 8152 (WRITE-TO-STRING 6505 . 7505) (PRIN1-TO-STRING 7507 . 7803) (PRINC-TO-STRING 7805 . 
8150)))))
STOP