(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED "28-Nov-88 19:02:01" {PHYLUM}<LISP>LYRIC>PATCHES>RSTRINGPATCH.;2
 4500   

      changes to%:  (VARS RSTRINGPATCHCOMS)

      previous date%: "17-Nov-88 13:59:59" {PHYLUM}<LISP>LYRIC>PATCHES>RSTRINGPATCH.;1)


(* "
Copyright (c) 1988 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT RSTRINGPATCHCOMS)

(RPAQQ RSTRINGPATCHCOMS
 ((FILES NSCHARPATCH)
                         (FNS \RSTRING2)))

(FILESLOAD NSCHARPATCH)
(DEFINEQ

(\RSTRING2

(LAMBDA (STREAM SA RSFLG PNSTR) (* ; "Edited 17-Nov-88 13:58 by bvm") (* ;;; "The main string reader.  Reads characters from STREAM according to the syntax table SA and returns a string.  PNSTR is an instance of the global resource \PNAMESTRING, which we can use all to ourselves as a buffer.") (* ;;; "If RSFLG is T then the call is from RSTRING, in which case the string is terminated by a break or sepr in SA.  If RSFLG is NIL then the string is terminated by a string delimiter.  If RSFLG is SKIP then CR's and the following separator chars are discarded as an otherwise normal string is read") (DECLARE (USEDFREE *READTABLE* *READ-SUPPRESS*)) (PROG ((EOLC (ffetch EOLCONVENTION of STREAM)) (PBASE (SELECTQ (SYSTEMTYPE) (VAX PNSTR) (ffetch (STRINGP XBASE) of PNSTR))) (SHIFTEDCHARSET (UNFOLD (ACCESS-CHARSET STREAM) 256)) (J 0) EOLCHAR CH SNX ANSLIST ANSTAIL FATSEEN SKIPPING) (SELECTC EOLC (CRLF.EOLC (SETQ EOLCHAR (CHARCODE CR))) (LF.EOLC (SETQ EOLCHAR (CHARCODE LF))) NIL) RS2LP (SETQ CH (\NSIN STREAM SHIFTEDCHARSET SHIFTEDCHARSET)) (if (EQ CH EOLCHAR) then (* ;; "We just read the stream's EOL character, so we have to turn it into our EOL.  Most places do this with \CHECKEOLC, but we can't do that here, because if the eol is CRLF and would terminate the read, \BACKNSCHAR won't work right.") (if (AND (EQ RSFLG T) (fetch STOPATOM of (\SYNCODE SA (CHARCODE CR)))) then (* ; "From RSTRING, eol terminates read.  Leave eol in buffer") (\BACKNSCHAR STREAM SHIFTEDCHARSET) (GO FINISH) else (if (AND (EQ EOLC CRLF.EOLC) (EQ (\PEEKBIN STREAM T) (CHARCODE LF))) then (* ; "Eat the LF after the CR") (\BIN STREAM)) (SETQ CH (CHARCODE CR)))) (SETQ SNX (\SYNCODE SA CH)) (SELECTC SNX (OTHER.RC (* ; "Normal case, nothing to do")) (ESCAPE.RC (COND ((fetch ESCAPEFLG of *READTABLE*) (SETQ CH (\CHECKEOLC (\NSIN STREAM SHIFTEDCHARSET SHIFTEDCHARSET) EOLC STREAM)) (COND ((AND (EQ RSFLG (QUOTE SKIP)) (EQ CH (CHARCODE CR))) (* ; "Strip leading spaces after escaped returns, too, but leave the CR in the string") (SETQ SKIPPING 0) (GO PUTCHAR)))))) (SELECTQ RSFLG (NIL (* ; "end check is dbl quote") (COND ((EQ SNX STRINGDELIM.RC) (* ; "Got it") (GO FINISH)))) (T (* ; "if called from RSTRING, end check is break or sepr, and we must leave delim in stream") (COND ((fetch STOPATOM of SNX) (\BACKNSCHAR STREAM SHIFTEDCHARSET) (GO FINISH)))) (SKIP (* ; "Like NIL but strip cr's and leading spaces") (SELECTC SNX (STRINGDELIM.RC (GO FINISH)) (SEPRCHAR.RC (* ; "Assume that CR is a sepr") (COND (SKIPPING (COND ((EQ CH (CHARCODE EOL)) (* ; "Multiple CR's while skipping are kept") (COND ((EQ SKIPPING T) (* ; "Turn previous space back into CR.  Note that J is guaranteed to be at least 1") (\PNAMESTRINGPUTCHAR PBASE (SUB1 J) CH) (SETQ SKIPPING 0))) (GO PUTCHAR)) (T (* ; "Continue skipping seprs") (GO RS2LP)))) ((EQ CH (CHARCODE EOL)) (* ; "Turn CR into space and start skipping seprs") (SETQ SKIPPING T) (SETQ CH (CHARCODE SPACE)) (GO PUTCHAR)))) NIL)) (SHOULDNT))) (SETQ SKIPPING NIL) PUTCHAR (if (NOT *READ-SUPPRESS*) then (* ; "Accumulate character") (COND ((EQ J \PNAMELIMIT) (* ; "Filled PNSTR so have to save those chars away and start filling up a new buffer") (SETQ J (\SMASHSTRING (ALLOCSTRING J NIL NIL FATSEEN) 0 PNSTR J)) (COND (ANSLIST (RPLACD ANSTAIL (SETQ ANSTAIL (CONS J NIL)))) (T (SETQ ANSTAIL (SETQ ANSLIST (CONS J NIL))))) (SETQ J 0))) (\PNAMESTRINGPUTCHAR PBASE J CH) (COND ((AND (NOT FATSEEN) (IGREATERP CH \MAXTHINCHAR)) (SETQ FATSEEN T))) (SETQ J (ADD1 J))) (if (OR (NEQ RSFLG T) (NOT (\EOFP STREAM))) then (* ; "in RSTRING (RSFLG=T), if we've read something already, then end of file terminates string just like a sepr/break") (GO RS2LP)) FINISH (RETURN (if (NOT *READ-SUPPRESS*) then (SETQ J (\SMASHSTRING (ALLOCSTRING J NIL NIL FATSEEN) 0 PNSTR J)) (COND (ANSLIST (RPLACD ANSTAIL (SETQ ANSTAIL (CONS J NIL))) (CONCATLIST ANSLIST)) (T J))))))
)
)
(PUTPROPS RSTRINGPATCH COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (524 4416 (\RSTRING2 534 . 4414)))))
STOP