(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) (FILECREATED " 3-Apr-91 15:11:53" |{PELE:MV:ENVOS}SOURCES>CLSTREAMS.;4| 54013 |changes| |to:| (FUNCTIONS CL:WITH-INPUT-FROM-STRING) |previous| |date:| "27-Feb-91 20:05:55" |{PELE:MV:ENVOS}SOURCES>CLSTREAMS.;3|) ; Copyright (c) 1985, 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation. All rights reserved. (PRETTYCOMPRINT CLSTREAMSCOMS) (RPAQQ CLSTREAMSCOMS ( (* |;;;| "Implements a number of stream functions from CommonLisp. See CLtL chapter 21") (COMS (* |;;| "documented functions and macros") (FUNCTIONS OPEN CL:CLOSE CL:STREAM-EXTERNAL-FORMAT) (FUNCTIONS CL:STREAM-ELEMENT-TYPE CL:INPUT-STREAM-P CL:OUTPUT-STREAM-P XCL:OPEN-STREAM-P) (COMS (FUNCTIONS FILE-STREAM-POSITION) (SETFS FILE-STREAM-POSITION)) (FUNCTIONS CL:MAKE-SYNONYM-STREAM XCL:SYNONYM-STREAM-P XCL:SYNONYM-STREAM-SYMBOL XCL:FOLLOW-SYNONYM-STREAMS) (FUNCTIONS CL:MAKE-BROADCAST-STREAM XCL:BROADCAST-STREAM-P XCL:BROADCAST-STREAM-STREAMS) (FUNCTIONS CL:MAKE-CONCATENATED-STREAM XCL:CONCATENATED-STREAM-P XCL:CONCATENATED-STREAM-STREAMS) (FUNCTIONS CL:MAKE-TWO-WAY-STREAM XCL:TWO-WAY-STREAM-P XCL:TWO-WAY-STREAM-OUTPUT-STREAM XCL:TWO-WAY-STREAM-INPUT-STREAM) (FUNCTIONS CL:MAKE-ECHO-STREAM XCL:ECHO-STREAM-P XCL:ECHO-STREAM-INPUT-STREAM XCL:ECHO-STREAM-OUTPUT-STREAM) (FUNCTIONS CL:MAKE-STRING-INPUT-STREAM MAKE-CONCATENATED-STRING-INPUT-STREAM) (FUNCTIONS %MAKE-INITIAL-STRING-STREAM-CONTENTS) (FUNCTIONS CL:WITH-OPEN-STREAM CL:WITH-INPUT-FROM-STRING CL:WITH-OUTPUT-TO-STRING CL:WITH-OPEN-FILE) (FUNCTIONS CL:MAKE-STRING-OUTPUT-STREAM MAKE-FILL-POINTER-OUTPUT-STREAM CL:GET-OUTPUT-STREAM-STRING \\STRING-STREAM-OUTCHARFN \\ADJUSTABLE-STRING-STREAM-OUTCHARFN )) (COMS (* |;;| "helpers") (FUNCTIONS %NEW-FILE PREDICT-NAME) (DECLARE\: EVAL@COMPILE DONTCOPY (FUNCTIONS INTERLISP-ACCESS))) (COMS (* |;;| "methods for the special devices") (FNS %BROADCAST-STREAM-DEVICE-BOUT %BROADCAST-STREAM-DEVICE-OUTCHARFN %BROADCAST-STREAM-DEVICE-CLOSEFILE %BROADCAST-STREAM-DEVICE-FORCEOUTPUT) (FUNCTIONS %BROADCAST-STREAM-DEVICE-CHARSETFN) (FNS %CONCATENATED-STREAM-DEVICE-BIN %CONCATENATED-STREAM-DEVICE-CLOSEFILE %CONCATENATED-STREAM-DEVICE-EOFP %CONCATENATED-STREAM-DEVICE-PEEKBIN %CONCATENATED-STREAM-DEVICE-BACKFILEPTR) (FUNCTIONS %CONCATENATED-STREAM-DEVICE-CHARSETFN) (FNS %ECHO-STREAM-DEVICE-BIN) (FUNCTIONS %SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM) (FNS %SYNONYM-STREAM-DEVICE-BIN %SYNONYM-STREAM-DEVICE-BOUT %SYNONYM-STREAM-DEVICE-OUTCHARFN %SYNONYM-STREAM-DEVICE-CLOSEFILE %SYNONYM-STREAM-DEVICE-EOFP %SYNONYM-STREAM-DEVICE-FORCEOUTPUT %SYNONYM-STREAM-DEVICE-GETFILEINFO %SYNONYM-STREAM-DEVICE-PEEKBIN %SYNONYM-STREAM-DEVICE-READP %SYNONYM-STREAM-DEVICE-BACKFILEPTR %SYNONYM-STREAM-DEVICE-SETFILEINFO %SYNONYM-STREAM-DEVICE-CHARSETFN) (FNS %TWO-WAY-STREAM-DEVICE-BIN %TWO-WAY-STREAM-DEVICE-INPUTSTREAM %TWO-WAY-STREAM-DEVICE-BOUT %TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM %TWO-WAY-STREAM-DEVICE-OUTCHARFN %TWO-WAY-STREAM-DEVICE-CLOSEFILE %TWO-WAY-STREAM-DEVICE-EOFP %TWO-WAY-STREAM-DEVICE-READP %TWO-WAY-STREAM-DEVICE-BACKFILEPTR %TWO-WAY-STREAM-DEVICE-FORCEOUTPUT %TWO-WAY-STREAM-DEVICE-PEEKBIN %TWO-WAY-STREAM-DEVICE-CHARSETFN) (FUNCTIONS %FILL-POINTER-STREAM-DEVICE-CLOSEFILE %FILL-POINTER-STREAM-DEVICE-GETFILEPTR) (GLOBALVARS %SYNONYM-STREAM-DEVICE %BROADCAST-STREAM-DEVICE %CONCATENATED-STREAM-DEVICE %TWO-WAY-STREAM-DEVICE %ECHO-STREAM-DEVICE \\FILL-POINTER-STREAM-DEVICE)) (COMS (* |;;| "helper stuff") (FNS %SYNONYM-STREAM-DEVICE-GET-STREAM)) (COMS (* |;;| "module initialization") (VARIABLES *DEBUG-IO* *QUERY-IO* *TERMINAL-IO* *ERROR-OUTPUT* *STANDARD-OUTPUT* *STANDARD-INPUT*) (FUNCTIONS %INITIALIZE-STANDARD-STREAMS) (FNS %INITIALIZE-CLSTREAM-TYPES) (DECLARE\: DONTEVAL@LOAD DOCOPY (* \; "initialization") (P (%INITIALIZE-CLSTREAM-TYPES) (%INITIALIZE-STANDARD-STREAMS)))) (PROP FILETYPE CLSTREAMS))) (* |;;;| "Implements a number of stream functions from CommonLisp. See CLtL chapter 21") (* |;;| "documented functions and macros") (CL:DEFUN OPEN (FILENAME &KEY (DIRECTION :INPUT) (ELEMENT-TYPE 'CL:STRING-CHAR) (IF-EXISTS NIL EXISTS-P) (IF-DOES-NOT-EXIST NIL DOES-NOT-EXIST-P) (EXTERNAL-FORMAT :DEFAULT)) (* |;;;| "Return a stream which reads from or writes to Filename. Defined keywords: :direction (one of :input, :output or :probe :element-type), Type of object to read or write, default String-Char, :if-exists (one of :error, :new-version, :overwrite, :append or nil), :if-does-not-exist (one of :error, :create or nil). :external-format (one of :DEFAULT, :EUC, :JIS, :W-MS, :MS or :XCCS). The specification of :external-format is based on the JEIDA proposal. See the manual for details.") (CL:UNLESS (MEMQ DIRECTION '(:INPUT :OUTPUT :IO :PROBE)) (CL:ERROR "~S isn't a valid direction for open." DIRECTION)) (CL:UNLESS (CL:MEMBER ELEMENT-TYPE '(CL:STRING-CHAR CL:SIGNED-BYTE CL:UNSIGNED-BYTE ( CL:UNSIGNED-BYTE 8) (CL:SIGNED-BYTE 8) CL:CHARACTER :DEFAULT) :TEST 'CL:EQUAL) (CL:ERROR "~S isn't an implemented element-type for open." ELEMENT-TYPE)) (LET ((PATHNAME (PATHNAME FILENAME)) (FOR-INPUT (MEMQ DIRECTION '(:IO :INPUT))) (FOR-OUTPUT (MEMQ DIRECTION '(:IO :OUTPUT))) (ACCESS (INTERLISP-ACCESS DIRECTION)) (FILE-TYPE (IF (CL:MEMBER ELEMENT-TYPE '(CL:UNSIGNED-BYTE CL:SIGNED-BYTE (CL:UNSIGNED-BYTE 8) (CL:SIGNED-BYTE 8)) :TEST 'CL:EQUAL) THEN 'BINARY ELSE 'TEXT)) (STREAM NIL)) (* |;;;| "Do hairy defaulting of :if-exists and :if-does-not-exist keywords.") (CL:UNLESS EXISTS-P (SETQ IF-EXISTS (CL:IF (EQ (CL:PATHNAME-VERSION PATHNAME) :NEWEST) :NEW-VERSION :ERROR))) (* \;  "If the file does not exist, it is OK to have :if-exists :overwrite. ") (CL:UNLESS DOES-NOT-EXIST-P (SETQ IF-DOES-NOT-EXIST (COND ((OR (EQ IF-EXISTS :APPEND) (EQ DIRECTION :INPUT)) :ERROR) ((EQ DIRECTION :PROBE) NIL) (T :CREATE)))) (CL:LOOP (* \;  "See if the file exists and handle the existential keywords.") (LET* ((NAME (PREDICT-NAME PATHNAME)) (CL:NAMESTRING (MKSTRING NAME))) (IF NAME THEN (* \; "file exists") (IF FOR-OUTPUT THEN (* |;;| "open for output/both") (CASE IF-EXISTS (:ERROR (CL:CERROR "write it anyway." "File ~A already exists." CL:NAMESTRING) (SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS NIL `((TYPE ,FILE-TYPE) (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) (RETURN NIL)) ((:NEW-VERSION :SUPERSEDE :RENAME :RENAME-AND-DELETE) (SETQ STREAM (OPENSTREAM PATHNAME ACCESS 'NEW `((TYPE ,FILE-TYPE) (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) (RETURN NIL)) (:OVERWRITE (SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS 'OLD `((TYPE ,FILE-TYPE) (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) (RETURN NIL)) (:APPEND (IF (EQ DIRECTION :OUTPUT) THEN (* \;  "if the direction is output it is the same as interlisp append") (SETQ STREAM (OPENSTREAM CL:NAMESTRING 'APPEND 'OLD `((TYPE ,FILE-TYPE) (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) ELSE (* \;  "if direction is io it opens the file for both and goes to the end of the file") (SETQ STREAM (OPENSTREAM CL:NAMESTRING 'BOTH 'OLD `((TYPE ,FILE-TYPE) (EXTERNALFORMAT ,EXTERNAL-FORMAT) ))) (SETFILEPTR STREAM -1)) (RETURN NIL)) ((NIL) (CL:RETURN-FROM OPEN NIL)) (T (CL:ERROR "~S is not a valid value for :if-exists." IF-EXISTS))) |elseif| FOR-INPUT |then| (* |;;| "open for input/both") (SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS 'OLD `((TYPE ,FILE-TYPE) (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) (RETURN NIL) |else| (* |;;| "open for probe") (SETQ STREAM (|create| STREAM FULLFILENAME _ (FULLNAME CL:NAMESTRING))) (RETURN NIL)) |else| (* |;;| "file does not exist") (|if| FOR-OUTPUT |then| (CASE IF-DOES-NOT-EXIST (:ERROR (CL:CERROR "prompt for a new name." 'XCL:FILE-NOT-FOUND :PATHNAME PATHNAME) (CL:FORMAT *QUERY-IO* "~&New file name: ") (SETQ PATHNAME (PATHNAME (CL:READ-LINE *QUERY-IO*)))) (:CREATE (SETQ STREAM (OPENSTREAM PATHNAME ACCESS 'NEW `((TYPE ,FILE-TYPE) (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) (RETURN NIL)) ((NIL) (CL:RETURN-FROM OPEN NIL)) (T (CL:ERROR "~S is not a valid value for :if-does-not-exist." IF-DOES-NOT-EXIST))) |elseif| FOR-INPUT |then| (CASE IF-DOES-NOT-EXIST (:ERROR (CL:CERROR "prompt for a new name." 'XCL:FILE-NOT-FOUND :PATHNAME PATHNAME) (CL:FORMAT *QUERY-IO* "~&New file name: ") (SETQ PATHNAME (PATHNAME (CL:READ-LINE *QUERY-IO*)))) (:CREATE (%NEW-FILE PATHNAME)) ((NIL) (CL:RETURN-FROM OPEN NIL)) (T (CL:ERROR "~S is not a valid value for :if-does-not-exist." IF-DOES-NOT-EXIST))) |else| (* \; "Open for probe.") (RETURN NIL))))) (STREAMPROP STREAM :FILE-STREAM-P T) STREAM)) (CL:DEFUN CL:CLOSE (STREAM &KEY ABORT) (* |;;;| "Close a stream. If ABORT, then don't keep the file") (|if| (STREAMP STREAM) |then| (|if| (OPENP STREAM) |then| (* |;;|  "determine 'deletability' of stream's file before closing, as that trashes the info") (LET ((ABORTABLE (AND (DIRTYABLE STREAM) (NOT (APPENDONLY STREAM))))) (CLOSEF STREAM) (|if| (AND ABORT ABORTABLE) |then| (* \;  "eventually we will change device CLOSEF methods to take an ABORT arg. For now, simulate it.") (DELFILE (CL:NAMESTRING STREAM))))) |else| (ERROR "Closing a non-stream" STREAM)) T) (CL:DEFUN CL:STREAM-EXTERNAL-FORMAT (STREAM) (\\EXTERNALFORMAT STREAM)) (CL:DEFUN CL:STREAM-ELEMENT-TYPE (STREAM) 'CL:UNSIGNED-BYTE) (CL:DEFUN CL:INPUT-STREAM-P (STREAM) (CL:WHEN (NOT (STREAMP STREAM)) (\\ILLEGAL.ARG STREAM)) (* |;;| "we return T instead of the stream because Symbolics does") (AND (\\IOMODEP STREAM 'INPUT T) T)) (CL:DEFUN CL:OUTPUT-STREAM-P (STREAM) (CL:WHEN (NOT (STREAMP STREAM)) (\\ILLEGAL.ARG STREAM)) (* |;;| "we return T instead of the stream because Symbolics does") (AND (\\IOMODEP STREAM 'OUTPUT T) T)) (CL:DEFUN XCL:OPEN-STREAM-P (STREAM) (* |;;| "is stream an open stream?") (AND (STREAMP STREAM) (OPENED STREAM))) (CL:DEFUN FILE-STREAM-POSITION (STREAM) (GETFILEPTR STREAM)) (CL:DEFSETF FILE-STREAM-POSITION SETFILEPTR) (CL:DEFUN CL:MAKE-SYNONYM-STREAM (CL:SYMBOL) (* |;;| "A CommonLisp function for shadowing a stream. See CLtL p. 329") (LET ((STREAM (|create| STREAM DEVICE _ %SYNONYM-STREAM-DEVICE ACCESS _ 'BOTH F1 _ CL:SYMBOL LINELENGTH _ (|fetch| (STREAM LINELENGTH) |of| (CL:SYMBOL-VALUE CL:SYMBOL)) OUTCHARFN _ (FUNCTION %SYNONYM-STREAM-DEVICE-OUTCHARFN)))) (STREAMPROP STREAM 'XCL:SYNONYM-STREAM-P T) (* |;;| "save the synonym stream in the OPENFILELST field of %SYNONYM-STREAM-DEVICE") (|replace| (FDEV OPENFILELST) |of| %SYNONYM-STREAM-DEVICE |with| (CONS STREAM (|fetch| (FDEV OPENFILELST) |of| %SYNONYM-STREAM-DEVICE))) STREAM)) (CL:DEFUN XCL:SYNONYM-STREAM-P (STREAM) (STREAMPROP STREAM 'XCL:SYNONYM-STREAM-P)) (CL:DEFUN XCL:SYNONYM-STREAM-SYMBOL (STREAM) (AND (XCL:SYNONYM-STREAM-P STREAM) (FETCH (STREAM F1) OF STREAM))) (CL:DEFUN XCL:FOLLOW-SYNONYM-STREAMS (STREAM) (* |;;;| "Return the non-synonym stream at the heart of STREAM.") (CL:IF (XCL:SYNONYM-STREAM-P STREAM) (XCL:FOLLOW-SYNONYM-STREAMS (CL:SYMBOL-VALUE (XCL:SYNONYM-STREAM-SYMBOL STREAM))) STREAM)) (CL:DEFUN CL:MAKE-BROADCAST-STREAM (&REST STREAMS) (* |;;| "CommonLisp function that makes a broadcast stream. See CLtL p329") (IF (FOR STREAM? IN STREAMS ALWAYS (STREAMP STREAM?)) THEN (LET ((STREAM (|create| STREAM DEVICE _ %BROADCAST-STREAM-DEVICE ACCESS _ 'OUTPUT F1 _ STREAMS OUTCHARFN _ (FUNCTION %BROADCAST-STREAM-DEVICE-OUTCHARFN)))) (STREAMPROP STREAM 'XCL:BROADCAST-STREAM-P T) STREAM) ELSE (\\ILLEGAL.ARG (FOR STREAM? IN STREAMS WHEN (NOT (STREAMP STREAM?)) DO (RETURN STREAM?))))) (CL:DEFUN XCL:BROADCAST-STREAM-P (STREAM) (* |;;| "is stream a broadcast stream?") (STREAMPROP STREAM 'XCL:BROADCAST-STREAM-P)) (CL:DEFUN XCL:BROADCAST-STREAM-STREAMS (STREAM) (* |;;| "return all of the streams that STREAM broadcasts to") (AND (XCL:BROADCAST-STREAM-P STREAM) (FETCH (STREAM F1) OF STREAM))) (CL:DEFUN CL:MAKE-CONCATENATED-STREAM (&REST STREAMS) (* |;;| "CommonLisp function that creates a concatenated stream. See CLtL p. 329") (IF (FOR STREAM? IN STREAMS ALWAYS (STREAMP STREAM?)) THEN (LET ((STREAM (|create| STREAM DEVICE _ %CONCATENATED-STREAM-DEVICE ACCESS _ 'INPUT F1 _ STREAMS))) (STREAMPROP STREAM 'XCL:CONCATENATED-STREAM-P T) STREAM) ELSE (\\ILLEGAL.ARG (FOR STREAM? IN STREAMS WHEN (NOT (STREAMP STREAM?)) DO (RETURN STREAM?))))) (CL:DEFUN XCL:CONCATENATED-STREAM-P (STREAM) (STREAMPROP STREAM 'XCL:CONCATENATED-STREAM-P)) (CL:DEFUN XCL:CONCATENATED-STREAM-STREAMS (STREAM) (* |;;| "return all of STREAM's concatenated streams") (AND (XCL:CONCATENATED-STREAM-P STREAM) (FETCH (STREAM F1) OF STREAM))) (CL:DEFUN CL:MAKE-TWO-WAY-STREAM (CL::INPUT-STREAM CL::OUTPUT-STREAM) (* |;;| "A CommonLisp function for splicing together two streams. See CLtL p. 329") (CL:UNLESS (STREAMP CL::INPUT-STREAM) (\\ILLEGAL.ARG CL::INPUT-STREAM)) (CL:UNLESS (STREAMP CL::OUTPUT-STREAM) (\\ILLEGAL.ARG CL::OUTPUT-STREAM)) (LET ((STREAM (|create| STREAM DEVICE _ %TWO-WAY-STREAM-DEVICE ACCESS _ 'BOTH F1 _ CL::INPUT-STREAM F2 _ CL::OUTPUT-STREAM LINELENGTH _ (|fetch| (STREAM LINELENGTH) |of| CL::OUTPUT-STREAM) OUTCHARFN _ (FUNCTION %TWO-WAY-STREAM-DEVICE-OUTCHARFN)))) (STREAMPROP STREAM 'XCL:TWO-WAY-STREAM-P T) (* |;;| "save STREAM in the OPENFILELST field of %TWO-WAY-STREAM-DEVICE") (|replace| (FDEV OPENFILELST) |of| %TWO-WAY-STREAM-DEVICE |with| (CONS STREAM (|fetch| (FDEV OPENFILELST) |of| %TWO-WAY-STREAM-DEVICE))) STREAM)) (CL:DEFUN XCL:TWO-WAY-STREAM-P (STREAM) (* |;;| "is STREAM a two-way stream?") (STREAMPROP STREAM 'XCL:TWO-WAY-STREAM-P)) (CL:DEFUN XCL:TWO-WAY-STREAM-OUTPUT-STREAM (STREAM) (AND (XCL:TWO-WAY-STREAM-P STREAM) (FETCH (STREAM F2) OF STREAM))) (CL:DEFUN XCL:TWO-WAY-STREAM-INPUT-STREAM (STREAM) (AND (XCL:TWO-WAY-STREAM-P STREAM) (FETCH (STREAM F1) OF STREAM))) (CL:DEFUN CL:MAKE-ECHO-STREAM (CL::INPUT-STREAM CL::OUTPUT-STREAM) (* |;;| "A CommonLisp function for making an echo stream. See CLtL p. 329") (CL:UNLESS (STREAMP CL::INPUT-STREAM) (\\ILLEGAL.ARG CL::INPUT-STREAM)) (CL:UNLESS (STREAMP CL::OUTPUT-STREAM) (\\ILLEGAL.ARG CL::OUTPUT-STREAM)) (LET ((STREAM (|create| STREAM DEVICE _ %ECHO-STREAM-DEVICE ACCESS _ 'BOTH F1 _ CL::INPUT-STREAM F2 _ CL::OUTPUT-STREAM LINELENGTH _ (|fetch| (STREAM LINELENGTH) |of| CL::OUTPUT-STREAM) OUTCHARFN _ (FUNCTION %TWO-WAY-STREAM-DEVICE-OUTCHARFN)))) (STREAMPROP STREAM 'XCL:ECHO-STREAM-P T) (* |;;| "save STREAM in the OPENFILELST field of %ECHO-STREAM-DEVICE") (|replace| (FDEV OPENFILELST) |of| %ECHO-STREAM-DEVICE |with| (CONS STREAM (|fetch| (FDEV OPENFILELST) |of| %ECHO-STREAM-DEVICE))) STREAM)) (CL:DEFUN XCL:ECHO-STREAM-P (STREAM) (* |;;| "is stream an echo stream?") (STREAMPROP STREAM 'XCL:ECHO-STREAM-P)) (CL:DEFUN XCL:ECHO-STREAM-INPUT-STREAM (STREAM) (AND (XCL:ECHO-STREAM-P STREAM) (FETCH (STREAM F1) OF STREAM))) (CL:DEFUN XCL:ECHO-STREAM-OUTPUT-STREAM (STREAM) (AND (XCL:ECHO-STREAM-P STREAM) (FETCH (STREAM F2) OF STREAM))) (CL:DEFUN CL:MAKE-STRING-INPUT-STREAM (STRING &OPTIONAL (CL::START 0) (CL::END NIL)) (* |;;;| "A CommonLisp function for producing a stream from a string. See CLtL p. 330") (OPENSTRINGSTREAM (|if| (OR (NOT (CL:ZEROP CL::START)) (NOT (NULL CL::END))) |then| (* |;;| "A displaced array is ok here because the stream's uses GETBASEBYTE directly and doesn't go through the array code at all. ") (SUBSTRING STRING (CL:1+ CL::START) CL::END) |else| STRING) 'INPUT)) (CL:DEFUN MAKE-CONCATENATED-STRING-INPUT-STREAM (STRINGS) (COND ((NULL STRINGS) NIL) ((NULL (CL:REST STRINGS)) (CL:MAKE-STRING-INPUT-STREAM (CL:FIRST STRINGS))) (T (CL:APPLY 'CL:MAKE-CONCATENATED-STREAM (FOR STRING IN STRINGS COLLECT (CL:MAKE-STRING-INPUT-STREAM STRING)))))) (CL:DEFUN %MAKE-INITIAL-STRING-STREAM-CONTENTS () (CL:MAKE-ARRAY '(256) :ELEMENT-TYPE 'CL:STRING-CHAR :EXTENDABLE T :FILL-POINTER 0)) (DEFMACRO CL:WITH-OPEN-STREAM ((VAR STREAM) &BODY (BODY DECLS)) (LET ((ABORTP (GENSYM))) `(LET ((,VAR ,STREAM) (,ABORTP T)) ,@DECLS (CL:UNWIND-PROTECT (CL:MULTIPLE-VALUE-PROG1 (PROGN ,@BODY) (SETQ ,ABORTP NIL)) (CL:CLOSE ,VAR :ABORT ,ABORTP))))) (DEFMACRO CL:WITH-INPUT-FROM-STRING ((CL::VAR STRING &KEY (CL::INDEX NIL CL::INDEXP) (CL::START 0 CL::STARTP) (CL::END NIL CL:ENDP)) &BODY (CL::BODY CL::DECLS)) `(LET* ((CL::$STRING$ ,STRING) (CL::$START$ ,CL::START)) (DECLARE (LOCALVARS CL::$STRING$ CL::$START$)) (CL:WITH-OPEN-STREAM (,CL::VAR (CL:MAKE-STRING-INPUT-STREAM CL::$STRING$ CL::$START$ ,CL::END)) ,@CL::DECLS ,@(CL:IF CL::INDEXP (* |;;| "This exists as a fudge for the fat string problem. It WILL GO AWAY when STRINGSTREAMS HAVE THEIR OWN DEVICE.") `((CL:MULTIPLE-VALUE-PROG1 (PROGN ,@CL::BODY) (* |;;| "(IF (FASL::FAT-STRING-P $STRING$) (SETF ,INDEX (+ $START$ (IL:IQUOTIENT (IL:GETFILEPTR ,VAR) 2))) (SETF ,INDEX (+ $START$ (IL:GETFILEPTR ,VAR))))") (CL:SETF ,CL::INDEX (+ CL::$START$ (GETFILEPTR ,CL::VAR))))) CL::BODY)))) (DEFMACRO CL:WITH-OUTPUT-TO-STRING ((VAR &OPTIONAL (STRING NIL ST-P)) &BODY (FORMS DECLS)) (COND (ST-P `(CL:WITH-OPEN-STREAM (,VAR (MAKE-FILL-POINTER-OUTPUT-STREAM ,STRING)) ,@DECLS ,@FORMS)) (T `(CL:WITH-OPEN-STREAM (,VAR (CL:MAKE-STRING-OUTPUT-STREAM)) ,@DECLS (PROGN ,@FORMS (CL:GET-OUTPUT-STREAM-STRING ,VAR)))))) (DEFMACRO CL:WITH-OPEN-FILE ((VAR &REST OPEN-ARGS) &BODY (FORMS DECLS)) (* |;;;| "The file whose name is File-Name is opened using the OPEN-ARGS and bound to the variable VAR. The Forms are executed, and when they terminate, normally or otherwise, the file is closed.") (LET ((ABORTP (GENSYM))) `(LET ((,VAR (OPEN ,@OPEN-ARGS)) (,ABORTP T)) ,@DECLS (CL:UNWIND-PROTECT (CL:MULTIPLE-VALUE-PROG1 (PROGN ,@FORMS) (SETQ ,ABORTP NIL)) (CL:CLOSE ,VAR :ABORT ,ABORTP))))) (DEFINLINE CL:MAKE-STRING-OUTPUT-STREAM () (* |;;;| "A function for producing a string stream. See also the function get-output-stream-string. Also, see CLtL p. 330") (MAKE-FILL-POINTER-OUTPUT-STREAM)) (CL:DEFUN MAKE-FILL-POINTER-OUTPUT-STREAM (&OPTIONAL (STRING (  %MAKE-INITIAL-STRING-STREAM-CONTENTS ))) (DECLARE (GLOBALVARS \\FILL-POINTER-STREAM-DEVICE)) (|if| (NOT (CL:ARRAY-HAS-FILL-POINTER-P STRING)) |then| (\\ILLEGAL.ARG STRING) |else| (LET ((STREAM (|create| STREAM DEVICE _ \\FILL-POINTER-STREAM-DEVICE F1 _ STRING ACCESS _ 'OUTPUT OTHERPROPS _ '(STRING-OUTPUT-STREAM T)))) (* \;  "give it a canned property list to save some consing.") (|replace| (STREAM OUTCHARFN) |of| STREAM |with| (|if| (EXTENDABLE-ARRAY-P STRING) |then| (FUNCTION \\ADJUSTABLE-STRING-STREAM-OUTCHARFN) |else| (FUNCTION \\STRING-STREAM-OUTCHARFN))) (|replace| (STREAM STRMBOUTFN) |of| STREAM |with| (FUNCTION \\OUTCHAR)) STREAM))) (CL:DEFUN CL:GET-OUTPUT-STREAM-STRING (STRING-OUTPUT-STREAM) (* |;;;| "A CommonLisp function for getting the contents of the buffer created by a call to make-string-output-stream. See CLtL p. 330") (|if| (NOT (STREAMPROP STRING-OUTPUT-STREAM 'STRING-OUTPUT-STREAM)) |then| (ERROR "Stream not a string-output-stream" STRING-OUTPUT-STREAM) |else| (PROG1 (|fetch| (STREAM F1) |of| STRING-OUTPUT-STREAM) (|replace| (STREAM F1) |of| STRING-OUTPUT-STREAM |with| (  %MAKE-INITIAL-STRING-STREAM-CONTENTS ))))) (CL:DEFUN \\STRING-STREAM-OUTCHARFN (STREAM CHAR) (IF (OR (IEQP (FETCH (STREAM CHARPOSITION) OF STREAM) (FETCH (STREAM LINELENGTH) OF STREAM)) (EQ CHAR (CHARCODE EOL))) THEN (REPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) ELSE (ADD (FETCH (STREAM CHARPOSITION) OF STREAM) 1)) (CL:VECTOR-PUSH (CL:CHARACTER CHAR) (FETCH (STREAM F1) OF STREAM))) (CL:DEFUN \\ADJUSTABLE-STRING-STREAM-OUTCHARFN (STREAM CHAR) (LET ((STRING (FETCH (STREAM F1) OF STREAM)) (CH (CL:CHARACTER CHAR))) (IF (OR (IEQP (FETCH (STREAM CHARPOSITION) OF STREAM) (FETCH (STREAM LINELENGTH) OF STREAM)) (EQ CHAR (CHARCODE EOL))) THEN (REPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) ELSE (ADD (FETCH (STREAM CHARPOSITION) OF STREAM) 1)) (* |;;| "Do the equivalent of VECTOR-PUSH-EXTEND inline to save the significant! overhead of calculating the new length at each character.") (CL:UNLESS (CL:VECTOR-PUSH CH STRING) (LET ((CURRENT-LENGTH (CL:ARRAY-TOTAL-SIZE STRING))) (IF (>= CURRENT-LENGTH (CL:1- CL:ARRAY-TOTAL-SIZE-LIMIT)) THEN (PROCEED-CASE (CL:ERROR 'END-OF-FILE :STREAM STREAM) (SI::RETRY-OUTCHAR NIL :REPORT "VECTOR-PUSH the character anyway" :CONDITION END-OF-FILE (CL:VECTOR-PUSH CH (FETCH (STREAM F1) OF STREAM)) )) ELSE (CL:ADJUST-ARRAY STRING (MIN (CL:1- CL:ARRAY-TOTAL-SIZE-LIMIT) (+ CURRENT-LENGTH (MAX (LRSH CURRENT-LENGTH 1) *DEFAULT-PUSH-EXTENSION-SIZE* )))) (CL:VECTOR-PUSH CH STRING)))))) (* |;;| "helpers") (CL:DEFUN %NEW-FILE (FILENAME) (CLOSEF (OPENSTREAM FILENAME 'OUTPUT 'NEW))) (CL:DEFUN PREDICT-NAME (PATHNAME) (LET ((PATH (CL:PROBE-FILE PATHNAME))) (IF PATH THEN (CL:NAMESTRING PATH)))) (DECLARE\: EVAL@COMPILE DONTCOPY (DEFMACRO INTERLISP-ACCESS (DIRECTION) `(CASE ,DIRECTION (:INPUT 'INPUT) (:OUTPUT 'OUTPUT) (:IO 'BOTH) (T NIL))) ) (* |;;| "methods for the special devices") (DEFINEQ (%broadcast-stream-device-bout (lambda (stream byte) (* \; "Edited 13-Jan-87 14:45 by hdj") (* |;;| "The BOUT method for the broadcast-stream device") (|for| s |in| (|fetch| f1 |of| stream) |do| (\\bout s byte)) byte) ) (%broadcast-stream-device-outcharfn (lambda (stream charcode) (* \; "Edited 18-Mar-87 11:00 by lal") (* |;;| "outcharfn for broadcast streams") (* |;;| "Using the charposition from the first stream in the broadcast stream list") (|for| s |in| (|fetch| (stream f1) |of| stream) |do| (\\outchar s charcode)) (|replace| (stream charposition) |of| stream |with| (|fetch| (stream charposition) |of| (car (|fetch| (stream f1) |of| stream)))) charcode) ) (%broadcast-stream-device-closefile (lambda (stream) (* |hdj| "26-Mar-86 16:28") (* |;;;| "The CLOSEFILE method for the broadcast-stream device") (|replace| access |of| stream |with| nil) (|replace| f1 |of| stream |with| nil) stream) ) (%broadcast-stream-device-forceoutput (lambda (|stream| |waitForFinish?|) (* |smL| "14-Aug-85 15:55") (* |;;;| "The FORCEOUTPUT method for the broadcast-stream device") (|for| \s |in| (|fetch| f1 |of| |stream|) |do| (forceoutput \s |waitForFinish?|))) ) ) (CL:DEFUN %BROADCAST-STREAM-DEVICE-CHARSETFN (STREAM NEWVALUE) (* |;;| "charset function for broadcast streams. Not clear what the value should be, so we arbitrarily return the value of the last stream.") (FOR S IN (FETCH (STREAM F1) OF STREAM) DO (SETQ $$VAL (ACCESS-CHARSET S NEWVALUE)))) (DEFINEQ (%concatenated-stream-device-bin (lambda (stream) (* \; "Edited 13-Jan-87 14:52 by hdj") (* |;;| "The BIN method for the concatenated-stream device") (while (fetch (stream f1) of stream) do (if (eofp (car (fetch (stream f1) of stream))) then (closef (pop (fetch (stream f1) of stream))) else (return (\\bin (car (fetch (stream f1) of stream))))) finally (* \; "the EOF case") (\\eof.action stream))) ) (%concatenated-stream-device-closefile (lambda (|stream|) (* |smL| "14-Aug-85 16:53") (* |;;;| "The CLOSEFILE method for the concatenated-stream device") (|replace| access |of| |stream| |with| nil) (|for| \s |in| (|fetch| f1 |of| |stream|) |do| (closef \s)) (|replace| f1 |of| |stream| |with| nil) |stream|) ) (%concatenated-stream-device-eofp (lambda (|stream|) (* \; "Edited 17-Mar-87 09:20 by lal") (* |;;;| "The EOFP method for the concatenated-stream device") (|while| (|fetch| f1 |of| |stream|) |do| (|if| (eofp (car (|fetch| f1 |of| |stream|))) |then| (closef (|pop| (|fetch| f1 |of| |stream|))) |else| (return nil)) |finally| (* \; "the EOF case") (return t))) ) (%concatenated-stream-device-peekbin (lambda (|stream| |noErrorFlg?|) (* |smL| "14-Aug-85 16:53") (* |;;;| "The PEEKBIN method for the concatenated-stream device") (|while| (|fetch| f1 |of| |stream|) |do| (|if| (eofp (car (|fetch| f1 |of| |stream|))) |then| (closef (|pop| (|fetch| f1 |of| |stream|))) |else| (return (\\peekbin (car (|fetch| f1 |of| |stream|))))) |finally| (* \; "the EOF case") (|if| |noErrorFlg?| |then| (return nil) |else| (\\eof.action |stream|)))) ) (%concatenated-stream-device-backfileptr (lambda (|stream|) (* \; "Edited 24-Mar-87 10:47 by lal") (* |;;| "concatenated streams are read sequentially and a list of them are kept in F1. as they are read, the used stream is removed from the list. \\backfileptr will work because 1) when a file is stream is used up the new one is read, at least one character's worth and 2) \\backfileptr only needs to back up one character") (\\backfileptr (car (|fetch| f1 |of| |stream|)))) ) ) (CL:DEFUN %CONCATENATED-STREAM-DEVICE-CHARSETFN (STREAM NEWVALUE) (* |;;| "the charset method for concatenated stream devices") (LET ((STREAMS (FETCH (STREAM F1) OF STREAM))) (IF STREAMS THEN (ACCESS-CHARSET (CAR STREAMS) NEWVALUE) ELSE 0))) (DEFINEQ (%echo-stream-device-bin (lambda (stream) (* |hdj| "21-Apr-86 18:33") (* |;;;| "The BIN method for the echo-stream device") (let ((byte (%two-way-stream-device-bin stream))) (\\bout stream byte) byte)) ) ) (CL:DEFUN %SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM (SYNONYM-STREAM) (* |;;| "given a synonym-stream, find out what it is currently tracking") (CL:SYMBOL-VALUE (XCL:SYNONYM-STREAM-SYMBOL SYNONYM-STREAM))) (DEFINEQ (%synonym-stream-device-bin (lambda (stream) (* |hdj| "19-Mar-86 17:19") (* |;;;| "The BIN method for the synonym-stream device.") (\\bin (%synonym-stream-device-get-stream stream))) ) (%synonym-stream-device-bout (lambda (stream byte) (* |hdj| "19-Mar-86 17:20") (* |;;;| "The BOUT method for the synonym-stream device.") (\\bout (%synonym-stream-device-get-stream stream) byte)) ) (%SYNONYM-STREAM-DEVICE-OUTCHARFN (LAMBDA (STREAM CHARCODE) (* \; "Edited 3-Jan-90 15:25 by jds") (* |;;| " OUTCHARFN for synonym streams") (LET ((OTHER-STREAM (%SYNONYM-STREAM-DEVICE-GET-STREAM STREAM))) (\\OUTCHAR OTHER-STREAM CHARCODE) (|freplace| (STREAM CHARPOSITION) |of| STREAM |with| (|ffetch| (STREAM CHARPOSITION ) |of| OTHER-STREAM))) )) (%SYNONYM-STREAM-DEVICE-CLOSEFILE (LAMBDA (STREAM) (* \; "Edited 18-Dec-87 12:17 by sye") (* |;;;| "the CLOSEFILE method for the synonym-stream device") (|replace| F1 |of| STREAM |with| NIL) (* |;;|  "remove the synonym stream STREAM from the OPENFILELST field of %SYNONYM-STREAM-DEVICE") (|replace| (FDEV OPENFILELST) |of| %SYNONYM-STREAM-DEVICE |with| (DREMOVE STREAM (|fetch| (FDEV OPENFILELST) |of| %SYNONYM-STREAM-DEVICE))) STREAM)) (%synonym-stream-device-eofp (lambda (stream) (* |hdj| "19-Mar-86 17:20") (* |;;;| "The EOFP method for the synonym-stream device.") (\\eofp (%synonym-stream-device-get-stream stream))) ) (%synonym-stream-device-forceoutput (lambda (stream waitforfinish) (* |hdj| "19-Mar-86 17:09") (* |;;;| "The FORCEOUTPUT method for the synonym-stream device.") (forceoutput (%synonym-stream-device-get-stream stream) waitforfinish)) ) (%synonym-stream-device-getfileinfo (lambda (stream attribute device) (* |hdj| "19-Mar-86 17:10") (* |;;;| "The GETFILEINFO method for the synonym-stream device.") (getfileinfo (%synonym-stream-device-get-stream stream) attribute)) ) (%synonym-stream-device-peekbin (lambda (stream noerrorflg?) (* |hdj| "19-Mar-86 17:12") (* |;;;| "The PEEKBIN method for the synonym-stream device") (\\peekbin (%synonym-stream-device-get-stream stream) noerrorflg?)) ) (%synonym-stream-device-readp (lambda (stream flg) (readp (%synonym-stream-device-get-stream stream) flg))) (%synonym-stream-device-backfileptr (lambda (stream) (* |hdj| "26-Aug-86 17:35") (\\backfileptr (%synonym-stream-device-get-stream stream))) ) (%synonym-stream-device-setfileinfo (lambda (stream attribute value device) (* |hdj| "19-Mar-86 17:17") (* |;;;| "The SETFILEINFO method for the synonym-stream device.") (setfileinfo (%synonym-stream-device-get-stream stream) attribute value)) ) (%synonym-stream-device-charsetfn (lambda (stream newvalue) (* \; "Edited 11-Sep-87 16:01 by bvm:") (* |;;| "The charset method for the synonym-stream device.") (access-charset (%synonym-stream-device-get-stream stream) newvalue)) ) ) (DEFINEQ (%two-way-stream-device-bin (lambda (|stream|) (* |smL| "14-Aug-85 16:44") (* |;;;| "The BIN method for the two-way-stream device") (\\bin (|fetch| f1 |of| |stream|))) ) (%two-way-stream-device-inputstream (lambda (|stream|) (* \; "Edited 14-Apr-87 16:59 by bvm:") (* |;;;| "Fetch the real input for the two-way-stream device") (|fetch| f1 |of| |stream|)) ) (%two-way-stream-device-bout (lambda (stream byte) (* |hdj| "17-Sep-86 15:28") (* |;;| " the BOUT method for two-way streams") (\\bout (|fetch| f2 |of| stream) byte)) ) (%two-way-stream-device-outputstream (lambda (stream byte) (* \; "Edited 14-Apr-87 16:59 by bvm:") (* |;;| "Fetch the real output stream for two-way streams") (|fetch| f2 |of| stream)) ) (%TWO-WAY-STREAM-DEVICE-OUTCHARFN (LAMBDA (STREAM CHARCODE) (* \; "Edited 3-Jan-90 15:26 by jds") (* |;;| "outcharfn for two-way streams") (\\OUTCHAR (|fetch| (STREAM F2) |of| STREAM) CHARCODE) (|freplace| (STREAM CHARPOSITION) |of| STREAM |with| (|ffetch| (STREAM CHARPOSITION ) |of| (|ffetch| (STREAM F2) |of| STREAM)) ))) (%TWO-WAY-STREAM-DEVICE-CLOSEFILE (LAMBDA (|stream|) (* \; "Edited 18-Dec-87 12:32 by sye") (* |;;;| "The CLOSEFILE method for the two-way-stream device and echo-stream device") (LET ((STREAMDEVICE (|if| (XCL:TWO-WAY-STREAM-P |stream|) |then| %TWO-WAY-STREAM-DEVICE |else| %ECHO-STREAM-DEVICE))) (|replace| ACCESS |of| |stream| |with| NIL) (CLOSEF? (|fetch| F1 |of| |stream|)) (|replace| F1 |of| |stream| |with| NIL) (CLOSEF? (|fetch| F2 |of| |stream|)) (|replace| F2 |of| |stream| |with| NIL) (* |;;|  "remove STREAM from the OPENFILELST field of %TWO-WAY-STREAM-DEVICE or %ECHO-STREAM-DEVICE") (|replace| (FDEV OPENFILELST) |of| STREAMDEVICE |with| (DREMOVE |stream| (|fetch| (FDEV OPENFILELST ) |of| STREAMDEVICE))) |stream|))) (%two-way-stream-device-eofp (lambda (|stream|) (* |smL| "14-Aug-85 16:47") (* |;;;| "The EOFP method for the two-way-stream device") (\\eofp (|fetch| f1 |of| |stream|))) ) (%two-way-stream-device-readp (lambda (stream flg) (* \; "Edited 14-Apr-87 17:01 by bvm:") (* |;;;| "The READP method for the two-way-stream device") (readp (|fetch| f1 |of| stream) flg)) ) (%two-way-stream-device-backfileptr (lambda (stream) (* |hdj| "15-Sep-86 15:02") (\\backfileptr (|fetch| (stream f1) |of| stream)))) (%two-way-stream-device-forceoutput (lambda (|stream| |waitForFinish?|) (* |smL| "14-Aug-85 16:49") (* |;;;| "the FORCEOUTPUT method for the two-way-stream device") (forceoutput (|fetch| f2 |of| |stream|) |waitForFinish?|)) ) (%two-way-stream-device-peekbin (lambda (|stream| |noErrorFlg?|) (* |smL| "14-Aug-85 16:46") (* |;;;| "The PEEKBIN method for the two-way-stream device") (\\peekbin (|fetch| f1 |of| |stream|) |noErrorFlg?|)) ) (%two-way-stream-device-charsetfn (lambda (stream newvalue) (* \; "Edited 11-Sep-87 16:00 by bvm:") (* |;;| "The charset method for two-way streams. Unclear what this is supposed to mean--let's apply it only to the input side (in which case newvalue is senseless)") (access-charset (|fetch| (stream f1) |of| stream) newvalue)) ) ) (CL:DEFUN %FILL-POINTER-STREAM-DEVICE-CLOSEFILE (STREAM &OPTIONAL ABORTFLAG) (* |;;;| "the CLOSEFILE method for the fill-pointer-string-stream device") (|replace| F1 |of| STREAM |with| NIL) STREAM) (CL:DEFUN %FILL-POINTER-STREAM-DEVICE-GETFILEPTR (STREAM) (CL:LENGTH (|fetch| (STREAM F1) |of| STREAM))) (DECLARE\: DOEVAL@COMPILE DONTCOPY (GLOBALVARS %SYNONYM-STREAM-DEVICE %BROADCAST-STREAM-DEVICE %CONCATENATED-STREAM-DEVICE %TWO-WAY-STREAM-DEVICE %ECHO-STREAM-DEVICE \\FILL-POINTER-STREAM-DEVICE) ) (* |;;| "helper stuff") (DEFINEQ (%synonym-stream-device-get-stream (lambda (|stream|) (* \; "Edited 12-Jan-87 14:46 by hdj") (* |;;| "given a synonym-stream, find out what it is currently tracking") (cl:symbol-value (|fetch| (stream f1) |of| |stream|))) ) ) (* |;;| "module initialization") (CL:DEFVAR *DEBUG-IO*) (CL:DEFVAR *QUERY-IO*) (CL:DEFVAR *TERMINAL-IO*) (CL:DEFVAR *ERROR-OUTPUT*) (CL:DEFVAR *STANDARD-OUTPUT*) (CL:DEFVAR *STANDARD-INPUT*) (CL:DEFUN %INITIALIZE-STANDARD-STREAMS () (* |;;|  "Called when CLSTREAMS is loaded. Almost everything is same as *TERMINAL-IO* to start with.") (CL:SETQ *QUERY-IO* (CL:MAKE-TWO-WAY-STREAM (CL:MAKE-SYNONYM-STREAM '\\LINEBUF.OFD) (CL:MAKE-SYNONYM-STREAM '\\TERM.OFD))) (CL:SETQ *DEBUG-IO* *QUERY-IO*) (CL:SETQ *TERMINAL-IO* *QUERY-IO*) (CL:SETQ *ERROR-OUTPUT* (CL:MAKE-SYNONYM-STREAM '\\TERM.OFD))) (DEFINEQ (%initialize-clstream-types (lambda nil (* \; "Edited 14-Apr-87 17:08 by bvm:") (* |;;| "Initialize the CLSTREAMS package. This sets up some file devices for the functions make-two-way-stream-device, etc. See CLtL chapter 21") (setq %broadcast-stream-device (|create| fdev devicename _ (quote broadcast-stream-device) resetable _ nil randomaccessp _ nil nodirectories _ t buffered _ nil pagemapped _ nil fdbinable _ nil fdboutable _ nil fdextendable _ nil deviceinfo _ nil hostnamep _ (function nill) eventfn _ (function nill) directorynamep _ (function nill) reopenfile _ (function nill) closefile _ (function %broadcast-stream-device-closefile) getfilename _ (function nill) deletefile _ (function nill) generatefiles _ (function \\generatenofiles) renamefile _ (function nill) bin _ (function nill) bout _ (function %broadcast-stream-device-bout) peekbin _ (function nill) readp _ (function nill) eofp _ (function true) blockin _ (function \\generic.bins) blockout _ (function nill) forceoutput _ (function %broadcast-stream-device-forceoutput) getfileinfo _ (function nill) setfileinfo _ (function nill) charsetfn _ (function %broadcast-stream-device-charsetfn))) (setq %concatenated-stream-device (|create| fdev devicename _ (quote concatenated-stream-device) resetable _ nil randomaccessp _ nil nodirectories _ t buffered _ nil pagemapped _ nil fdbinable _ nil fdboutable _ nil fdextendable _ nil deviceinfo _ nil hostnamep _ (function nill) eventfn _ (function nill) directorynamep _ (function nill) reopenfile _ (function nill) closefile _ (function %concatenated-stream-device-closefile) getfilename _ (function nill) deletefile _ (function nill) generatefiles _ (function \\generatenofiles) renamefile _ (function nill) bin _ (function %concatenated-stream-device-bin) bout _ (function nill) peekbin _ (function %concatenated-stream-device-peekbin) readp _ (function \\generic.readp) backfileptr _ (function %concatenated-stream-device-backfileptr) eofp _ (function %concatenated-stream-device-eofp) blockin _ (function \\generic.bins) blockout _ (function nill) forceoutput _ (function nill) getfileinfo _ (function nill) setfileinfo _ (function nill) charsetfn _ (function %concatenated-stream-device-charsetfn))) (setq %two-way-stream-device (|create| fdev devicename _ (quote two-way-stream-device) resetable _ nil randomaccessp _ nil nodirectories _ t buffered _ nil pagemapped _ nil fdbinable _ nil fdboutable _ nil fdextendable _ nil input-indirected _ t output-indirected _ t deviceinfo _ nil hostnamep _ (function nill) eventfn _ (function nill) directorynamep _ (function nill) reopenfile _ (function nill) closefile _ (function %two-way-stream-device-closefile) getfilename _ (function nill) deletefile _ (function nill) generatefiles _ (function \\generatenofiles) renamefile _ (function nill) bin _ (function %two-way-stream-device-bin) bout _ (function %two-way-stream-device-bout) peekbin _ (function %two-way-stream-device-peekbin) readp _ (function %two-way-stream-device-readp) backfileptr _ (function %two-way-stream-device-backfileptr) eofp _ (function %two-way-stream-device-eofp) blockin _ (function \\generic.bins) blockout _ (function \\generic.bouts) forceoutput _ (function %two-way-stream-device-forceoutput) getfileinfo _ (function nill) setfileinfo _ (function nill) charsetfn _ (function %two-way-stream-device-charsetfn) inputstream _ (function %two-way-stream-device-inputstream) outputstream _ (function %two-way-stream-device-outputstream))) (setq %echo-stream-device (|create| fdev |using| %two-way-stream-device devicename _ (quote echo-stream-device) bin _ (function %echo-stream-device-bin))) (setq %synonym-stream-device (|create| fdev devicename _ (quote synonym-stream-device) resetable _ nil randomaccessp _ nil nodirectories _ t buffered _ nil pagemapped _ nil fdbinable _ nil fdboutable _ nil fdextendable _ nil deviceinfo _ nil input-indirected _ t output-indirected _ t hostnamep _ (function nill) eventfn _ (function nill) directorynamep _ (function nill) reopenfile _ (function nill) closefile _ (function %synonym-stream-device-closefile) getfilename _ (function nill) deletefile _ (function nill) generatefiles _ (function \\generatenofiles) renamefile _ (function nill) bin _ (function %synonym-stream-device-bin) bout _ (function %synonym-stream-device-bout) peekbin _ (function %synonym-stream-device-peekbin) readp _ (function %synonym-stream-device-readp) backfileptr _ (function %synonym-stream-device-backfileptr) eofp _ (function %synonym-stream-device-eofp) blockin _ (function \\generic.bins) blockout _ (function \\generic.bouts) forceoutput _ (function %synonym-stream-device-forceoutput) getfileinfo _ (function %synonym-stream-device-getfileinfo) setfileinfo _ (function %synonym-stream-device-setfileinfo) inputstream _ (function %synonym-stream-device-get-indirect-stream) outputstream _ (function %synonym-stream-device-get-indirect-stream) charsetfn _ (function %synonym-stream-device-charsetfn))) (setq \\fill-pointer-stream-device (|create| fdev devicename _ (quote fill-pointer-stream-device) resetable _ nil randomaccessp _ nil nodirectories _ t buffered _ nil pagemapped _ nil fdbinable _ nil fdboutable _ nil fdextendable _ nil deviceinfo _ nil hostnamep _ (function nill) eventfn _ (function nill) directorynamep _ (function nill) openfile _ (function nill) reopenfile _ (function nill) closefile _ (function %fill-pointer-stream-device-closefile) getfilename _ (function nill) deletefile _ (function nill) generatefiles _ (function \\generatenofiles) renamefile _ (function nill) bin _ (function \\illegal.deviceop) bout _ (function nill) peekbin _ (function \\illegal.deviceop) readp _ (function \\illegal.deviceop) eofp _ (function nill) blockin _ (function \\illegal.deviceop) blockout _ (function \\generic.bouts) forceoutput _ (function nill) getfileptr _ (function %fill-pointer-stream-device-getfileptr) setfileinfo _ (function \\illegal.deviceop)))) ) ) (DECLARE\: DONTEVAL@LOAD DOCOPY (%INITIALIZE-CLSTREAM-TYPES) (%INITIALIZE-STANDARD-STREAMS) ) (PUTPROPS CLSTREAMS FILETYPE CL:COMPILE-FILE) (PUTPROPS CLSTREAMS COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991)) (DECLARE\: DONTCOPY (FILEMAP (NIL (34128 35316 (%BROADCAST-STREAM-DEVICE-BOUT 34138 . 34361) ( %BROADCAST-STREAM-DEVICE-OUTCHARFN 34363 . 34814) (%BROADCAST-STREAM-DEVICE-CLOSEFILE 34816 . 35055) ( %BROADCAST-STREAM-DEVICE-FORCEOUTPUT 35057 . 35314)) (35732 37791 (%CONCATENATED-STREAM-DEVICE-BIN 35742 . 36147) (%CONCATENATED-STREAM-DEVICE-CLOSEFILE 36149 . 36462) (%CONCATENATED-STREAM-DEVICE-EOFP 36464 . 36828) (%CONCATENATED-STREAM-DEVICE-PEEKBIN 36830 . 37305) ( %CONCATENATED-STREAM-DEVICE-BACKFILEPTR 37307 . 37789)) (38129 38348 (%ECHO-STREAM-DEVICE-BIN 38139 . 38346)) (38576 41921 (%SYNONYM-STREAM-DEVICE-BIN 38586 . 38774) (%SYNONYM-STREAM-DEVICE-BOUT 38776 . 38977) (%SYNONYM-STREAM-DEVICE-OUTCHARFN 38979 . 39686) (%SYNONYM-STREAM-DEVICE-CLOSEFILE 39688 . 40272) (%SYNONYM-STREAM-DEVICE-EOFP 40274 . 40465) (%SYNONYM-STREAM-DEVICE-FORCEOUTPUT 40467 . 40705) (%SYNONYM-STREAM-DEVICE-GETFILEINFO 40707 . 40944) (%SYNONYM-STREAM-DEVICE-PEEKBIN 40946 . 41169) ( %SYNONYM-STREAM-DEVICE-READP 41171 . 41282) (%SYNONYM-STREAM-DEVICE-BACKFILEPTR 41284 . 41430) ( %SYNONYM-STREAM-DEVICE-SETFILEINFO 41432 . 41681) (%SYNONYM-STREAM-DEVICE-CHARSETFN 41683 . 41919)) ( 41922 46247 (%TWO-WAY-STREAM-DEVICE-BIN 41932 . 42105) (%TWO-WAY-STREAM-DEVICE-INPUTSTREAM 42107 . 42298) (%TWO-WAY-STREAM-DEVICE-BOUT 42300 . 42472) (%TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM 42474 . 42664) (%TWO-WAY-STREAM-DEVICE-OUTCHARFN 42666 . 43528) (%TWO-WAY-STREAM-DEVICE-CLOSEFILE 43530 . 44953) ( %TWO-WAY-STREAM-DEVICE-EOFP 44955 . 45131) (%TWO-WAY-STREAM-DEVICE-READP 45133 . 45326) ( %TWO-WAY-STREAM-DEVICE-BACKFILEPTR 45328 . 45464) (%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 45466 . 45695) ( %TWO-WAY-STREAM-DEVICE-PEEKBIN 45697 . 45910) (%TWO-WAY-STREAM-DEVICE-CHARSETFN 45912 . 46245)) (46835 47074 (%SYNONYM-STREAM-DEVICE-GET-STREAM 46845 . 47072)) (47780 53743 (%INITIALIZE-CLSTREAM-TYPES 47790 . 53741))))) STOP