IOTiogaImpl.mesa
Copyright Ó 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Bier, February 27, 1991 2:25 pm PST
Doug Wyatt, October 30, 1991 4:48 pm PST
Contents: Some IO streams produce Tioga files as output. These routines allow client control of the node properties, characters looks, and characters properties of the Tioga document as it is emitted.
DIRECTORY
Ascii, Atom, IO, IOTioga, IOTiogaPrivate, IOUtils, NodeProps, Prop, RefText, Rope, TextLooks, TiogaAccess;
IOTiogaImpl: CEDAR PROGRAM
IMPORTS Ascii, Atom, IO, IOUtils, NodeProps, Prop, RefText, Rope, TextLooks, TiogaAccess
EXPORTS IOTioga, IOTiogaPrivate
~ BEGIN OPEN IOTioga, IOTiogaPrivate;
ioTiogaOpsAtom:
ATOM ~ $IOTiogaOps;
AddOps:
PUBLIC
PROC [class:
REF
IO.StreamProcs, ops: Ops] ~ {
IOUtils.StoreProc[class, ioTiogaOpsAtom, ops];
};
GetOps:
PROC [self:
STREAM]
RETURNS [Ops] ~ {
WITH IOUtils.LookupProc[self, ioTiogaOpsAtom]
SELECT
FROM
ops: Ops => RETURN[ops];
ENDCASE => RETURN[noOps];
ERROR IO.Error[NotImplementedForThisStream, self];
};
SetCharSet:
PUBLIC
PROC [self:
STREAM, charSet: CharSet] ~ {
GetOps[self].SetCharSet[self, charSet];
};
GetCharSet:
PUBLIC
PROC [self:
STREAM]
RETURNS [CharSet] ~ {
RETURN[GetOps[self].GetCharSet[self]];
};
LooksFromRope:
PUBLIC
PROC [rope:
ROPE]
RETURNS [Looks] ~ {
RETURN[TextLooks.RopeToLooks[rope]];
};
RopeFromLooks:
PUBLIC
PROC [looks: Looks]
RETURNS [
ROPE] ~ {
RETURN[TextLooks.LooksToRope[looks]];
};
ChangeLooks:
PUBLIC
PROC [self:
STREAM, remove, add: Looks ¬ noLooks] ~ {
GetOps[self].ChangeLooks[self, remove, add];
};
GetLooks:
PUBLIC
PROC [self:
STREAM]
RETURNS [Looks] ~ {
RETURN[GetOps[self].GetLooks[self]];
};
PropRem:
PROC [propList: PropList, key:
REF]
RETURNS [PropList] ~ {
RETURN[Prop.Rem[propList, key]];
};
PropGet:
PUBLIC
PROC [propList: PropList, key:
REF]
RETURNS [val:
REF] ~ {
RETURN[Prop.Get[propList, key]];
};
PropPut:
PUBLIC
PROC [propList: PropList, key:
REF, val:
REF]
RETURNS [PropList] ~ {
RETURN[Prop.Put[propList, key, val]];
};
SetCharProps:
PUBLIC
PROC [self:
STREAM, propList: PropList] ~ {
GetOps[self].SetCharProps[self, propList];
};
GetCharProps:
PUBLIC
PROC [self:
STREAM]
RETURNS [PropList] ~ {
RETURN[GetOps[self].GetCharProps[self]];
};
SetNodeProp:
PUBLIC
PROC [self:
STREAM, name:
ATOM, value:
REF] ~ {
GetOps[self].SetNodeProp[self, name, value];
};
GetNodeProp:
PUBLIC
PROC [self:
STREAM, name:
ATOM]
RETURNS [value:
REF] ~ {
RETURN[GetOps[self].GetNodeProp[self, name]];
};
MapNodeProps:
PUBLIC
PROC [self:
STREAM, action: MapPropsAction]
RETURNS [
BOOL] ~ {
RETURN[GetOps[self].MapNodeProps[self, action]];
};
FormatFromRope:
PUBLIC
PROC [rope:
ROPE]
RETURNS [format:
ATOM] ~ {
IF Rope.IsEmpty[rope]
THEN
RETURN[
NIL]
ELSE {
scratch: REF TEXT ~ RefText.ObtainScratch[100];
text: REF TEXT ¬ scratch;
action: Rope.ActionType ~ { text ¬ RefText.AppendChar[text, Ascii.Lower[c]] };
[] ¬ Rope.Map[base: rope, action: action];
format ¬ Atom.MakeAtomFromRefText[text];
RefText.ReleaseScratch[scratch];
};
};
RopeFromFormat: PUBLIC PROC [value: REF] RETURNS [ROPE] ~ {
WITH value SELECT FROM
atom: ATOM => RETURN[Atom.GetPName[atom]];
ENDCASE => RETURN[NIL];
};
nameFormat:
ATOM ~ $Format;
SetFormat:
PUBLIC
PROC [self:
STREAM, format:
ATOM] ~ {
SetNodeProp[self, nameFormat, format];
};
GetFormat:
PUBLIC
PROC [self:
STREAM]
RETURNS [
ATOM] ~ {
WITH GetNodeProp[self, nameFormat]
SELECT
FROM
format: ATOM => RETURN[format];
ENDCASE => RETURN[NIL];
};
CommentFromBool:
PUBLIC
PROC [bool:
BOOL]
RETURNS [
REF] ~ {
RETURN[NodeProps.ValueFromBool[bool]];
};
BoolFromComment:
PUBLIC
PROC [value:
REF]
RETURNS [
BOOL] ~ {
RETURN[NodeProps.BoolFromValue[value]];
};
nameComment:
ATOM ~ $Comment;
SetComment:
PUBLIC
PROC [self:
STREAM, comment:
BOOL] ~ {
SetNodeProp[self, nameComment, CommentFromBool[comment]];
};
GetComment:
PUBLIC
PROC [self:
STREAM]
RETURNS [
BOOL] ~ {
RETURN[BoolFromComment[GetNodeProp[self, nameComment]]];
};
SetLevel:
PUBLIC
PROC [self:
STREAM, level:
CARDINAL] ~ {
GetOps[self].SetLevel[self, level];
};
GetLevel:
PUBLIC
PROC [self:
STREAM]
RETURNS [level:
CARDINAL] ~ {
RETURN[GetOps[self].GetLevel[self]];
};
Break:
PUBLIC
PROC [self:
STREAM] ~ {
GetOps[self].Break[self];
};
Signal: PUBLIC SIGNAL [code: ATOM, msg: ROPE] ~ CODE;
Implementation on top of TiogaAccess
opsAStream: Ops ~
NEW[OpsRep ¬ [
PutChar: APutChar,
SetCharSet: ASetCharSet,
GetCharSet: AGetCharSet,
ChangeLooks: AChangeLooks,
GetLooks: AGetLooks,
SetCharProps: ASetCharProps,
GetCharProps: AGetCharProps,
SetNodeProp: ASetNodeProp,
GetNodeProp: AGetNodeProp,
MapNodeProps: AMapNodeProps,
SetLevel: ASetLevel,
GetLevel: AGetLevel,
Break: ABreak
]];
noOps: Ops ~
NEW[OpsRep ¬ [
PutChar: NoPutChar,
SetCharSet: NoSetCharSet,
GetCharSet: NoGetCharSet,
ChangeLooks: NoChangeLooks,
GetLooks: NoGetLooks,
SetCharProps: NoSetCharProps,
GetCharProps: NoGetCharProps,
SetNodeProp: NoSetNodeProp,
GetNodeProp: NoGetNodeProp,
MapNodeProps: NoMapNodeProps,
SetLevel: NoSetLevel,
GetLevel: NoGetLevel,
Break: NoBreak
]];
classAStream: REF IO.StreamProcs ~ CreateClassA[];
CreateClassA:
PROC
RETURNS [class:
REF
IO.StreamProcs] ~ {
class ¬ IO.CreateStreamProcs[variety: output, class: $IOTioga, putChar: APutChar];
AddOps[class, opsAStream];
};
AStreamData: TYPE ~ REF AStreamDataRep;
AStreamDataRep:
TYPE ~
RECORD [
writer: TiogaAccess.Writer,
char: TiogaAccess.TiogaChar,
node: TiogaAccess.TiogaChar,
level, prevLevel: CARDINAL
];
CreateTiogaAccessStream:
PUBLIC
PROC
RETURNS [
STREAM] ~ {
nullChar: TiogaAccess.TiogaChar ~ [charSet: 0, char: '\000, looks: noLooks,
format: NIL, comment: FALSE, endOfNode: FALSE, deltaLevel: 0, propList: NIL];
data: AStreamData ~ NEW[AStreamDataRep ¬ [writer: TiogaAccess.Create[],
char: nullChar, node: nullChar, level: 0, prevLevel: 0]];
data.node.endOfNode ¬ TRUE;
RETURN[IO.CreateStream[classAStream, data]];
};
WriterFromStream:
PUBLIC
PROC [self:
STREAM]
RETURNS [TiogaAccess.Writer] ~ {
WITH self.streamData
SELECT
FROM
data: AStreamData => RETURN[data.writer];
ENDCASE;
ERROR IO.Error[NotImplementedForThisStream, self];
};
APutChar:
PROC [self:
STREAM, char:
CHAR] ~ {
data: AStreamData ~ NARROW[self.streamData];
data.char.char ¬ char;
TiogaAccess.Put[data.writer, data.char];
};
NoPutChar:
PROC [self:
STREAM, char:
CHAR] ~ {
};
ASetCharSet:
PROC [self:
STREAM, charSet: CharSet] ~ {
data: AStreamData ~ NARROW[self.streamData];
data.char.charSet ¬ charSet;
};
NoSetCharSet:
PROC [self:
STREAM, charSet: CharSet] ~ {
};
AGetCharSet:
PROC [self:
STREAM]
RETURNS [CharSet] ~ {
data: AStreamData ~ NARROW[self.streamData];
RETURN[data.char.charSet];
};
NoGetCharSet:
PROC [self:
STREAM]
RETURNS [CharSet] ~ {
RETURN[0];
};
AChangeLooks:
PROC [self:
STREAM, remove, add: Looks] ~ {
data: AStreamData ~ NARROW[self.streamData];
data.char.looks ¬ TextLooks.ModifyLooks[old: data.char.looks, remove: remove, add: add];
};
NoChangeLooks:
PROC [self:
STREAM, remove, add: Looks] ~ {
};
AGetLooks:
PROC [self:
STREAM]
RETURNS [Looks] ~ {
data: AStreamData ~ NARROW[self.streamData];
RETURN[data.char.looks];
};
NoGetLooks:
PROC [self:
STREAM]
RETURNS [Looks] ~ {
RETURN[TextLooks.noLooks];
};
ASetCharProps:
PROC [self:
STREAM, propList: PropList] ~ {
data: AStreamData ~ NARROW[self.streamData];
data.char.propList ¬ propList;
};
NoSetCharProps:
PROC [self:
STREAM, propList: PropList] ~ {
};
AGetCharProps:
PROC [self:
STREAM]
RETURNS [PropList] ~ {
data: AStreamData ~ NARROW[self.streamData];
RETURN[data.char.propList];
};
NoGetCharProps:
PROC [self:
STREAM]
RETURNS [PropList] ~ {
RETURN[NIL];
};
ASetNodeProp:
PROC [self:
STREAM, name:
ATOM, value:
REF] ~ {
data: AStreamData ~ NARROW[self.streamData];
data.node.propList ¬ PropPut[data.node.propList, name, value];
};
NoSetNodeProp:
PROC [self:
STREAM, name:
ATOM, value:
REF] ~ {
};
AGetNodeProp:
PROC [self:
STREAM, name:
ATOM]
RETURNS [value:
REF] ~ {
data: AStreamData ~ NARROW[self.streamData];
RETURN[PropGet[data.node.propList, name]];
};
NoGetNodeProp:
PROC [self:
STREAM, name:
ATOM]
RETURNS [value:
REF] ~ {
RETURN[NIL];
};
AMapNodeProps:
PROC [self:
STREAM, action: MapPropsAction]
RETURNS [
BOOL] ~ {
data: AStreamData ~ NARROW[self.streamData];
FOR list: PropList ¬ data.node.propList, list.rest
UNTIL list=
NIL
DO
WITH list.first.key
SELECT
FROM
name: ATOM => IF action[name, list.first.val] THEN RETURN[TRUE];
ENDCASE;
ENDLOOP;
RETURN[FALSE];
};
NoMapNodeProps:
PROC [self:
STREAM, action: MapPropsAction]
RETURNS [
BOOL] ~ {
RETURN[FALSE];
};
ASetLevel:
PROC [self:
STREAM, level:
CARDINAL] ~ {
data: AStreamData ~ NARROW[self.streamData];
IF (
INT[level]-
INT[data.prevLevel])>1
THEN {
SIGNAL Signal[$InvalidLevel, "Invalid nesting level"];
level ¬ data.prevLevel+1; -- if RESUMEd
};
data.level ¬ level;
};
NoSetLevel:
PROC [self:
STREAM, level:
CARDINAL] ~ {
};
AGetLevel:
PROC [self:
STREAM]
RETURNS [level:
CARDINAL] ~ {
data: AStreamData ~ NARROW[self.streamData];
RETURN[data.level];
};
NoGetLevel:
PROC [self:
STREAM]
RETURNS [level:
CARDINAL] ~ {
RETURN[0];
};
ABreak:
PROC [self:
STREAM] ~ {
data: AStreamData ~ NARROW[self.streamData];
TiogaAccess.Nest[data.writer, INT[data.level]-INT[data.prevLevel]];
TiogaAccess.Put[data.writer, data.node];
data.prevLevel ¬ data.level;
};
NoBreak:
PROC [self:
STREAM] ~ {
};
END.