(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "XCL")
(IL:FILECREATED "26-Jan-98 13:28:55" ("compiled on " 
IL:{DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>READ-PRINT-PROFILE.;1) "30-Mar-95 20:33:04" 
IL:bcompl'd IL:in "Medley 14-Aug-95 ..." IL:dated "14-Aug-95 15:27:48")
(IL:FILECREATED "16-May-90 21:23:08" IL:{DSK}<usr>local>lde>lispcore>sources>READ-PRINT-PROFILE.;2 
12400 IL:changes IL:to%: (IL:VARS IL:READ-PRINT-PROFILECOMS) IL:previous IL:date%: 
"13-Nov-86 11:37:11" IL:{DSK}<usr>local>lde>lispcore>sources>READ-PRINT-PROFILE.;1)
(IL:PRETTYCOMPRINT IL:READ-PRINT-PROFILECOMS)
(IL:RPAQQ IL:READ-PRINT-PROFILECOMS ((IL:P (EXPORT (QUOTE (MAKE-READ-PRINT-PROFILE 
COPY-READ-PRINT-PROFILE READ-PRINT-PROFILE-P READ-PRINT-PROFILE-READTABLE READ-PRINT-PROFILE-READ-BASE
 READ-PRINT-PROFILE-READ-SUPPRESS READ-PRINT-PROFILE-PACKAGE 
READ-PRINT-PROFILE-READ-DEFAULT-FLOAT-FORMAT READ-PRINT-PROFILE-PRINT-ESCAPE 
READ-PRINT-PROFILE-PRINT-PRETTY READ-PRINT-PROFILE-PRINT-CIRCLE READ-PRINT-PROFILE-PRINT-BASE 
READ-PRINT-PROFILE-PRINT-RADIX READ-PRINT-PROFILE-PRINT-CASE READ-PRINT-PROFILE-PRINT-GENSYM 
READ-PRINT-PROFILE-PRINT-LEVEL READ-PRINT-PROFILE-PRINT-LENGTH READ-PRINT-PROFILE-PRINT-ARRAY 
READ-PRINT-PROFILE-PRINT-STRUCTURE RESTORE-READ-PRINT-PROFILE SAVE-READ-PRINT-PROFILE 
WITH-READ-PRINT-PROFILE *DEFAULT-READ-PRINT-PROFILE* FIND-READ-PRINT-PROFILE 
LIST-ALL-READ-PRINT-PROFILE-NAMES)) "XCL")) (IL:STRUCTURES READ-PRINT-PROFILE) (IL:FUNCTIONS 
MAKE-READ-PRINT-PROFILE RESTORE-READ-PRINT-PROFILE SAVE-READ-PRINT-PROFILE WITH-READ-PRINT-PROFILE 
FIND-READ-PRINT-PROFILE SETF-FIND-READ-PRINT-PROFILE LIST-ALL-READ-PRINT-PROFILE-NAMES) (IL:SETFS 
FIND-READ-PRINT-PROFILE) (IL:VARIABLES *READ-PRINT-PROFILES* *DEFAULT-READ-PRINT-PROFILE*) (IL:PROP (
IL:MAKEFILE-ENVIRONMENT IL:FILETYPE) IL:READ-PRINT-PROFILE)))
(EXPORT (QUOTE (MAKE-READ-PRINT-PROFILE COPY-READ-PRINT-PROFILE READ-PRINT-PROFILE-P 
READ-PRINT-PROFILE-READTABLE READ-PRINT-PROFILE-READ-BASE READ-PRINT-PROFILE-READ-SUPPRESS 
READ-PRINT-PROFILE-PACKAGE READ-PRINT-PROFILE-READ-DEFAULT-FLOAT-FORMAT 
READ-PRINT-PROFILE-PRINT-ESCAPE READ-PRINT-PROFILE-PRINT-PRETTY READ-PRINT-PROFILE-PRINT-CIRCLE 
READ-PRINT-PROFILE-PRINT-BASE READ-PRINT-PROFILE-PRINT-RADIX READ-PRINT-PROFILE-PRINT-CASE 
READ-PRINT-PROFILE-PRINT-GENSYM READ-PRINT-PROFILE-PRINT-LEVEL READ-PRINT-PROFILE-PRINT-LENGTH 
READ-PRINT-PROFILE-PRINT-ARRAY READ-PRINT-PROFILE-PRINT-STRUCTURE RESTORE-READ-PRINT-PROFILE 
SAVE-READ-PRINT-PROFILE WITH-READ-PRINT-PROFILE *DEFAULT-READ-PRINT-PROFILE* FIND-READ-PRINT-PROFILE 
LIST-ALL-READ-PRINT-PROFILE-NAMES)) "XCL")
(DEFSTRUCT (READ-PRINT-PROFILE (:CONSTRUCTOR INTERNAL-MAKE-READ-PRINT-PROFILE)) (IL:* IL:;;; 
"Holds complete collection of read / print affecting globals.") READTABLE READ-BASE READ-SUPPRESS 
PACKAGE READ-DEFAULT-FLOAT-FORMAT PRINT-ESCAPE PRINT-PRETTY PRINT-CIRCLE PRINT-BASE PRINT-RADIX 
PRINT-CASE PRINT-GENSYM PRINT-LEVEL PRINT-LENGTH PRINT-ARRAY PRINT-STRUCTURE)
(DEFUN MAKE-READ-PRINT-PROFILE (&KEY (READTABLE *READTABLE*) (READ-BASE *READ-BASE*) (READ-SUPPRESS 
*READ-SUPPRESS*) (PACKAGE *PACKAGE*) (READ-DEFAULT-FLOAT-FORMAT *READ-DEFAULT-FLOAT-FORMAT*) (
PRINT-ESCAPE *PRINT-ESCAPE*) (PRINT-PRETTY *PRINT-PRETTY*) (PRINT-CIRCLE *PRINT-CIRCLE*) (PRINT-BASE 
*PRINT-BASE*) (PRINT-RADIX *PRINT-RADIX*) (PRINT-CASE *PRINT-CASE*) (PRINT-GENSYM *PRINT-GENSYM*) (
PRINT-LEVEL *PRINT-LEVEL*) (PRINT-LENGTH *PRINT-LENGTH*)) (IL:* IL:;;; 
"Create and return a profile with default contents the current bindings of the read print special variables."
) (INTERNAL-MAKE-READ-PRINT-PROFILE :READTABLE READTABLE :READ-BASE READ-BASE :READ-SUPPRESS 
READ-SUPPRESS :PACKAGE PACKAGE :READ-DEFAULT-FLOAT-FORMAT READ-DEFAULT-FLOAT-FORMAT :PRINT-ESCAPE 
PRINT-ESCAPE :PRINT-PRETTY PRINT-PRETTY :PRINT-CIRCLE PRINT-CIRCLE :PRINT-BASE PRINT-BASE :PRINT-RADIX
 PRINT-RADIX :PRINT-CASE PRINT-CASE :PRINT-GENSYM PRINT-GENSYM :PRINT-LEVEL PRINT-LEVEL :PRINT-LENGTH 
PRINT-LENGTH))
(DEFUN RESTORE-READ-PRINT-PROFILE (PROFILE) 
"Restore values of special io bindings from profile.  Sets current bindings.  Returns T." (SETF 
*READTABLE* (READ-PRINT-PROFILE-READTABLE PROFILE)) (SETF *READ-BASE* (READ-PRINT-PROFILE-READ-BASE 
PROFILE)) (SETF *READ-SUPPRESS* (READ-PRINT-PROFILE-READ-SUPPRESS PROFILE)) (SETF *PACKAGE* (
READ-PRINT-PROFILE-PACKAGE PROFILE)) (SETF *READ-DEFAULT-FLOAT-FORMAT* (
READ-PRINT-PROFILE-READ-DEFAULT-FLOAT-FORMAT PROFILE)) (SETF *PRINT-ESCAPE* (
READ-PRINT-PROFILE-PRINT-ESCAPE PROFILE)) (SETF *PRINT-PRETTY* (READ-PRINT-PROFILE-PRINT-PRETTY 
PROFILE)) (SETF *PRINT-CIRCLE* (READ-PRINT-PROFILE-PRINT-CIRCLE PROFILE)) (SETF *PRINT-BASE* (
READ-PRINT-PROFILE-PRINT-BASE PROFILE)) (SETF *PRINT-RADIX* (READ-PRINT-PROFILE-PRINT-RADIX PROFILE)) 
(SETF *PRINT-CASE* (READ-PRINT-PROFILE-PRINT-CASE PROFILE)) (SETF *PRINT-GENSYM* (
READ-PRINT-PROFILE-PRINT-GENSYM PROFILE)) (SETF *PRINT-LEVEL* (READ-PRINT-PROFILE-PRINT-LEVEL PROFILE)
) (SETF *PRINT-LENGTH* (READ-PRINT-PROFILE-PRINT-LENGTH PROFILE)) (SETF *PRINT-ARRAY* (
READ-PRINT-PROFILE-PRINT-ARRAY PROFILE)) (SETF *PRINT-STRUCTURE* (READ-PRINT-PROFILE-PRINT-STRUCTURE 
PROFILE)) T)
(DEFUN SAVE-READ-PRINT-PROFILE (PROFILE) "Capture bindings of special io variables.  Returns profile."
 (SETF (READ-PRINT-PROFILE-READTABLE PROFILE) *READTABLE*) (SETF (READ-PRINT-PROFILE-READ-BASE PROFILE
) *READ-BASE*) (SETF (READ-PRINT-PROFILE-READ-SUPPRESS PROFILE) *READ-SUPPRESS*) (SETF (
READ-PRINT-PROFILE-PACKAGE PROFILE) *PACKAGE*) (SETF (READ-PRINT-PROFILE-READ-DEFAULT-FLOAT-FORMAT 
PROFILE) *READ-DEFAULT-FLOAT-FORMAT*) (SETF (READ-PRINT-PROFILE-PRINT-ESCAPE PROFILE) *PRINT-ESCAPE*) 
(SETF (READ-PRINT-PROFILE-PRINT-PRETTY PROFILE) *PRINT-PRETTY*) (SETF (READ-PRINT-PROFILE-PRINT-CIRCLE
 PROFILE) *PRINT-CIRCLE*) (SETF (READ-PRINT-PROFILE-PRINT-BASE PROFILE) *PRINT-BASE*) (SETF (
READ-PRINT-PROFILE-PRINT-RADIX PROFILE) *PRINT-RADIX*) (SETF (READ-PRINT-PROFILE-PRINT-CASE PROFILE) 
*PRINT-CASE*) (SETF (READ-PRINT-PROFILE-PRINT-GENSYM PROFILE) *PRINT-GENSYM*) (SETF (
READ-PRINT-PROFILE-PRINT-LEVEL PROFILE) *PRINT-LEVEL*) (SETF (READ-PRINT-PROFILE-PRINT-LENGTH PROFILE)
 *PRINT-LENGTH*) (SETF (READ-PRINT-PROFILE-PRINT-ARRAY PROFILE) *PRINT-ARRAY*) (SETF (
READ-PRINT-PROFILE-PRINT-STRUCTURE PROFILE) *PRINT-STRUCTURE*) PROFILE)
(DEFMACRO WITH-READ-PRINT-PROFILE (PROFILE-FORM &BODY FORMS) 
"Bind all the special IO variables to the values in the profile and execute the body forms." (IL:BQUOTE
 (LET ((PROFILE (IL:\, PROFILE-FORM))) (LET ((*READTABLE* (READ-PRINT-PROFILE-READTABLE PROFILE)) (
*READ-BASE* (READ-PRINT-PROFILE-READ-BASE PROFILE)) (*READ-SUPPRESS* (READ-PRINT-PROFILE-READ-SUPPRESS
 PROFILE)) (*PACKAGE* (READ-PRINT-PROFILE-PACKAGE PROFILE)) (*READ-DEFAULT-FLOAT-FORMAT* (
READ-PRINT-PROFILE-READ-DEFAULT-FLOAT-FORMAT PROFILE)) (*PRINT-ESCAPE* (
READ-PRINT-PROFILE-PRINT-ESCAPE PROFILE)) (*PRINT-PRETTY* (READ-PRINT-PROFILE-PRINT-PRETTY PROFILE)) (
*PRINT-CIRCLE* (READ-PRINT-PROFILE-PRINT-CIRCLE PROFILE)) (*PRINT-BASE* (READ-PRINT-PROFILE-PRINT-BASE
 PROFILE)) (*PRINT-RADIX* (READ-PRINT-PROFILE-PRINT-RADIX PROFILE)) (*PRINT-CASE* (
READ-PRINT-PROFILE-PRINT-CASE PROFILE)) (*PRINT-GENSYM* (READ-PRINT-PROFILE-PRINT-GENSYM PROFILE)) (
*PRINT-LEVEL* (READ-PRINT-PROFILE-PRINT-LEVEL PROFILE)) (*PRINT-LENGTH* (
READ-PRINT-PROFILE-PRINT-LENGTH PROFILE)) (*PRINT-ARRAY* (READ-PRINT-PROFILE-PRINT-ARRAY PROFILE)) (
*PRINT-STRUCTURE* (READ-PRINT-PROFILE-PRINT-STRUCTURE PROFILE))) (IL:\,@ FORMS)))))
(DEFUN FIND-READ-PRINT-PROFILE (NAME) (GETHASH (STRING-UPCASE NAME) *READ-PRINT-PROFILES*))
(DEFUN SETF-FIND-READ-PRINT-PROFILE (NAME READ-PRINT-PROFILE) (CHECK-TYPE READ-PRINT-PROFILE 
READ-PRINT-PROFILE) (SETF (GETHASH (STRING-UPCASE NAME) *READ-PRINT-PROFILES*) READ-PRINT-PROFILE))
(DEFUN LIST-ALL-READ-PRINT-PROFILE-NAMES NIL (LET ((NAMES NIL)) (MAPHASH (FUNCTION (LAMBDA (NAME VALUE
) (PUSH NAME NAMES))) *READ-PRINT-PROFILES*) NAMES))
(DEFSETF FIND-READ-PRINT-PROFILE SETF-FIND-READ-PRINT-PROFILE)
(DEFPARAMETER *READ-PRINT-PROFILES* (LET ((TABLE (MAKE-HASH-TABLE :TEST (QUOTE EQUAL))) (LISP-TABLE (
MAKE-READ-PRINT-PROFILE :READTABLE (IL:FIND-READTABLE "LISP") :READ-BASE 10 :READ-SUPPRESS NIL 
:PACKAGE (FIND-PACKAGE "USER") :READ-DEFAULT-FLOAT-FORMAT (QUOTE SINGLE-FLOAT) :PRINT-ESCAPE T 
:PRINT-PRETTY NIL :PRINT-CIRCLE NIL :PRINT-BASE 10 :PRINT-RADIX NIL :PRINT-CASE :UPCASE :PRINT-GENSYM 
T :PRINT-LEVEL NIL :PRINT-LENGTH NIL :PRINT-ARRAY NIL :PRINT-STRUCTURE NIL)) (XCL-TABLE (
MAKE-READ-PRINT-PROFILE :READTABLE (IL:FIND-READTABLE "XCL") :READ-BASE 10 :READ-SUPPRESS NIL :PACKAGE
 (FIND-PACKAGE "XCL-USER") :READ-DEFAULT-FLOAT-FORMAT (QUOTE SINGLE-FLOAT) :PRINT-ESCAPE T 
:PRINT-PRETTY NIL :PRINT-CIRCLE NIL :PRINT-BASE 10 :PRINT-RADIX NIL :PRINT-CASE :UPCASE :PRINT-GENSYM 
T :PRINT-LEVEL NIL :PRINT-LENGTH NIL :PRINT-ARRAY NIL :PRINT-STRUCTURE NIL)) (INTERLISP-TABLE (
MAKE-READ-PRINT-PROFILE :READTABLE (IL:FIND-READTABLE "INTERLISP") :READ-BASE 10 :READ-SUPPRESS NIL 
:PACKAGE (FIND-PACKAGE "INTERLISP") :READ-DEFAULT-FLOAT-FORMAT (QUOTE SINGLE-FLOAT) :PRINT-ESCAPE T 
:PRINT-PRETTY NIL :PRINT-CIRCLE NIL :PRINT-BASE 10 :PRINT-RADIX NIL :PRINT-CASE :UPCASE :PRINT-GENSYM 
T :PRINT-LEVEL NIL :PRINT-LENGTH NIL :PRINT-ARRAY NIL :PRINT-STRUCTURE NIL))) (SETF (GETHASH "LISP" 
TABLE) LISP-TABLE) (SETF (GETHASH "XCL" TABLE) XCL-TABLE) (SETF (GETHASH "INTERLISP" TABLE) 
INTERLISP-TABLE) TABLE) "Where read-print-modes live.")
(DEFPARAMETER *DEFAULT-READ-PRINT-PROFILE* (FIND-READ-PRINT-PROFILE "INTERLISP") 
"The default read & print state to be used when not explicitly set.")
(IL:PUTPROPS IL:READ-PRINT-PROFILE IL:MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "XCL"))
(IL:PUTPROPS IL:READ-PRINT-PROFILE IL:FILETYPE IL:COMPILE-FILE)
(IL:PUTPROPS IL:READ-PRINT-PROFILE IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1990))
NIL