Localize external format implementation in new EXTERNALFORMAT file
Pieces moved from FILEIO and LLREAD, EXTERNALFORMAT added to FILESETS
This commit is contained in:
rmkaplan
604
sources/EXTERNALFORMAT
Normal file
604
sources/EXTERNALFORMAT
Normal file
@@ -0,0 +1,604 @@
|
||||
(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)
|
||||
|
||||
previous date%: "11-Sep-2021 09:44:04"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>EXTERNALFORMAT.;15)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT EXTERNALFORMATCOMS)
|
||||
|
||||
(RPAQQ EXTERNALFORMATCOMS
|
||||
[(COMS (* ;
|
||||
"EXTERNALFORMAT declaration and related functions (originally on FILEIO)")
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (RECORDS EXTERNALFORMAT)))
|
||||
(INITRECORDS EXTERNALFORMAT)
|
||||
(SYSRECORDS EXTERNALFORMAT)
|
||||
(FNS \EXTERNALFORMAT MAKE-EXTERNALFORMAT)
|
||||
(FNS \INSTALL.EXTERNALFORMAT \REMOVE.EXTERNALFORMAT FIND-FORMAT)
|
||||
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
|
||||
(INITVARS (*EXTERNALFORMATS* NIL)
|
||||
[*DEFAULT-EXTERNALFORMATS* '((DSK :XCCS]
|
||||
(*DEFAULT-EXTERNALFORMAT* :XCCS)))
|
||||
[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]
|
||||
(COMS
|
||||
(* ;; "Also from FILEIO, but not clear that this is or ever has been used.")
|
||||
|
||||
(FNS \CREATE.THROUGH.EXTERNALFORMAT \THROUGHIN \THROUGHBACKCCODE \THROUGHOUTCHARFN)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.THROUGH.EXTERNALFORMAT])
|
||||
|
||||
|
||||
|
||||
(* ; "EXTERNALFORMAT declaration and related functions (originally on FILEIO)")
|
||||
|
||||
(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)))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2)
|
||||
FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER
|
||||
POINTER)
|
||||
'((EXTERNALFORMAT 0 (FLAGBITS . 0))
|
||||
(EXTERNALFORMAT 0 (BITS . 17))
|
||||
(EXTERNALFORMAT 0 (FLAGBITS . 48))
|
||||
(EXTERNALFORMAT 0 POINTER)
|
||||
(EXTERNALFORMAT 2 POINTER)
|
||||
(EXTERNALFORMAT 4 POINTER)
|
||||
(EXTERNALFORMAT 6 POINTER)
|
||||
(EXTERNALFORMAT 8 POINTER)
|
||||
(EXTERNALFORMAT 10 POINTER)
|
||||
(EXTERNALFORMAT 12 POINTER)
|
||||
(EXTERNALFORMAT 14 POINTER))
|
||||
'16)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2)
|
||||
FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER
|
||||
POINTER)
|
||||
'((EXTERNALFORMAT 0 (FLAGBITS . 0))
|
||||
(EXTERNALFORMAT 0 (BITS . 17))
|
||||
(EXTERNALFORMAT 0 (FLAGBITS . 48))
|
||||
(EXTERNALFORMAT 0 POINTER)
|
||||
(EXTERNALFORMAT 2 POINTER)
|
||||
(EXTERNALFORMAT 4 POINTER)
|
||||
(EXTERNALFORMAT 6 POINTER)
|
||||
(EXTERNALFORMAT 8 POINTER)
|
||||
(EXTERNALFORMAT 10 POINTER)
|
||||
(EXTERNALFORMAT 12 POINTER)
|
||||
(EXTERNALFORMAT 14 POINTER))
|
||||
'16)
|
||||
(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)))
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\EXTERNALFORMAT
|
||||
[LAMBDA (STREAM NEWFORMAT/NAME) (* ; "Edited 10-Sep-2021 20:44 by rmk:")
|
||||
(* ; "Edited 26-Feb-91 13:20 by nm")
|
||||
|
||||
(* ;;; ";;; 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.")
|
||||
|
||||
(* ;;; "")
|
||||
|
||||
(* ;;; "If NEWFORMAT/NAME is nil, just returns the current external format name of STREAM. If NEWFORMAT/NAME is supplied and it is or names an external format, then the external format of STREAM is set to that format.")
|
||||
|
||||
(* ;;; "")
|
||||
|
||||
(* ;;; ":DEFAULT means the default external format for STREAM's filedevice")
|
||||
|
||||
(* ;;; "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]
|
||||
(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)))])
|
||||
(ffetch (EXTERNALFORMAT NAME) of (fetch (STREAM EXTERNALFORMAT) of STREAM])
|
||||
|
||||
(MAKE-EXTERNALFORMAT
|
||||
[LAMBDA (NAME INCCODEFN PEEKCCODEFN BACKCCODEFN OUTCHARFN FORMATBYTESTREAMFN EOL UNSTABLE)
|
||||
(* ; "Edited 10-Sep-2021 19:47 by rmk:")
|
||||
|
||||
(* ;; "Compiled creator for EXTERNALFORMAT so that declaration (EXPORTS.ALL) is not needed. If EOL is not specified, then EOLVALID is also NIL")
|
||||
|
||||
(SETQ EOL (SELECTC EOL
|
||||
((LIST 'LF LF.EOLC)
|
||||
LF.EOLC)
|
||||
((LIST 'CR CR.EOLC)
|
||||
CR.EOLC)
|
||||
((LIST 'CRLF CRLF.EOLC)
|
||||
CRLF.EOLC)
|
||||
(NIL)
|
||||
(SHOULDNT)))
|
||||
(\INSTALL.EXTERNALFORMAT (CREATE EXTERNALFORMAT
|
||||
NAME _ NAME
|
||||
INCCODEFN _ INCCODEFN
|
||||
PEEKCCODEFN _ PEEKCCODEFN
|
||||
BACKCCODEFN _ BACKCCODEFN
|
||||
OUTCHARFN _ OUTCHARFN
|
||||
FORMATBYTESTREAMFN _ FORMATBYTESTREAMFN
|
||||
EOLVALID _ EOL
|
||||
EOL _ (OR EOL LF.EOLC)
|
||||
UNSTABLE _ UNSTABLE])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\INSTALL.EXTERNALFORMAT
|
||||
[LAMBDA (EXTFORMAT/NAME EXTERNALFORMAT) (* ; "Edited 5-Aug-2021 14:22 by rmk:")
|
||||
|
||||
(* ;;; "Register an instance of the datatype EXTERNALFORMAT.")
|
||||
|
||||
(* ;;; "For backward compatibility, the first argument can be a NAME with the second argument being the format. If so, the NAME must match the name inside the format")
|
||||
|
||||
(LET (NAME)
|
||||
(IF EXTERNALFORMAT
|
||||
THEN
|
||||
|
||||
(* ;; "Backwards compatibility")
|
||||
|
||||
(SETQ NAME (MKATOM EXTFORMAT/NAME))
|
||||
(IF (EQ NAME (FETCH (EXTERNALFORMAT NAME) OF EXTERNALFORMAT))
|
||||
ELSEIF (FETCH (EXTERNALFORMAT NAME) OF EXTERNALFORMAT)
|
||||
THEN (ERROR "Mismatch of specified name and name of the external format")
|
||||
ELSE (REPLACE (EXTERNALFORMAT NAME) OF EXTERNALFORMAT WITH
|
||||
NAME))
|
||||
ELSE (SETQ EXTERNALFORMAT EXTFORMAT/NAME)
|
||||
(SETQ NAME (FETCH (EXTERNALFORMAT NAME) OF EXTERNALFORMAT)))
|
||||
(IF (type? EXTERNALFORMAT EXTERNALFORMAT)
|
||||
THEN (\REMOVE.EXTERNALFORMAT NAME)
|
||||
(push *EXTERNALFORMATS* EXTERNALFORMAT)
|
||||
ELSE (ERROR "INVALID EXTERNALFORMAT " EXTERNALFORMAT))
|
||||
EXTERNALFORMAT])
|
||||
|
||||
(\REMOVE.EXTERNALFORMAT
|
||||
[LAMBDA (NAME/EXTFORMAT) (* ; "Edited 5-May-2021 15:42 by rmk:")
|
||||
|
||||
(* ;;; "Deregisters external format EXTERNALFORMAT .")
|
||||
|
||||
(SETQ NAME/EXTFORMAT (IF (TYPE? EXTERNALFORMAT NAME/EXTFORMAT)
|
||||
THEN (FETCH (EXTERNALFORMAT NAME) OF NAME/EXTFORMAT)
|
||||
ELSE (MKATOM NAME/EXTFORMAT)))
|
||||
(SETQ *EXTERNALFORMATS* (DREMOVE (FIND EF IN *EXTERNALFORMATS*
|
||||
SUCHTHAT (EQ NAME/EXTFORMAT (FETCH (EXTERNALFORMAT
|
||||
NAME)
|
||||
OF EF)))
|
||||
*EXTERNALFORMATS*])
|
||||
|
||||
(FIND-FORMAT
|
||||
[LAMBDA (NAME NOERROR) (* ; "Edited 7-Aug-2021 09:29 by rmk:")
|
||||
(IF (TYPE? EXTERNALFORMAT NAME)
|
||||
THEN NAME
|
||||
ELSE (SETQ NAME (MKATOM NAME)) (* ;
|
||||
"The EQMEMB allows for synonyms, the first of which should be canonical. E.g. (:UTF-8 :UTF8)")
|
||||
(OR (FIND EF IN *EXTERNALFORMATS* SUCHTHAT (EQ NAME (FETCH (
|
||||
EXTERNALFORMAT
|
||||
NAME)
|
||||
OF EF)))
|
||||
(CL:UNLESS NOERROR (ERROR NAME "is not an external format"])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
|
||||
)
|
||||
|
||||
(RPAQ? *EXTERNALFORMATS* NIL)
|
||||
|
||||
(RPAQ? *DEFAULT-EXTERNALFORMATS* '((DSK :XCCS)))
|
||||
|
||||
(RPAQ? *DEFAULT-EXTERNALFORMAT* :XCCS)
|
||||
|
||||
|
||||
|
||||
(* ;; "Generic functions not compiled open (originally on LLREAD)")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\OUTCHAR
|
||||
[LAMBDA (STREAM CODE) (* ; "Edited 10-Aug-2021 10:29 by rmk:")
|
||||
|
||||
(* ;; "We can't do the EOL stuff here because we don't know whether BOUTs are legit.")
|
||||
|
||||
(* ;; "Maybe the implementation function does something else, like move the X and Y positions. At best we could convert the EOL into either CR or LF, or into a CR-LF sequence that we pass by two calls to the lower implementation function.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "This would make CHARPOSITION generic:")
|
||||
(* (FREPLACE (STREAM CHARPOSITION)
|
||||
OF STREAM WITH (CL:IF
|
||||
(EQ CODE (CHARCODE EOL)) 0
|
||||
(IPLUS16 1 (FFETCH
|
||||
(STREAM CHARPOSITION) OF STREAM)))))
|
||||
(CL:FUNCALL (OR (ffetch (STREAM OUTCHARFN) of STREAM)
|
||||
\DEFAULTOUTCHAR)
|
||||
STREAM CODE)
|
||||
CODE])
|
||||
|
||||
(\INCCODE
|
||||
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 7-Aug-2021 00:11 by rmk:")
|
||||
|
||||
(* ;; "Calling functions pass the name of the BYTECOUNTVAR, or NIL. If non-NIL, implementing functions are required to SETQ *BYTECOUNTER* to the number of bytes read (positive) or backed up (negative).")
|
||||
|
||||
(* ;; "Caller must bind BYTECOUNTVAR as a SPECVAR. BYTECOUNTVAL can be passed as the current value of BYTECOUNTVAR, to save a call to \EVALV1.")
|
||||
|
||||
(IF BYTECOUNTVAR
|
||||
THEN [LET ((*BYTECOUNTER* 0))
|
||||
(DECLARE (SPECVARS *BYTECOUNTER*))
|
||||
(PROG1 (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
|
||||
\DEFAULTINCCODE)
|
||||
STREAM
|
||||
'*BYTECOUNTER*)
|
||||
(SET BYTECOUNTVAR (IDIFFERENCE (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
|
||||
*BYTECOUNTER*)))]
|
||||
ELSE (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
|
||||
\DEFAULTINCCODE)
|
||||
STREAM])
|
||||
|
||||
(\BACKCCODE
|
||||
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 14-Aug-2021 00:26 by rmk:")
|
||||
|
||||
(* ;;
|
||||
"Format function returns T if the backup succeed, NIL otherwise (e.g at the beginning of the file)")
|
||||
|
||||
(IF BYTECOUNTVAR
|
||||
THEN [LET ((*BYTECOUNTER* 0))
|
||||
(DECLARE (SPECVARS *BYTECOUNTER*))
|
||||
(PROG1 (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
|
||||
\DEFAULTBACKCCODE)
|
||||
STREAM T)
|
||||
(SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
|
||||
*BYTECOUNTER*)))]
|
||||
ELSE (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
|
||||
\DEFAULTBACKCCODE)
|
||||
STREAM])
|
||||
|
||||
(\BACKCCODE.EOLC
|
||||
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "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.")
|
||||
|
||||
(* ;; "Within this we operate at the external-format implementation level.")
|
||||
|
||||
(* ;; "Counting is unusual in general (mostly just COPYCHARS and PFCOPYBYTES) , and counting while backing up is even rarer. So for simplicity here we just count by looking at the byte pointer.")
|
||||
|
||||
(LET [(STARTPOS (CL:WHEN BYTECOUNTVAR (\GETFILEPTR STREAM]
|
||||
|
||||
(* ;; "In almost all cases, we just execute the first backup")
|
||||
|
||||
(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
|
||||
|
||||
(* ;;
|
||||
"We just backed over an LF in a CRLF file. 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))
|
||||
|
||||
(* ;; "Not a preceding CR, reread it.")
|
||||
|
||||
(CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
|
||||
\DEFAULTINCCODE)
|
||||
STREAM))
|
||||
T)
|
||||
ELSE T))
|
||||
(CL:WHEN BYTECOUNTVAR
|
||||
[SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
|
||||
(IDIFFERENCE STARTPOS (\GETFILEPTR STREAM]))])
|
||||
|
||||
(\PEEKCCODE
|
||||
[LAMBDA (STREAM NOERROR EOL) (* ; "Edited 14-Jun-2021 12:40 by rmk:")
|
||||
(\CHECKEOLC (CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN) of STREAM)
|
||||
\DEFAULTPEEKCCODE)
|
||||
STREAM NOERROR)
|
||||
EOL STREAM T])
|
||||
|
||||
(\PEEKCCODE.NOEOLC
|
||||
[LAMBDA (STREAM NOERROR) (* ; "Edited 27-Jun-2021 23:26 by rmk:")
|
||||
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN) of STREAM)
|
||||
\DEFAULTPEEKCCODE)
|
||||
STREAM NOERROR])
|
||||
|
||||
(\INCCODE.EOLC
|
||||
[LAMBDA (STREAM EOLC BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 8-Aug-2021 14:52 by rmk:")
|
||||
|
||||
(* ;;
|
||||
"EOL conversion around essentially a copy of \INCCODE but avoids the extra function call.")
|
||||
|
||||
(* ;; " EOLC of NIL means all patterns go to EOL")
|
||||
|
||||
(IF BYTECOUNTVAR
|
||||
THEN [LET (*BYTECOUNTER* CODE)
|
||||
(DECLARE (SPECVARS *BYTECOUNTER*))
|
||||
|
||||
(* ;; "The INCCODEFN first sets *BYTECOUNTER*")
|
||||
|
||||
(CL:UNLESS BYTECOUNTVAL
|
||||
(SETQ BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR)))
|
||||
(SETQ CODE (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
|
||||
\DEFAULTINCCODE)
|
||||
STREAM T))
|
||||
|
||||
(* ;; "Update according to the number of first-char (CR or LF) bytes")
|
||||
|
||||
(SETQ BYTECOUNTVAL (IDIFFERENCE BYTECOUNTVAL *BYTECOUNTER*))
|
||||
(SETQ *BYTECOUNTER* 0)
|
||||
|
||||
(* ;;
|
||||
"*BYTECOUNTER* will now be reset to the number of LF-after-CR bytes, if any")
|
||||
|
||||
(PROG1 (\CHECKEOLC CODE (OR EOLC (FFETCH (STREAM EOLCONVENTION)
|
||||
OF STREAM))
|
||||
STREAM NIL T)
|
||||
|
||||
(* ;; "Post the results")
|
||||
|
||||
(SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL *BYTECOUNTER*)))]
|
||||
ELSE (\CHECKEOLC (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
|
||||
\DEFAULTINCCODE)
|
||||
STREAM)
|
||||
(OR EOLC (FFETCH (STREAM EOLCONVENTION) OF STREAM))
|
||||
STREAM])
|
||||
|
||||
(\FORMATBYTESTREAM
|
||||
[LAMBDA (STREAM BYTESTREAM) (* ; "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))
|
||||
(SETQ BYTESTREAM (OPENSTREAM '{NODIRCORE} 'BOTH)))
|
||||
(LET ((FORMAT (FETCH (STREAM EXTERNALFORMAT) OF STREAM))
|
||||
(EOLC (FETCH (STREAM EOLCONVENTION) OF STREAM)))
|
||||
(\EXTERNALFORMAT BYTESTREAM FORMAT)
|
||||
(CL:WHEN (EQ EOLC ANY.EOLC)
|
||||
(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))
|
||||
(CL:WHEN (FETCH (EXTERNALFORMAT FORMATBYTESTREAMFN) OF FORMAT)
|
||||
(APPLY* (FETCH (EXTERNALFORMAT FORMATBYTESTREAMFN) OF FORMAT)
|
||||
STREAM BYTESTREAM))
|
||||
BYTESTREAM])
|
||||
|
||||
(\CHECKEOLC.CRLF
|
||||
[LAMBDA (STREAM PEEKBINFLG COUNTP) (* ; "Edited 6-Aug-2021 23:30 by rmk:")
|
||||
|
||||
(* ;; "This is called only when a CR has been read and EOLC is either any or CRLF. This returns EOL if the next code is an LF")
|
||||
|
||||
(* ;; "If COUNTP, that sets *BYTECOUNTER* freely with the number of LF bytes.")
|
||||
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(LET (CH)
|
||||
[SETQ CH (COND
|
||||
[PEEKBINFLG
|
||||
|
||||
(* ;;
|
||||
"T from PEEKC. In this case, must leave the fileptr where it was.")
|
||||
|
||||
(* ;; "The CR itself hasn't been read, just peeked. So here we have to read it, then peek at the next character to see if it is an LF, and then back out the CR")
|
||||
|
||||
(COND
|
||||
([EQ (CHARCODE LF)
|
||||
(UNINTERRUPTABLY
|
||||
|
||||
(* ;; " Since we are going to \BACKCCODE back the peeked character, we don't need to update the counter variable")
|
||||
|
||||
(\INCCODE STREAM)
|
||||
(PROG1 (\PEEKCCODE STREAM T 'NOEOLC)
|
||||
|
||||
(* ;;
|
||||
"This has to be a call to \PEEKCODE that doesn't itself to the checkeolc")
|
||||
|
||||
(* ;;
|
||||
"LF must be the next char after the CR. We back up over the CR that \INCCODE just read.")
|
||||
|
||||
(\BACKCCODE STREAM)))]
|
||||
|
||||
(* ;; "Got the CRLF, it's an EOL")
|
||||
|
||||
(CHARCODE EOL))
|
||||
(T (CHARCODE CR]
|
||||
((EQ (CHARCODE LF)
|
||||
(\PEEKCCODE STREAM T 'NOEOLC))
|
||||
|
||||
(* ;; "Since we aren't peeking, the CR has actually been read, and we are entitled to read the LF that we just peeked at.")
|
||||
|
||||
(IF COUNTP
|
||||
THEN (LET (NUMLFBYTES)
|
||||
(DECLARE (SPECVARS NUMLFBYTES))
|
||||
(\INCCODE STREAM 'NUMLFBYTES 0)
|
||||
(ADD *BYTECOUNTER* NUMLFBYTES))
|
||||
ELSE (\INCCODE STREAM))
|
||||
(CHARCODE EOL))
|
||||
(T (CHARCODE CR]
|
||||
CH])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
(* "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])
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;; "Also from FILEIO, but not clear that this is or ever has been used.")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\CREATE.THROUGH.EXTERNALFORMAT
|
||||
[LAMBDA NIL (* ; "Edited 23-Jun-2021 13:34 by rmk:")
|
||||
|
||||
(* ;;; "Create an instance of EXTERNALFORMAT datatype and install it with :THROUGH as its name. EOL is adjusted to CR so as not to do any eol conversion on this stream.")
|
||||
|
||||
(\INSTALL.EXTERNALFORMAT (create EXTERNALFORMAT
|
||||
NAME _ :THROUGH
|
||||
INCCODEFN _ (FUNCTION \THROUGHIN)
|
||||
PEEKCCODEFN _ (FUNCTION \PEEKBIN)
|
||||
BACKCCODEFN _ (FUNCTION \THROUGHBACKCCODE)
|
||||
OUTCHARFN _ (FUNCTION \THROUGHOUTCHARFN)
|
||||
EOL _ CR.EOLC])
|
||||
|
||||
(\THROUGHIN
|
||||
[LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:13 by rmk:")
|
||||
|
||||
(* ;;; "Read in a single byte from STREAM and returns it without any character conversion, just through as if.")
|
||||
|
||||
(* ;;; "If COUNTP is non-NIL, the byte counter is always set to 1.")
|
||||
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* 1))
|
||||
(\BIN STREAM])
|
||||
|
||||
(\THROUGHBACKCCODE
|
||||
[LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:14 by rmk:")
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(CL:WHEN (\BACKFILEPTR STREAM)
|
||||
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
|
||||
T)])
|
||||
|
||||
(\THROUGHOUTCHARFN
|
||||
[LAMBDA (OUTSTREAM CHARCODE) (* ; "Edited 26-Feb-91 13:44 by nm")
|
||||
|
||||
(* ;;; "Encoder for THROUGH format.")
|
||||
|
||||
(COND
|
||||
((> CHARCODE 255)
|
||||
(\BOUT OUTSTREAM (\CHARSET CHARCODE))
|
||||
(\BOUT OUTSTREAM (\CHAR8CODE CHARCODE)))
|
||||
(T (\BOUT OUTSTREAM CHARCODE])
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(\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)))))
|
||||
STOP
|
||||
Reference in New Issue
Block a user