EXTERNALFORMAT: Add \FORMATBYTESTRING, EOLC arg to \INCCODE.EOLC
Also, STREAM can be given as the format argument to \EXTERNALFORMAT, gets the stream's format. Atoms (LF, CR, CRLF, ANY) allowed for EOL specs (caller won't need exports.all)
This commit is contained in:
@@ -1,18 +1,21 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "19-Sep-2021 08:59:42"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>EXTERNALFORMAT.;16 31868
|
||||
|
||||
changes to%: (VARS EXTERNALFORMATCOMS)
|
||||
(FILECREATED "22-Jun-2022 11:09:34"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;30 32742
|
||||
|
||||
previous date%: "11-Sep-2021 09:44:04"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>EXTERNALFORMAT.;15)
|
||||
:CHANGES-TO (FNS \FORMATBYTESTREAM \FORMATBYTESTRING \EXTERNALFORMAT)
|
||||
(RESOURCES \FORMATBYTESTRING.STREAM)
|
||||
(VARS EXTERNALFORMATCOMS)
|
||||
|
||||
:PREVIOUS-DATE "18-Jun-2022 22:04:22"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;21)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT EXTERNALFORMATCOMS)
|
||||
|
||||
(RPAQQ EXTERNALFORMATCOMS
|
||||
[(COMS (* ;
|
||||
"EXTERNALFORMAT declaration and related functions (originally on FILEIO)")
|
||||
"EXTERNALFORMAT declaration and related functions (originally on FILEIO)")
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (RECORDS EXTERNALFORMAT)))
|
||||
(INITRECORDS EXTERNALFORMAT)
|
||||
(SYSRECORDS EXTERNALFORMAT)
|
||||
@@ -22,12 +25,14 @@
|
||||
(INITVARS (*EXTERNALFORMATS* NIL)
|
||||
[*DEFAULT-EXTERNALFORMATS* '((DSK :XCCS]
|
||||
(*DEFAULT-EXTERNALFORMAT* :XCCS)))
|
||||
[COMS
|
||||
(COMS
|
||||
(* ;; "Generic functions not compiled open (originally on LLREAD)")
|
||||
|
||||
(FNS \OUTCHAR \INCCODE \BACKCCODE \BACKCCODE.EOLC \PEEKCCODE \PEEKCCODE.NOEOLC
|
||||
\INCCODE.EOLC \FORMATBYTESTREAM \CHECKEOLC.CRLF)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (MACROS \CHECKEOLC]
|
||||
\INCCODE.EOLC \FORMATBYTESTREAM \FORMATBYTESTRING \CHECKEOLC.CRLF)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (MACROS \CHECKEOLC))
|
||||
(RESOURCES \FORMATBYTESTRING.STREAM))
|
||||
(INITRESOURCES \FORMATBYTESTRING.STREAM))
|
||||
(COMS
|
||||
(* ;; "Also from FILEIO, but not clear that this is or ever has been used.")
|
||||
|
||||
@@ -41,28 +46,30 @@
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG) (* ; "If true, the value of EOL field will replace the EOLCONVENTION field of the resulted stream. (Can't test EOL because it is always something)")
|
||||
(EOL BITS 2)
|
||||
(UNSTABLE FLAG) (* ; "T if (like XCCS runcodes) the byte encoding of a given character can change by other signals in the file, NIL if every charactercode has a single byte encoding (like UTF-8). ")
|
||||
(INCCODEFN POINTER) (* ;
|
||||
"Called with STREAM and 2 optional arguments, BYTECOUNTVAR and BYTECOUNTVAL")
|
||||
(PEEKCCODEFN POINTER) (* ;
|
||||
"Called with three arguments -- STREAM, NOERROR, and EOL")
|
||||
(BACKCCODEFN POINTER) (* ;
|
||||
"Called with STREAM and optional BYTECOUNTVAR and BYTECOUNTVAL")
|
||||
(OUTCHARFN POINTER) (* ;
|
||||
"Called with two arguments -- STREAM and CHARCODE")
|
||||
(NAME POINTER) (* ;
|
||||
"keyword name of this format, provided to \INSTALL.EXTERNALFORMAT")
|
||||
(FORMATBYTESTREAMFN POINTER) (* ; "Function to copy the format state of a given stream to an IO stream that allows formatted byte sequences to be examined")
|
||||
(EF1 POINTER) (* ;
|
||||
"Extra fields for use of particular formats. Possibly to hold standardized translation tables")
|
||||
(EF2 POINTER)))
|
||||
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG) (* ; "If true, the value of EOL field will replace the EOLCONVENTION field of the resulted stream. (Can't test EOL because it is always something)")
|
||||
(EOL BITS 2)
|
||||
(UNSTABLE FLAG) (* ; "T if (like XCCS runcodes) the byte encoding of a given character can change by other signals in the file, NIL if every charactercode has a single byte encoding (like UTF-8). ")
|
||||
(INCCODEFN POINTER) (* ;
|
||||
"Called with STREAM and 2 optional arguments, BYTECOUNTVAR and BYTECOUNTVAL")
|
||||
(PEEKCCODEFN POINTER) (* ;
|
||||
"Called with three arguments -- STREAM, NOERROR, and EOL")
|
||||
(BACKCCODEFN POINTER) (* ;
|
||||
"Called with STREAM and optional BYTECOUNTVAR and BYTECOUNTVAL")
|
||||
(OUTCHARFN POINTER) (* ;
|
||||
"Called with two arguments -- STREAM and CHARCODE")
|
||||
(NAME POINTER) (* ;
|
||||
"keyword name of this format, provided to \INSTALL.EXTERNALFORMAT")
|
||||
(FORMATBYTESTREAMFN POINTER) (* ; "Function to copy the format state of a given stream to an IO stream that allows formatted byte sequences to be examined")
|
||||
(EF1 POINTER) (* ;
|
||||
"Extra fields for use of particular formats. Possibly to hold standardized translation tables")
|
||||
(EF2 POINTER)
|
||||
(FORMATBYTESTRINGFN POINTER) (* ; "Translates an internal string into a string containing the bytes that represent that string in this format")
|
||||
))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2)
|
||||
FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER
|
||||
POINTER)
|
||||
POINTER POINTER)
|
||||
'((EXTERNALFORMAT 0 (FLAGBITS . 0))
|
||||
(EXTERNALFORMAT 0 (BITS . 17))
|
||||
(EXTERNALFORMAT 0 (FLAGBITS . 48))
|
||||
@@ -73,8 +80,9 @@
|
||||
(EXTERNALFORMAT 8 POINTER)
|
||||
(EXTERNALFORMAT 10 POINTER)
|
||||
(EXTERNALFORMAT 12 POINTER)
|
||||
(EXTERNALFORMAT 14 POINTER))
|
||||
'16)
|
||||
(EXTERNALFORMAT 14 POINTER)
|
||||
(EXTERNALFORMAT 16 POINTER))
|
||||
'18)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
@@ -82,7 +90,7 @@
|
||||
|
||||
(/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2)
|
||||
FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER
|
||||
POINTER)
|
||||
POINTER POINTER)
|
||||
'((EXTERNALFORMAT 0 (FLAGBITS . 0))
|
||||
(EXTERNALFORMAT 0 (BITS . 17))
|
||||
(EXTERNALFORMAT 0 (FLAGBITS . 48))
|
||||
@@ -93,29 +101,36 @@
|
||||
(EXTERNALFORMAT 8 POINTER)
|
||||
(EXTERNALFORMAT 10 POINTER)
|
||||
(EXTERNALFORMAT 12 POINTER)
|
||||
(EXTERNALFORMAT 14 POINTER))
|
||||
'16)
|
||||
(EXTERNALFORMAT 14 POINTER)
|
||||
(EXTERNALFORMAT 16 POINTER))
|
||||
'18)
|
||||
(ADDTOVAR SYSTEMRECLST
|
||||
|
||||
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG)
|
||||
(EOL BITS 2)
|
||||
(UNSTABLE FLAG)
|
||||
(INCCODEFN POINTER)
|
||||
(PEEKCCODEFN POINTER)
|
||||
(BACKCCODEFN POINTER)
|
||||
(OUTCHARFN POINTER)
|
||||
(NAME POINTER)
|
||||
(FORMATBYTESTREAMFN POINTER)
|
||||
(EF1 POINTER)
|
||||
(EF2 POINTER)))
|
||||
(EOL BITS 2)
|
||||
(UNSTABLE FLAG)
|
||||
(INCCODEFN POINTER)
|
||||
(PEEKCCODEFN POINTER)
|
||||
(BACKCCODEFN POINTER)
|
||||
(OUTCHARFN POINTER)
|
||||
(NAME POINTER)
|
||||
(FORMATBYTESTREAMFN POINTER)
|
||||
(EF1 POINTER)
|
||||
(EF2 POINTER)
|
||||
(FORMATBYTESTRINGFN POINTER)))
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\EXTERNALFORMAT
|
||||
[LAMBDA (STREAM NEWFORMAT/NAME) (* ; "Edited 10-Sep-2021 20:44 by rmk:")
|
||||
(* ; "Edited 26-Feb-91 13:20 by nm")
|
||||
[LAMBDA (STREAM NEWFORMAT/NAME)
|
||||
|
||||
(* ;;; ";;; RMK July 2020: Added interface for per-device default external format. \DO.PARAMS.AT.OPEN will make that call even if it is not specified from the open. STREAMPROP is fixed to call \EXTERNALFORMAT to set the property EXTERNALFORMAT, to export a user-level way of manipulating this.")
|
||||
(* ;; "Edited 22-Jun-2022 09:40 by rmk: NEWFORMAT/NAME can be a stream, picks its externalformat")
|
||||
|
||||
(* ;; "Edited 10-Sep-2021 20:44 by rmk:")
|
||||
|
||||
(* ;; "Edited 26-Feb-91 13:20 by nm")
|
||||
|
||||
(* ;;; " July 2020: Added interface for per-device default external format. \DO.PARAMS.AT.OPEN will make that call even if it is not specified from the open. STREAMPROP is fixed to call \EXTERNALFORMAT to set the property EXTERNALFORMAT, to export a user-level way of manipulating this.")
|
||||
|
||||
(* ;;; "")
|
||||
|
||||
@@ -128,52 +143,39 @@
|
||||
(* ;;; "The all-device default is in *DEFAULT-EXTERNALFORMAT* or the DEFAULTEXTERNALFORMAT field of the file device. The list currently has priority since that makes it easier for a user without EXPORTS.ALL to systematically override. That may or may not be a useful capability. ")
|
||||
|
||||
(\DTEST STREAM 'STREAM)
|
||||
(SETQ SAVEDNAME (fetch DEVICENAME of (fetch DEVICE of STREAM)))
|
||||
(SETQ SAVEDDEFAULTFORMATNAME (fetch (FDEV DEFAULTEXTERNALFORMAT) of (fetch DEVICE
|
||||
of STREAM)))
|
||||
(SETQ FOUNDFORMAT (FIND-FORMAT SAVEDDEFAULTFORMATNAME T))
|
||||
(CL:WHEN NEWFORMAT/NAME
|
||||
(CL:WHEN (type? READER-ENVIRONMENT NEWFORMAT/NAME)
|
||||
(SETQ NEWFORMAT/NAME (fetch (READER-ENVIRONMENT REFORMAT) of NEWFORMAT/NAME)))
|
||||
[LET (EXTFORMAT)
|
||||
[COND
|
||||
((type? EXTERNALFORMAT NEWFORMAT/NAME)
|
||||
(SETQ EXTFORMAT NEWFORMAT/NAME))
|
||||
(T (CL:WHEN (EQ NEWFORMAT/NAME :DEFAULT)
|
||||
(SETQ NEWFORMAT/NAME (OR (CADR (ASSOC (fetch DEVICENAME
|
||||
of (fetch DEVICE of
|
||||
STREAM))
|
||||
*DEFAULT-EXTERNALFORMATS*))
|
||||
(fetch (FDEV DEFAULTEXTERNALFORMAT)
|
||||
of (fetch DEVICE of STREAM))
|
||||
*DEFAULT-EXTERNALFORMAT*)))
|
||||
(SETQ EXTFORMAT (FIND-FORMAT NEWFORMAT/NAME))
|
||||
(CL:UNLESS EXTFORMAT (ERROR NEWFORMAT/NAME
|
||||
"is not a registered external format name"))
|
||||
(CL:UNLESS (type? EXTERNALFORMAT EXTFORMAT)
|
||||
(ERROR "INVALID EXTERNALFORMAT " EXTFORMAT]
|
||||
(if (type? EXTERNALFORMAT NEWFORMAT/NAME)
|
||||
then (SETQ EXTFORMAT NEWFORMAT/NAME)
|
||||
elseif (\GETSTREAM NEWFORMAT/NAME NIL T)
|
||||
then (SETQ EXTFORMAT (ffetch (STREAM EXTERNALFORMAT) of NEWFORMAT/NAME))
|
||||
else (CL:WHEN (EQ NEWFORMAT/NAME :DEFAULT)
|
||||
(SETQ NEWFORMAT/NAME (OR (CADR (ASSOC (fetch DEVICENAME
|
||||
of (fetch DEVICE of STREAM))
|
||||
*DEFAULT-EXTERNALFORMATS*))
|
||||
(fetch (FDEV DEFAULTEXTERNALFORMAT)
|
||||
of (fetch DEVICE of STREAM))
|
||||
*DEFAULT-EXTERNALFORMAT*)))
|
||||
(SETQ EXTFORMAT (FIND-FORMAT NEWFORMAT/NAME))
|
||||
(CL:UNLESS EXTFORMAT (ERROR NEWFORMAT/NAME
|
||||
"is not a registered external format name")))
|
||||
(CL:UNLESS (type? EXTERNALFORMAT EXTFORMAT)
|
||||
(ERROR "INVALID EXTERNALFORMAT " EXTFORMAT))
|
||||
(UNINTERRUPTABLY
|
||||
(freplace (STREAM EXTERNALFORMAT) of STREAM with EXTFORMAT)
|
||||
(CL:WHEN (ffetch (EXTERNALFORMAT EOLVALID) of EXTFORMAT)
|
||||
(freplace (STREAM EOLCONVENTION) of STREAM with (ffetch
|
||||
(EXTERNALFORMAT
|
||||
EOL) of
|
||||
EXTFORMAT
|
||||
)))
|
||||
(freplace (STREAM OUTCHARFN) of STREAM with (ffetch (EXTERNALFORMAT
|
||||
OUTCHARFN)
|
||||
of EXTFORMAT))
|
||||
(freplace (STREAM INCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT
|
||||
INCCODEFN)
|
||||
of EXTFORMAT))
|
||||
(freplace (STREAM PEEKCCODEFN) of STREAM with (ffetch (
|
||||
EXTERNALFORMAT
|
||||
PEEKCCODEFN)
|
||||
of EXTFORMAT))
|
||||
(freplace (STREAM BACKCCODEFN) of STREAM with (ffetch (
|
||||
EXTERNALFORMAT
|
||||
BACKCCODEFN)
|
||||
of EXTFORMAT)))])
|
||||
(freplace (STREAM EOLCONVENTION) of STREAM with (ffetch (EXTERNALFORMAT EOL)
|
||||
of EXTFORMAT)))
|
||||
(freplace (STREAM OUTCHARFN) of STREAM with (ffetch (EXTERNALFORMAT OUTCHARFN)
|
||||
of EXTFORMAT))
|
||||
(freplace (STREAM INCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT INCCODEFN)
|
||||
of EXTFORMAT))
|
||||
(freplace (STREAM PEEKCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT PEEKCCODEFN)
|
||||
of EXTFORMAT))
|
||||
(freplace (STREAM BACKCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT BACKCCODEFN)
|
||||
of EXTFORMAT)))])
|
||||
(ffetch (EXTERNALFORMAT NAME) of (fetch (STREAM EXTERNALFORMAT) of STREAM])
|
||||
|
||||
(MAKE-EXTERNALFORMAT
|
||||
@@ -333,7 +335,8 @@
|
||||
STREAM])
|
||||
|
||||
(\BACKCCODE.EOLC
|
||||
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 14-Aug-2021 00:27 by rmk:")
|
||||
[LAMBDA (STREAM EOLC BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 18-Jun-2022 18:45 by rmk")
|
||||
(* ; "Edited 14-Aug-2021 00:27 by rmk:")
|
||||
|
||||
(* ;; "If the EOLCONVENTION is CRLF, and the first backup is over an LF encoding, this looks to see whether the preceding bytes encode a CR and if so, backs up over those.")
|
||||
|
||||
@@ -348,33 +351,32 @@
|
||||
(PROG1 (CL:WHEN (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
|
||||
\DEFAULTBACKCCODE)
|
||||
STREAM)
|
||||
(IF (AND (EQ CRLF.EOLC (FETCH (STREAM EOLCONVENTION) OF STREAM))
|
||||
(EQ (CHARCODE LF)
|
||||
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN) of STREAM)
|
||||
\DEFAULTPEEKCCODE)
|
||||
STREAM)))
|
||||
THEN
|
||||
(SELECTC (OR EOLC (ffetch (STREAM EOLCONVENTION) OF STREAM))
|
||||
((LIST CRLF.EOLC ANY.EOLC 'CRLF 'ANY)
|
||||
(CL:WHEN (EQ (CHARCODE LF)
|
||||
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN) of STREAM)
|
||||
\DEFAULTPEEKCCODE)
|
||||
STREAM))
|
||||
|
||||
(* ;;
|
||||
"We just backed over an LF in a CRLF file. If we go one more, do we get a CR?")
|
||||
(* ;;
|
||||
"We just backed over an LF with EOLC= CRLF or ANY. If we go one more, do we get a CR?")
|
||||
|
||||
(CL:WHEN (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM
|
||||
)
|
||||
\DEFAULTBACKCCODE)
|
||||
STREAM)
|
||||
(CL:UNLESS (EQ (CHARCODE CR)
|
||||
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN)
|
||||
of STREAM)
|
||||
\DEFAULTPEEKCCODE)
|
||||
STREAM))
|
||||
(CL:WHEN (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
|
||||
\DEFAULTBACKCCODE)
|
||||
STREAM)
|
||||
(CL:UNLESS (EQ (CHARCODE CR)
|
||||
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN)
|
||||
of STREAM)
|
||||
\DEFAULTPEEKCCODE)
|
||||
STREAM))
|
||||
|
||||
(* ;; "Not a preceding CR, reread it.")
|
||||
(* ;; "Not a preceding CR, reread it.")
|
||||
|
||||
(CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
|
||||
\DEFAULTINCCODE)
|
||||
STREAM))
|
||||
T)
|
||||
ELSE T))
|
||||
(CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
|
||||
\DEFAULTINCCODE)
|
||||
STREAM)))))
|
||||
NIL)
|
||||
T)
|
||||
(CL:WHEN BYTECOUNTVAR
|
||||
[SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
|
||||
(IDIFFERENCE STARTPOS (\GETFILEPTR STREAM]))])
|
||||
@@ -434,14 +436,15 @@
|
||||
STREAM])
|
||||
|
||||
(\FORMATBYTESTREAM
|
||||
[LAMBDA (STREAM BYTESTREAM) (* ; "Edited 24-Jun-2021 17:26 by rmk:")
|
||||
[LAMBDA (STREAM BYTESTREAM) (* ; "Edited 22-Jun-2022 11:09 by rmk")
|
||||
(* ; "Edited 24-Jun-2021 17:26 by rmk:")
|
||||
|
||||
(* ;; "Create or modify a stream that will simulate the current character input/output byte sequences of STREAM. The set up here does what is common to all formats: an IO stream starting with STREAM external format and EOL.")
|
||||
|
||||
(* ;; "If the format has its own FORMATBYTESTREAMFN function, that is applied to copy any other state. (Currently that function is a property of the format, not carried over into a stream field that can be changed dynamically.)")
|
||||
|
||||
(CL:UNLESS (AND (STREAMP BYTESTREAM)
|
||||
(\IOMODEP STREAM 'BOTH))
|
||||
(\IOMODEP BYTESTREAM 'BOTH))
|
||||
(SETQ BYTESTREAM (OPENSTREAM '{NODIRCORE} 'BOTH)))
|
||||
(LET ((FORMAT (FETCH (STREAM EXTERNALFORMAT) OF STREAM))
|
||||
(EOLC (FETCH (STREAM EOLCONVENTION) OF STREAM)))
|
||||
@@ -450,13 +453,34 @@
|
||||
(SETQ EOLC (OR (FETCH (EXTERNALFORMAT EOL) OF FORMAT)
|
||||
LF.EOLC)))
|
||||
(REPLACE (STREAM EOLCONVENTION) OF BYTESTREAM WITH EOLC)
|
||||
(SETFILEPTR BYTESTREAM 0)
|
||||
(SETFILEINFO BYTESTREAM 'ENDOFSTREAMOP (FUNCTION NILL))
|
||||
(\SETFILEPTR BYTESTREAM 0)
|
||||
(freplace (STREAM ENDOFSTREAMOP) of BYTESTREAM with (FUNCTION NILL))
|
||||
(CL:WHEN (FETCH (EXTERNALFORMAT FORMATBYTESTREAMFN) OF FORMAT)
|
||||
(APPLY* (FETCH (EXTERNALFORMAT FORMATBYTESTREAMFN) OF FORMAT)
|
||||
STREAM BYTESTREAM))
|
||||
BYTESTREAM])
|
||||
|
||||
(\FORMATBYTESTRING
|
||||
[LAMBDA (STREAM STRING) (* ; "Edited 22-Jun-2022 11:07 by rmk")
|
||||
(* ; "Edited 18-Jun-2022 22:04 by rmk")
|
||||
|
||||
(* ;; "Produces a string containing the bytes that would represent STRING on STREAM. Presumably this only makes sense for a stable format")
|
||||
|
||||
(WITH-RESOURCE \FORMATBYTESTRING.STREAM (\SETFILEPTR \FORMATBYTESTRING.STREAM 0)
|
||||
(LET [FSTRING NBYTES (BYTESTRINGFN (FETCH (EXTERNALFORMAT FORMATBYTESTRINGFN)
|
||||
OF (FETCH (STREAM EXTERNALFORMAT) OF STREAM]
|
||||
(IF BYTESTRINGFN
|
||||
THEN (APPLY* BYTESTRINGFN STREAM STRING \FORMATBYTESTRING.STREAM)
|
||||
ELSE (\FORMATBYTESTREAM STREAM \FORMATBYTESTRING.STREAM)
|
||||
(FOR C INSTRING STRING DO (\OUTCHAR \FORMATBYTESTRING.STREAM C))
|
||||
(SETQ NBYTES (\GETFILEPTR \FORMATBYTESTRING.STREAM))
|
||||
(\SETFILEPTR \FORMATBYTESTRING.STREAM 0)
|
||||
(SETQ FSTRING (ALLOCSTRING NBYTES))
|
||||
(FOR I FROM 1 TO NBYTES DO (RPLCHARCODE FSTRING I (\BIN
|
||||
\FORMATBYTESTRING.STREAM
|
||||
)))
|
||||
FSTRING])
|
||||
|
||||
(\CHECKEOLC.CRLF
|
||||
[LAMBDA (STREAM PEEKBINFLG COUNTP) (* ; "Edited 6-Aug-2021 23:30 by rmk:")
|
||||
|
||||
@@ -514,32 +538,34 @@
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \CHECKEOLC MACRO [OPENLAMBDA (CH EOLC STRM PEEKBINFLG COUNTP)
|
||||
(COND
|
||||
((EQ EOLC 'NOEOLC)
|
||||
CH)
|
||||
(T (SELCHARQ CH
|
||||
(LF (SELECTC (OR EOLC (FFETCH (STREAM
|
||||
EOLCONVENTION
|
||||
)
|
||||
OF STRM))
|
||||
((LIST LF.EOLC ANY.EOLC)
|
||||
(CHARCODE EOL))
|
||||
(CHARCODE LF)))
|
||||
(CR (SELECTC (OR EOLC (FFETCH (STREAM
|
||||
EOLCONVENTION
|
||||
)
|
||||
OF STRM))
|
||||
(CR.EOLC (CHARCODE EOL))
|
||||
((LIST ANY.EOLC CRLF.EOLC)
|
||||
(\CHECKEOLC.CRLF STRM PEEKBINFLG
|
||||
COUNTP))
|
||||
(CHARCODE CR)))
|
||||
CH])
|
||||
(COND
|
||||
((EQ EOLC 'NOEOLC)
|
||||
CH)
|
||||
(T (SELCHARQ CH
|
||||
(LF (SELECTC (OR EOLC (FFETCH (STREAM EOLCONVENTION)
|
||||
OF STRM))
|
||||
((LIST LF.EOLC ANY.EOLC)
|
||||
(CHARCODE EOL))
|
||||
(CHARCODE LF)))
|
||||
(CR (SELECTC (OR EOLC (FFETCH (STREAM EOLCONVENTION)
|
||||
OF STRM))
|
||||
(CR.EOLC (CHARCODE EOL))
|
||||
((LIST ANY.EOLC CRLF.EOLC)
|
||||
(\CHECKEOLC.CRLF STRM PEEKBINFLG COUNTP))
|
||||
(CHARCODE CR)))
|
||||
CH])
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTDEF '\FORMATBYTESTRING.STREAM 'RESOURCES '(NEW (OPENSTREAM '{NODIRCORE} 'BOTH]
|
||||
)
|
||||
)
|
||||
|
||||
(/SETTOPVAL '\\FORMATBYTESTRING.STREAM.GLOBALRESOURCE NIL)
|
||||
|
||||
|
||||
|
||||
@@ -594,11 +620,11 @@
|
||||
(\CREATE.THROUGH.EXTERNALFORMAT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5657 12044 (\EXTERNALFORMAT 5667 . 10729) (MAKE-EXTERNALFORMAT 10731 . 12042)) (12045
|
||||
15158 (\INSTALL.EXTERNALFORMAT 12055 . 13504) (\REMOVE.EXTERNALFORMAT 13506 . 14337) (FIND-FORMAT
|
||||
14339 . 15156)) (15488 27986 (\OUTCHAR 15498 . 16634) (\INCCODE 16636 . 17822) (\BACKCCODE 17824 .
|
||||
18718) (\BACKCCODE.EOLC 18720 . 21483) (\PEEKCCODE 21485 . 21801) (\PEEKCCODE.NOEOLC 21803 . 22065) (
|
||||
\INCCODE.EOLC 22067 . 23926) (\FORMATBYTESTREAM 23928 . 25418) (\CHECKEOLC.CRLF 25420 . 27984)) (29929
|
||||
31772 (\CREATE.THROUGH.EXTERNALFORMAT 29939 . 30741) (\THROUGHIN 30743 . 31163) (\THROUGHBACKCCODE
|
||||
31165 . 31432) (\THROUGHOUTCHARFN 31434 . 31770)))))
|
||||
(FILEMAP (NIL (6250 11540 (\EXTERNALFORMAT 6260 . 10225) (MAKE-EXTERNALFORMAT 10227 . 11538)) (11541
|
||||
14654 (\INSTALL.EXTERNALFORMAT 11551 . 13000) (\REMOVE.EXTERNALFORMAT 13002 . 13833) (FIND-FORMAT
|
||||
13835 . 14652)) (14984 29243 (\OUTCHAR 14994 . 16130) (\INCCODE 16132 . 17318) (\BACKCCODE 17320 .
|
||||
18214) (\BACKCCODE.EOLC 18216 . 21093) (\PEEKCCODE 21095 . 21411) (\PEEKCCODE.NOEOLC 21413 . 21675) (
|
||||
\INCCODE.EOLC 21677 . 23536) (\FORMATBYTESTREAM 23538 . 25171) (\FORMATBYTESTRING 25173 . 26675) (
|
||||
\CHECKEOLC.CRLF 26677 . 29241)) (30803 32646 (\CREATE.THROUGH.EXTERNALFORMAT 30813 . 31615) (
|
||||
\THROUGHIN 31617 . 32037) (\THROUGHBACKCCODE 32039 . 32306) (\THROUGHOUTCHARFN 32308 . 32644)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user