(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "11-Sep-87 18:18:26" {ERIS}<VANMELLE>LISP>NSCHARPATCH.;1 10025
changes to%: (VARS NSCHARPATCHCOMS))
(* "
Copyright (c) 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT NSCHARPATCHCOMS)
(RPAQQ NSCHARPATCHCOMS ((FNS CHARSET \GENERIC.CHARSET ACCESS-CHARSET) (FNS %%SYNONYM-STREAM-DEVICE-CHARSETFN %%TWO-WAY-STREAM-DEVICE-CHARSETFN) (FUNCTIONS %%BROADCAST-STREAM-DEVICE-CHARSETFN %%CONCATENATED-STREAM-DEVICE-CHARSETFN) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MAPC (QUOTE (LASTC SKIPSEPRCODES SKIPSEPRS READ-EXTENDED-TOKEN \RSTRING2 \SUBREAD SETFILEPTR \GENERIC.READP CL:UNREAD-CHAR CL:PEEK-CHAR \FILLBUFFER READCCODE READC PEEKCCODE COPY.TEXT.TO.IMAGE FASL:FASL-FAT-STRING FASL::FASL-FAT-STRINGA0002)) (FUNCTION (LAMBDA (FN) (CHANGENAME FN (QUOTE CHARSET) (QUOTE ACCESS-CHARSET))))))) (DECLARE%: EVAL@COMPILE DONTCOPY (OPTIMIZERS ACCESS-CHARSET) (MACROS \BACKCHAR \BACKNSCHAR \CHECKEOLC \INCHAR \INCCODE \PEEKCCODE \NSIN \NSPEEK NUMERIC-CHARSET) (PROP FILETYPE NSCHARPATCH)))
)
(DEFINEQ
(CHARSET
(LAMBDA (STREAM NEWVALUE) (* ; "Edited 11-Sep-87 16:22 by bvm:") (* ;; "Public access to a stream's CHARSET. If NEWVALUE is given, changes the charset (which for output streams can write a charset shift). We invoke the stream's device's get/set charset method on the stream, and also invoke the IMCHARSET image operation (which is where file streams get to write a charset shift).") (* ;; "If CHARACTERSET is either 255 or T, set the stream so that it's non run-coded, i.e., you read 2 bytes for each character read.") (SETQ STREAM (\GETSTREAM STREAM)) (COND ((EQ NEWVALUE NSCHARSETSHIFT) (* ; "Coerce 255 to T for uniformity") (SETQ NEWVALUE T)) ((NOT (OR (EQ NEWVALUE NIL) (EQ NEWVALUE T) (AND (>= NEWVALUE 0) (< NEWVALUE \MAXCHARSET)))) (\ILLEGAL.ARG NEWVALUE))) (LET ((OLDVAL (ACCESS-CHARSET STREAM (IF (EQ NEWVALUE T) THEN NSCHARSETSHIFT ELSE NEWVALUE)))) (* ; "First modify the stream's slot") (IF (EQ OLDVAL NSCHARSETSHIFT) THEN (SETQ OLDVAL T)) (IF (AND NEWVALUE (NEQ OLDVAL NEWVALUE)) THEN (* ; "Now invoke the imageop if anything interesting happened") (IMAGEOP (QUOTE IMCHARSET) STREAM STREAM NEWVALUE)) OLDVAL))
)
(\GENERIC.CHARSET
(LAMBDA (STREAM NEWVALUE) (* ; "Edited 11-Sep-87 16:20 by bvm:") (* ;;; "sets or returns the current numeric character set for this stream. This never writes anything on a stream, it just tells the stream what to think.") (PROG1 (ffetch (STREAM CHARSET) of (\DTEST STREAM (QUOTE STREAM))) (AND NEWVALUE (freplace (STREAM CHARSET) of STREAM with NEWVALUE))))
)
(ACCESS-CHARSET
(LAMBDA (STREAM NEWVALUE) (* ; "Edited 11-Sep-87 15:46 by bvm:") (FDEVOP (QUOTE CHARSETFN) (fetch (STREAM DEVICE) of STREAM) STREAM NEWVALUE))
)
)
(DEFINEQ
(%%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))
)
(%%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 %%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))))
(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)))
(DECLARE%: DONTEVAL@LOAD DOCOPY
(MAPC (QUOTE (LASTC SKIPSEPRCODES SKIPSEPRS READ-EXTENDED-TOKEN \RSTRING2 \SUBREAD SETFILEPTR \GENERIC.READP CL:UNREAD-CHAR CL:PEEK-CHAR \FILLBUFFER READCCODE READC PEEKCCODE COPY.TEXT.TO.IMAGE FASL:FASL-FAT-STRING FASL::FASL-FAT-STRINGA0002)) (FUNCTION (LAMBDA (FN) (CHANGENAME FN (QUOTE CHARSET) (QUOTE ACCESS-CHARSET)))))
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DEFOPTIMIZER ACCESS-CHARSET (STREAM &OPTIONAL NEWVALUE) (BQUOTE ((OPENLAMBDA (STRM) (FDEVOP (QUOTE CHARSETFN) (fetch (STREAM DEVICE) of STRM) STRM (\, NEWVALUE))) (\, STREAM))))
(DECLARE%: EVAL@COMPILE
(PUTPROPS \BACKCHAR MACRO (OPENLAMBDA (STREAM) (* ; "Backs up over an NS character") (\BACKNSCHAR STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256))))
(PUTPROPS \BACKNSCHAR MACRO ((STREAM SHIFTEDCHARSET COUNTERVAR) (AND (\BACKFILEPTR STREAM) (COND ((COND (SHIFTEDCHARSET (EQ SHIFTEDCHARSET (UNFOLD \NORUNCODE 256))) (T (EQ \NORUNCODE (ACCESS-CHARSET STREAM)))) (COND ((\BACKFILEPTR STREAM) (AND (QUOTE COUNTERVAR) (add COUNTERVAR 2)) T) ((QUOTE COUNTERVAR) (add COUNTERVAR 1)))) ((QUOTE COUNTERVAR) (add COUNTERVAR 1))))))
(PUTPROPS \CHECKEOLC MACRO (OPENLAMBDA (CH EOLC STREAM PEEKBINFLG COUNTERVAR) (* ;; "Subtracts number of bytes read from COUNTERVAR, which may be NIL. In fact, should be NIL if PEEKBINFLG is T.") (SELCHARQ CH (CR (SELECTC EOLC (CR.EOLC (CHARCODE EOL)) (CRLF.EOLC (COND (PEEKBINFLG (* ;; "T from PEEKC, compile-time constant. In this case, must leave the fileptr where it was, except for possibly advancing over character set shifts") (COND ((EQ (CHARCODE LF) (UNINTERRUPTABLY (\NSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256)) (* ;; "Read the NS CR. We know that there aren't any font-shift characters in front of the CR, because they would have already been read by the \NSPEEK that got the CR character. Since we are going to NS back the CR character, we don't need to update the counter variable") (PROG1 (\PEEKBIN STREAM T) (* ;; "LF must be in next BYTE after NS CR, regardless of coding. Character-set shifting bytes can't intervene. Then we back up over the CR that was \NSINed above.") (\BACKNSCHAR STREAM)))) (CHARCODE EOL)) (T (CHARCODE CR)))) ((EQ (CHARCODE LF) (\PEEKBIN STREAM T)) (\BIN STREAM) (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (SUB1 COUNTERVAR))) (CHARCODE EOL)) (T (CHARCODE CR)))) (CHARCODE CR))) (LF (COND ((EQ EOLC LF.EOLC) (CHARCODE EOL)) (T (CHARCODE LF)))) CH)))
(PUTPROPS \INCHAR MACRO (OPENLAMBDA (STREAM COUNTERVAR) (* ; "returns a 16 bit character code") (\CHECKEOLC (\NSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256) NIL COUNTERVAR) (FFETCH EOLCONVENTION OF STREAM) STREAM NIL COUNTERVAR)))
(PUTPROPS \INCCODE MACRO (OPENLAMBDA (STREAM COUNTERVAR) (* ; "returns a 16 bit character code") (\CHECKEOLC (\NSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256) NIL COUNTERVAR) (FFETCH EOLCONVENTION OF STREAM) STREAM NIL COUNTERVAR)))
(PUTPROPS \PEEKCCODE MACRO (OPENLAMBDA (STREAM NOERROR) (\CHECKEOLC (\NSPEEK STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256) NIL NOERROR) (ffetch EOLCONVENTION of STREAM) STREAM T)))
(PUTPROPS \NSIN MACRO ((STREAM SHIFTEDCSET SHIFTEDCSETVAR COUNTERVAR) (* ;;; "returns a 16 bit character code. SHIFTEDCSET is STREAM's char set left shifted 8, SHIFTEDCSETVAR if non-NIL is the variable to set if char set changes. COUNTERVAR if non-NIL is decremented by number of bytes read. Doesn't do EOL conversion -- \INCHAR does that.") (LET ((CHAR (\BIN STREAM)) SCSET) (COND ((EQ CHAR NSCHARSETSHIFT) (* ; "Shifting character sets") (ACCESS-CHARSET STREAM (SETQ SCSET (COND ((NEQ NSCHARSETSHIFT (SETQ CHAR (\BIN STREAM))) (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2))) CHAR) ((PROGN (* ; "2 shift-bytes means not run-encoded") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 3))) (EQ 0 (\BIN STREAM))) \NORUNCODE) (T (\NSIN.24BITENCODING.ERROR STREAM))))) (SETQ CHAR (\BIN STREAM)) (SETQ SCSET (COND ((QUOTE SHIFTEDCSETVAR) (* ; "CHARSETVAR=NIL means don't set") (SETQ SHIFTEDCSETVAR (UNFOLD SCSET 256))) (T (UNFOLD SCSET 256))))) (T (SETQ SCSET SHIFTEDCSET))) (COND ((EQ SCSET (UNFOLD \NORUNCODE 256)) (* ; "just read two bytes and combine them to a 16 bit value") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2))) (LOGOR (UNFOLD CHAR 256) (\BIN STREAM))) (CHAR (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 1))) (AND CHAR (LOGOR SCSET CHAR)))))))
(PUTPROPS \NSPEEK MACRO ((STREAM SHIFTEDCSET SHIFTEDCSETVAR NOERROR COUNTERVAR) (* ;; "returns a 16 bit character code. Doesn't do EOL conversion--\INCHAR does that. May actually read the character-set shift, storing the result in the stream. COUNTERVAR, if given, is updated to reflect any such bytes that are actually read") (PROG ((CHAR (\PEEKBIN STREAM NOERROR)) SCSET) (COND ((NULL CHAR) (RETURN NIL)) ((EQ CHAR NSCHARSETSHIFT) (* ; "CHARSETVAR=NIL means don't set") (\BIN STREAM) (* ; "Consume the char shift byte") (ACCESS-CHARSET STREAM (SETQ SCSET (COND ((NEQ NSCHARSETSHIFT (SETQ CHAR (\BIN STREAM))) (* ; "Note: no eof error check on this \BIN -- an eof in the middle of a charset shift is an error") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2))) CHAR) ((PROGN (* ; "2 shift-bytes means not run-encoded") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 3))) (EQ 0 (\BIN STREAM))) \NORUNCODE) (T (\NSIN.24BITENCODING.ERROR STREAM))))) (SETQ SCSET (COND ((QUOTE SHIFTEDCSETVAR) (* ; "CHARSETVAR=NIL means don't set") (SETQ SHIFTEDCSETVAR (UNFOLD SCSET 256))) (T (UNFOLD SCSET 256)))) (COND ((NULL (SETQ CHAR (\PEEKBIN STREAM NOERROR))) (RETURN NIL)))) (T (SETQ SCSET SHIFTEDCSET))) (RETURN (COND ((EQ SCSET (UNFOLD \NORUNCODE 256)) (* ;; "just peek two bytes and combine them to a 16 bit value. Again, is an error if we hit eof in mid-character") (\BIN STREAM) (PROG1 (LOGOR (UNFOLD CHAR 256) (\PEEKBIN STREAM NOERROR)) (\BACKFILEPTR STREAM))) (T (LOGOR SHIFTEDCSET CHAR)))))))
(PUTPROPS NUMERIC-CHARSET MACRO (= . ACCESS-CHARSET))
)
(PUTPROPS NSCHARPATCH FILETYPE :COMPILE-FILE)
)
(PUTPROPS NSCHARPATCH COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1090 2792 (CHARSET 1100 . 2240) (\GENERIC.CHARSET 2242 . 2624) (ACCESS-CHARSET 2626 .
2790)) (2793 3369 (%%SYNONYM-STREAM-DEVICE-CHARSETFN 2803 . 3038) (%%TWO-WAY-STREAM-DEVICE-CHARSETFN
3040 . 3367)))))
STOP