StructuredStreamsImpl.Mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
Mike Spreitzer July 30, 1986 9:22:31 pm PDT
Last tweaked by Mike Spreitzer on January 10, 1992 3:18 pm PST
JKF October 18, 1988 8:30:44 am PDT
Willie-s, January 16, 1992 6:11 pm PST
Michael Plass, May 21, 1992 9:43 am PDT
DIRECTORY Atom, IO, IOUtils, Rope, RuntimeError, StructuredStreams, UnparserBuffer;
StructuredStreamsImpl:
CEDAR
PROGRAM
IMPORTS IO, IOUtils, Rope, RuntimeError, UnparserBuffer
EXPORTS StructuredStreams
SHARES IO =
BEGIN
ROPE: TYPE = Rope.ROPE;
PropList: TYPE = Atom.PropList;
SSData: TYPE = REF SSDataRec;
SSDataRec:
TYPE =
RECORD [
ubh: UnparserBuffer.Handle,
idx: INT ¬ 0];
used: CARDINAL ¬ 0;
SSProcs:
REF
IO.StreamProcs ¬
IO.CreateStreamProcs[
variety: output,
class: $StructuredStream,
putChar: PutChar,
putBlock: PutBlock,
flush: Flush,
getIndex: GetIndex,
close: Close];
pfProcs: IOUtils.PFProcs = IOUtils.CopyPFProcs[NIL];
Create:
PUBLIC
PROC [onTopOf: UnparserBuffer.Handle]
RETURNS [ss:
IO.
STREAM] ~ {
ssd: SSData ~ NEW [SSDataRec ¬ [ubh: onTopOf]];
ss ¬ IO.CreateStream[streamProcs: SSProcs, streamData: ssd];
[] ¬ IOUtils.SetPFProcs[ss, pfProcs];
RETURN};
IsAnSS:
PUBLIC
PROC [s:
IO.
STREAM]
RETURNS [
BOOLEAN]
~ {RETURN [s.streamProcs.class = $StructuredStream]};
GetHandle:
PUBLIC
PROC [ss:
IO.
STREAM]
RETURNS [UnparserBuffer.Handle] =
BEGIN
IF ss.streamData = NIL THEN RETURN [NIL];
WITH ss.streamData
SELECT
FROM
ssd: SSData => RETURN [ssd.ubh];
ENDCASE => RETURN [NIL];
END;
Strip:
PUBLIC
PROC [ss:
IO.
STREAM]
RETURNS [
IO.
STREAM] =
BEGIN
IF ss.streamData = NIL THEN RETURN [ss];
WITH ss.streamData
SELECT
FROM
ssd: SSData =>
WITH ssd.ubh.output
SELECT
FROM
so: UnparserBuffer.BufferOutput.stream => RETURN [so.stream];
ENDCASE => ERROR;
ENDCASE => RETURN [ss];
END;
CloseThrough:
PUBLIC
PROC [self:
IO.
STREAM] =
BEGIN
IF NOT IsAnSS[self] THEN self.Close[]
ELSE {
ssd: SSData = NARROW[self.streamData];
self.Close[];
WITH ssd.ubh.output
SELECT
FROM
so: UnparserBuffer.BufferOutput.stream => so.stream.Close[];
ENDCASE => ERROR;
};
END;
Begin:
PUBLIC
PROC [ss:
IO.
STREAM] = {
IF IsAnSS[ss] THEN NARROW[ss.streamData, SSData].ubh.Setb[];
};
End:
PUBLIC
PROC [ss:
IO.
STREAM] = {
IF IsAnSS[ss] THEN NARROW[ss.streamData, SSData].ubh.Endb[];
};
XBp:
PUBLIC
PROC [ss:
IO.
STREAM, cond: UnparserBuffer.XBreakCondition, offset:
INTEGER, sep:
ROPE ¬
NIL] = {
IF IsAnSS[ss]
THEN {
ssd: SSData ¬ NARROW[ss.streamData];
UnparserBuffer.XBp[ssd.ubh, cond, offset, sep];
IF cond=always THEN ssd.idx ¬ ssd.idx+1 ELSE ssd.idx ¬ ssd.idx + sep.Length;
}
ELSE IF cond=always THEN ss.PutChar['\n]
ELSE ss.PutRope[sep];
};
Bp:
PUBLIC
PROC [ss:
IO.
STREAM, cond: UnparserBuffer.BreakCondition, offset:
INTEGER, sep:
ROPE ¬
NIL] = {
IF IsAnSS[ss]
THEN {
ssd: SSData ¬ NARROW[ss.streamData];
ssd.ubh.Bp[cond, offset, sep];
IF cond=always THEN ssd.idx ¬ ssd.idx+1 ELSE ssd.idx ¬ ssd.idx + sep.Length;
}
ELSE IF cond=always THEN ss.PutChar['\n]
ELSE ss.PutRope[sep];
};
ChangeMargin:
PUBLIC
PROC [ss:
IO.
STREAM, newMargin:
INTEGER ¬ 69] = {
IF IsAnSS[ss]
THEN
BEGIN
ssd: SSData ~ NARROW[ss.streamData];
ssd.ubh.margin ¬ newMargin;
END;
};
PutChar:
PROC [self:
IO.
STREAM, char:
CHAR] = {
ssd: SSData = NARROW[self.streamData];
IF char = '\r OR char = '\l THEN ssd.ubh.Newlineb[0]
ELSE ssd.ubh.Charb[char];
ssd.idx ¬ ssd.idx + 1;
};
PutBlock:
PROC [self:
IO.
STREAM, block:
REF
READONLY
TEXT, startIndex, count:
NAT] ~ {
ssd: SSData = NARROW[self.streamData];
limit: NAT;
IF count=0 THEN RETURN;
IF startIndex >= block.length THEN ERROR RuntimeError.BoundsFault[];
count ¬ MIN[count, block.length-startIndex];
IF count=0 THEN RETURN;
limit ¬ startIndex+count;
WHILE startIndex < limit
DO
FOR i:
NAT ¬ startIndex, i.
SUCC
WHILE i < limit
DO
c: CHAR ~ block[i];
IF c = '\l
OR c = '\r
THEN {
IF i > startIndex THEN UnparserBuffer.Textb[ssd.ubh, block, startIndex, i-startIndex];
ssd.ubh.Newlineb[0];
startIndex ¬ i+1;
EXIT};
REPEAT
FINISHED => {
UnparserBuffer.Textb[ssd.ubh, block, startIndex, limit-startIndex];
startIndex ¬ limit};
ENDLOOP;
ENDLOOP;
ssd.idx ¬ ssd.idx + count;
RETURN};
PrintLFormat:
PROC [stream:
IO.
STREAM, val:
IO.Value, format: IOUtils.Format, char:
CHAR]
--IOUtils.PFCodeProc-- = {
ssd: SSData = NARROW[stream.streamData];
WITH val
SELECT
FROM
x: rope IO.Value => ssd.ubh.Looksb[x.value];
ENDCASE => ERROR IO.Error[PFTypeMismatch, stream];
};
PrintPFormat:
PROC [stream:
IO.
STREAM, val:
IO.Value, format: IOUtils.Format, char:
CHAR]
--IOUtils.PFCodeProc-- = {
ssd: SSData = NARROW[stream.streamData];
WITH val
SELECT
FROM
x: refAny
IO.Value =>
TRUSTED {
mv: REF ANY = LOOPHOLE[x.value];
IF mv = NIL OR ISTYPE[mv, PropList] THEN ssd.ubh.CharPropsb[NARROW[mv]] ELSE ERROR IO.Error[PFTypeMismatch, stream];
};
x: cardinal
IO.Value =>
IF x.value
IN UnparserBuffer.CharSet
THEN UnparserBuffer.CharSetb[ssd.ubh, x.value]
ELSE IO.Error[PFUnprintableValue, stream];
ENDCASE => ERROR IO.Error[PFTypeMismatch, stream];
};
PrintNFormat:
PROC [stream:
IO.
STREAM, val:
IO.Value, format: IOUtils.Format, char:
CHAR]
--IOUtils.PFCodeProc-- = {
ssd: SSData = NARROW[stream.streamData];
WITH val
SELECT
FROM
x: refAny
IO.Value =>
TRUSTED {
mv: REF ANY = LOOPHOLE[x.value];
IF mv = NIL OR ISTYPE[mv, PropList] THEN ssd.ubh.NodePropsb[NARROW[mv]] ELSE ERROR IO.Error[PFTypeMismatch, stream];
};
x: boolean IO.Value => ssd.ubh.NodeCommentb[x.value];
x: atom IO.Value => ssd.ubh.NodeFormatb[x.value];
ENDCASE => ERROR IO.Error[PFTypeMismatch, stream];
};
Flush:
PROC [self:
IO.
STREAM] ~ {
ssd: SSData ~ NARROW[self.streamData];
WITH ssd.ubh.output
SELECT
FROM
so: UnparserBuffer.BufferOutput.stream => so.stream.Flush[];
ENDCASE => ERROR;
RETURN};
GetIndex:
PROC [self:
IO.
STREAM]
RETURNS [
INT] ~ {
ssd: SSData ~ NARROW[self.streamData];
RETURN [ssd.idx]};
Close:
PROC [self:
IO.
STREAM, abort:
BOOL ¬
FALSE] =
BEGIN
IOUtils.AmbushStream[self: self, streamProcs: IOUtils.closedStreamProcs, streamData: NIL];
END;
Start:
PROC = {
[] ¬ IOUtils.SetPFCodeProc[pfProcs, 'l, PrintLFormat];
[] ¬ IOUtils.SetPFCodeProc[pfProcs, 'p, PrintPFormat];
[] ¬ IOUtils.SetPFCodeProc[pfProcs, 'n, PrintNFormat];
};
Start[];
END.