DIRECTORY
Convert, GGSlice, GGParent, GGProps, GGSliceOps, IO, Prop, Real, RefTab, Rope;

GGPropsImpl: CEDAR MONITOR
IMPORTS Convert, GGParent, GGSliceOps, IO, Prop, RefTab
EXPORTS GGProps = BEGIN

STREAM: TYPE = IO.STREAM;
Slice: TYPE = GGSlice.Slice;
SliceDescriptor: TYPE = GGSlice.SliceDescriptor;
SliceParts: TYPE = GGSlice.SliceParts;
PropList: TYPE = Prop.PropList;

PropWalkProc: TYPE = GGProps.PropWalkProc;
FileoutProc: TYPE = GGProps.FileoutProc;
FileinProc: TYPE = GGProps.FileinProc;
CopyProc: TYPE = GGProps.CopyProc;
ValFormat: TYPE = GGProps.ValFormat;

Put: PUBLIC PROC [slice: Slice, parts: SliceParts, key: ATOM, val: REF] = {
DoPut: PROC [sliceD: SliceDescriptor] RETURNS [done: BOOL м FALSE] = {
sliceD.slice.props м Prop.Put[sliceD.slice.props, key, val];
};
IF GGParent.IsParentType[GGSliceOps.GetType[slice]] THEN [] м GGParent.WalkIncludedChildren[slice, parts, leaf, DoPut]
ELSE slice.props м Prop.Put[slice.props, key, val];
};
PutAll: PROC [slice: Slice, parts: SliceParts, props: Prop.PropList] = {
DoPut: PROC [sliceD: SliceDescriptor] RETURNS [done: BOOL м FALSE] = {
sliceD.slice.props м props;
};
IF GGParent.IsParentType[GGSliceOps.GetType[slice]] THEN [] м GGParent.WalkIncludedChildren[slice, parts, leaf, DoPut]
ELSE slice.props м props;
};
Get: PUBLIC PROC [slice: Slice, parts: SliceParts, key: ATOM] RETURNS [val: REF, isUnique: BOOL м TRUE] = {
found: BOOL м FALSE;
DoGet: PROC [sliceD: SliceDescriptor] RETURNS [done: BOOL м FALSE] = {
thisVal: REF м Prop.Get[sliceD.slice.props, key]; -- returns NIL if not found
IF thisVal#NIL THEN { -- check the property for uniqueness
IF found AND thisVal#val THEN RETURN[TRUE]
ELSE {
val м thisVal; -- first found property
found м TRUE;
};
};
};

IF GGParent.IsParentType[GGSliceOps.GetType[slice]] THEN
isUnique м NOT GGParent.WalkIncludedChildren[slice, parts, leaf, DoGet]
ELSE val м Prop.Get[slice.props, key];
};
Rem: PUBLIC PROC [slice: Slice, parts: SliceParts, key: ATOM] RETURNS [isUnique: BOOL м TRUE] = {
val: REF;
found: BOOL м FALSE;
DoRem: PROC [sliceD: SliceDescriptor] RETURNS [done: BOOL м FALSE] = {
thisVal: REF м Prop.Get[sliceD.slice.props, key]; -- returns NIL if not found
IF thisVal#NIL THEN {
sliceD.slice.props м Prop.Rem[sliceD.slice.props, key]; -- remove the property
IF found AND thisVal#val THEN isUnique м FALSE -- check the property for uniqueness
ELSE {
val м thisVal; -- first found property
found м TRUE;
};
};
};

IF GGParent.IsParentType[GGSliceOps.GetType[slice]] THEN
[] м GGParent.WalkIncludedChildren[slice, parts, leaf, DoRem]
ELSE slice.props м Prop.Rem[slice.props, key];
};
Copy: PUBLIC PROC [key: ATOM, val: REF] RETURNS [copy: REF] = {
tableEntry: REF;
gtEntry: GTEntry;
found: BOOL м FALSE;

[found, tableEntry] м RefTab.Fetch[gt, key];
IF found THEN {
gtEntry м NARROW[tableEntry];
IF gtEntry.copy=NIL THEN copy м val
ELSE copy м gtEntry.copy[val];
}
ELSE copy м val;
};

Walk: PUBLIC PROC [slice: Slice, parts: SliceParts, walkProc: PropWalkProc] RETURNS [aborted: BOOL м FALSE] = {
DoMap: Prop.MapAction = {
RETURN[walkProc[NARROW[key], val]];
};
DoWalk: PROC [sliceD: SliceDescriptor] RETURNS [done: BOOL м FALSE] = {
done м Prop.Map[sliceD.slice.props, DoMap];
};

IF GGParent.IsParentType[GGSliceOps.GetType[slice]] THEN
aborted м GGParent.WalkIncludedChildren[slice, parts, leaf, DoWalk]
ELSE aborted м Prop.Map[slice.props, DoMap]
};
Kill: PUBLIC PROC [slice: Slice, parts: SliceParts] = {
DoKill: PROC [sliceD: SliceDescriptor] RETURNS [done: BOOL м FALSE] = {
sliceD.slice.props м NIL;
};

IF GGParent.IsParentType[GGSliceOps.GetType[slice]] THEN
[] м GGParent.WalkIncludedChildren[slice, parts, leaf, DoKill]
ELSE slice.props м NIL;
};

CopyAll: PUBLIC PROC [fromSlice, toSlice: Slice, fromParts, toParts: SliceParts м NIL] = {
DoCopyProc: PropWalkProc = {
copyProps м Prop.Put[copyProps, key, Copy[key, val]];
};
copyProps: Prop.PropList м NIL;
[] м Walk[fromSlice, fromParts, DoCopyProc];
PutAll[toSlice, toParts, copyProps];
};

ToRope: PUBLIC ENTRY PROC [key: ATOM, val: REF] RETURNS [r: Rope.ROPE, vf: ValFormat м delimited] = {
ENABLE UNWIND => NULL; -- releases monitor locks if aborted
found: BOOL м FALSE;
tableEntry: REF;
gtEntry: GTEntry;
[found, tableEntry] м RefTab.Fetch[gt, key];
IF NOT found OR tableEntry=NIL THEN {
WITH val SELECT FROM
a: ATOM => RETURN[Convert.RopeFromAtom[from: a]];
rope: Rope.ROPE => RETURN[rope];
int: REF INT => RETURN[Convert.RopeFromInt[from: intн, base: 10, showRadix: FALSE]];
card: REF CARD => RETURN[Convert.RopeFromCard[from: cardн, base: 10, showRadix: FALSE]];
real: REF REAL => RETURN[Convert.RopeFromReal[from: realн, precision: Real.MaxSinglePrecision, useE: FALSE]];
bool: REF BOOL => RETURN[Convert.RopeFromBool[from: boolн]];
ENDCASE => RETURN[NIL];
}
ELSE {
gtEntry м NARROW[tableEntry];
IF gtEntry.out=NIL THEN RETURN[NIL]; -- will implement generic output later
vf м gtEntry.out[IO.ROS[oldStream: scratchROS], val];  -- fill the stream with a description of val
r м IO.RopeFromROS[self: scratchROS, close: TRUE];
};
};
FromRope: PUBLIC ENTRY PROC [key: ATOM, r: Rope.ROPE] RETURNS [val: REF] = {
ENABLE UNWIND => NULL; -- releases monitor locks if aborted
found: BOOL м FALSE;
tableEntry: REF;
gtEntry: GTEntry;
[found, tableEntry] м RefTab.Fetch[gt, key];
IF NOT found OR tableEntry=NIL THEN {
tokenKind: IO.TokenKind;
token: Rope.ROPE;
charsSkipped: INT;
success: BOOL м TRUE;
s: IO.STREAM м IO.RIS[rope: r, oldStream: scratchRIS];

[tokenKind, token, charsSkipped] м IO.GetCedarTokenRope[s
! IO.EndOfStream, IO.Error => {success м FALSE; CONTINUE}];
IF NOT success THEN ERROR;
IF IO.EndOf[s] THEN { -- value consists of a single token
SELECT tokenKind FROM
tokenID => val м token;
tokenDECIMAL => val м NEW[INT м Convert.IntFromRope[token, 10]];
tokenOCTAL => val м NEW[INT м Convert.IntFromRope[token, 8]];
tokenHEX => val м NEW[INT м Convert.IntFromRope[token, 16]];
tokenREAL => val м NEW[REAL м Convert.RealFromRope[token]];
tokenROPE => val м Convert.RopeFromLiteral[token];
tokenCHAR => val м token;
tokenATOM => val м Convert.AtomFromRope[token];
ENDCASE => val м token;
}
ELSE { -- if there are multiple tokens, return the whole rope
val м r;
};
}
ELSE {
gtEntry м NARROW[tableEntry];
IF gtEntry.in=NIL THEN RETURN[r];
val м gtEntry.in[IO.RIS[rope: r, oldStream: scratchRIS]];
};
};

Register: PUBLIC PROC [key: ATOM, in: FileinProc, out: FileoutProc, copy: CopyProc] = {
gtEntry: GTEntry м NEW[GTEntryRep м [in, out, copy] ];
[] м RefTab.Store[gt, key, gtEntry]; -- overwrites earlier entries with same key
};
Init: PROC = {
bigRope: Rope.ROPE м "BeKindToYourWebFootedFriendsForADuckMayBeSomebodysMother";
gt м RefTab.Create[];
scratchRIS м IO.RIS[rope: bigRope];
scratchROS м IO.ROS[];
};

IdentityCopy: PUBLIC CopyProc = {
copy м val;
};

RegisterTestProcs: PROC = {
Register[$int, FileInInt, FileOutInt, IdentityCopy];
Register[$real, FileInReal, FileOutReal, IdentityCopy];
Register[$atom, FileInAtom, FileOutAtom, IdentityCopy];
};

FileInInt: FileinProc = {
ref: REF INT м NEW[INT];
refн м IO.GetInt[s];
val м ref;
};
FileOutInt: FileoutProc = {
ref: REF INT м NARROW[val];
s.Put1[ [integer[refн]] ];
};
FileInReal: FileinProc = {
ref: REF REAL м NEW[REAL];
refн м IO.GetReal[s];
val м ref;
};
FileOutReal: FileoutProc = {
ref: REF REAL м NARROW[val];
s.Put1[ [real[refн]] ];
};
FileInAtom: FileinProc = {
ref: ATOM м IO.GetAtom[s];
val м ref;
};
FileOutAtom: FileoutProc = {
ref: ATOM м NARROW[val];
s.Put1[ [atom[ref]] ];
};
FileInRope: FileinProc = {
ref: Rope.ROPE м IO.GetRope[s];
val м ref;
};
FileOutRope: FileoutProc = {
ref: Rope.ROPE м NARROW[val];
s.PutRope[ref];
};

GTEntry: TYPE = REF GTEntryRep;
GTEntryRep: TYPE = RECORD [in: FileinProc, out: FileoutProc, copy: CopyProc];
gt: RefTab.Ref;
scratchRIS: STREAM;
scratchROS: STREAM;

Init[];
RegisterTestProcs[];

END.
   (  
GGPropsImpl.mesa
Copyright ╙ 1989, 1992 by Xerox Corporation.  All rights reserved.
Contents:  General property mechanism for GG slices
Last edited by Pier on June 16, 1989 10:14:28 am PDT
Bier, July 17, 1989 5:09:16 pm PDT
Doug Wyatt, April 14, 1992 2:32 pm PDT

Add the given property to the children of slice described in parts.

Add the given property to the children of slice described in parts.

Get the property value matching key from the children of slice described in parts.  If the children have more than one value for this property, return one of the values and isUnique = FALSE

Remove the property value matching key from the children of slice described in parts.  If the children have more than one different value for this property, return isUnique = FALSE

For all properties of the children of slice described in parts, call the walkProc.  Returns aborted=TRUE and aborts the walk if any call to walkProc returned TRUE.

Remove all the properties of the children of slice described in parts
PROC [key: ATOM, val: REF] RETURNS [done: BOOL _ FALSE];
Returns a ROPE describing the property value and the encoding format of that ROPE.  Uses a single scratch stream, so needs to be an ENTRY PROC.  Returns r=NIL if cannot encode val.

Returns a property derived from the input ROPE.  Uses a single scratch stream, so needs to be an ENTRY PROC.  Returns r if cannot decode r.
A global table of [key, fileinProc, fileoutProc] entries is maintained.  Clients who wish to have their properties filed in and out are encouraged to register appropriate procs.

 Э╩Е  Ц(cedarcode) styleХNewlineDelimiter
Щ codeЪЬЩKЪЬ
╧eЬ7ЩBKЪ╧nЬ"╧kЬЩ3KЪЬ4Щ4KЩ"KЩ&KЩ ЧЪЯ	Ш	KЪЬ1ЯЬШNЧKШ ЪЮЬЯЬЯШKЪЯЬ ЯЬШ7KЪЯЬ
ЯШЧKШ KЪЯЬЯЬЯЬЯЬШKЪЬЯЬШKЪЬЯЬШ0KЪЬЯЬШ&KЪЬ
ЯЬШKШ KЪЬЯЬШ*KЪЬЯЬШ(KЪЬЯЬШ&KЪЬ
ЯЬШ"KЪЬЯЬШ$KШ Ъ
ЮЬЯЬЯЬ(ЯЬЯЬШKKЩCЪ
ЮЬЯЬЯЬЯЬЯЬШFKШ<KШЧKЪЯЬ2ЯЬ>ШvKЪЯЬ/Ш3KШKЩ ЧЪЮЬЯЬ<ШHKЩCЪ
ЮЬЯЬЯЬЯЬЯЬШFKШKШЧKЪЯЬ2ЯЬ>ШvKЪЯЬШKШKЩ ЧЪ╨bnЬЯЬ(ЯЬЯЬЯЬЯЬЯЬШkKЪЬ╕ЯЩ╜KЪЬЯЬЯЬШЪ
ЮЬЯЬЯЬЯЬЯЬШFKЪЬ	ЯЬ╧bЬ#╧cШMЪЯЬ	ЯЬЯЬв$Ш:KЪ
ЯЬЯЬЯЬЯЬЯЬШ*ЪЯЬШKЪЬвШ&KЪЬЯЬШKШЧKШЧKШKШ ЧЪЯЬ2ЯШ8KЪЬЯЬ-бЬШGЧKЪЯЬ"Ш&KШKЩ ЧЪЮЬЯЬ(ЯЬЯЬЯЬЯЬШaKЪЬпЯЩ┤KЪЬЯЬШ	KЪЬЯЬЯЬШЪ
ЮЬЯЬЯЬЯЬЯЬШFKЪЬ	ЯЬбЬ#вШMЪЯЬ	ЯЬЯЬШKЪЬ8вШNKЪ	ЯЬЯЬЯЬЯЬв$ШSЪЯЬШKЪЬвШ&KЪЬЯЬШKШЧKШЧKШKШ ЧЪЯЬ2ЯШ8KЪЬ1бЬШ=ЧKЪЯЬ*Ш.KШKЩ ЧЪЮЬЯЬЯЬЯЬЯЬЯЬЯЬШ?KЪЬЯЬШKЪЬШKЪЬЯЬЯЬШKШ KШ,ЪЯЬЯЬШKЪЬ
ЯЬШKЪЯЬЯЬЯЬШ#KЪЯЬШKШЧKЪЯЬШKШKШ ЧЪаЬЯЬЯЬ;ЯЬЯЬЯЬШoKЪЬdЯЬ6ЯЬЩгЪЮЬШKЪЯЬ
ЯЬШ#KШЧЪ
ЮЬЯЬЯЬЯЬЯЬШGKШ+KШKШ ЧЪЯЬ2ЯШ8KЪЬ6бЬ	ШCЧKЪЯЬ'Ш+KШKЩ ЧЪаЬЯЬЯЬ&Ш7KЪЬEЩEЪЮаЬЯЬЯЬЯЬЯЬШGKЪЬЯЬШKШKШ ЧЪЯЬ2ЯШ8KЪЬ1бЬ	Ш>ЧKЪЯЬЯЬШKШЧKШ ЪЮЬЯЬЯЬ>ЯЬШZЪЮ
ЬбШKЪЯЬЯЬЯЬЯЬЯЬЯЬЩ8KШ5KШЧKЪЬЯЬШKШ,KЪЬ$Ш$KШKШ ЧЪаЬЯЬЯЬЯЬЯЬЯЬЯЬ
ЯЬ ШeKЪЬ
ЯЬ?ЯЬ3ЯЬ+Щ┤KЪЯЬЯЬЯЬв$Ш;KЪЬЯЬЯЬШKЪЬЯЬШKЪЬШKШ,Ъ
ЯЬЯЬЯЬЯЬЯЬШ%ЪЯЬЯЬЯШKЪЬЯЬЯЬ Ш1KЪЬЯЬЯЬШ KЪ	ЬЯЬЯЬЯЬ6ЯЬШTKЪ	ЬЯЬЯЬЯЬ8ЯЬШXKЪ	ЬЯЬЯЬЯЬMЯЬШmKЪЬЯЬЯЬЯЬ$Ш<KЪЯЬЯЬЯЬШЧKШЧЪЯЬШKЪЬ
ЯЬШKЪЯЬЯЬЯЬЯЬЯЬв&ШKKХStartOfExpansion)[rope: ROPE, oldStream: STREAM _ NIL]ЪЬЯЬЯЬ в,ШcKЦ&[self: STREAM, close: BOOL _ TRUE]ЪЬЯЬ&ЯЬШ2KШЧKШKЩ ЧЪаЬЯЬЯ
ЬЯЬ
ЯЬЯЬЯЬШLKЪЬaЯЬ%ЩЛKЪЯЬЯЬЯЬв$Ш;KЪЬЯЬЯЬШKЪЬЯЬШKЪЬШKШ,ЪЯЬЯЬЯЬЯЬЯЬЯШ%KЪЬЯЬШKЪЬЯЬШKЪЬЯЬШKЪЬ	ЯЬЯЬШKЪ	ЬЯЬЯЬЯЬЯЬ!Ш6KШ ЪЬ#ЯЬШ9KЪЬЯЬ%ЯЬЯЬШ;ЧKЪЯЬЯЬ	ЯЬЯЬШЦ[self: STREAM]ЪЯЬЯЬ
ЯЬв#Ш9ЪЯЬЯШKШKЪЬЯЬЯЬ#Ш@KЪЬЯЬЯЬ"Ш=KЪЬЯЬЯЬ#Ш<KЪЬЯЬЯЬ Ш;KШ2KШKШ/KЪЯЬШЧKШЧЪЯЬв6Ш=KШKШЧKШЧЪЯЬШKЪЬ
ЯЬШKЪЯЬЯЬЯЬЯЬШ!KЦ)[rope: ROPE, oldStream: STREAM _ NIL]ЪЬЯЬЯЬ"Ш9KШЧKШЧKШ ЪаЬЯЬЯЬ7ШWKЪЬ▒Щ▒KЪЬЯЬ Ш6KЪЬ%в+ШPKШЧKЩ ЪЮЬЯЬШKЪЬЯЬ>ШPKШKЦ)[rope: ROPE, oldStream: STREAM _ NIL]ЪЬЯЬЯЬШ#KЦ[oldStream: STREAM _ NIL]ЪЬЯЬЯЬШKШKШ ЧЪЮЬЯЬШ!KШKШKШ ЧЪЮЬЯЬШKШ4KШ7KШ7KШKШ ЧЪЮ	ЬШKЪ	ЬЯЬЯЬЯЬЯЬШKЦ[stream: STREAM]ЪЬЯЬШKШ
KЪЬШЧЪЮ╨ntЬШKЪЬЯЬЯЬЯЬШKШKЪЬШЧЪЮгЬШKЪ	ЬЯЬЯЬЯЬЯЬШKЦ[stream: STREAM]ЪЬЯЬШKШ
KЪЬШЧЪЮгЬШKЪЬЯЬЯЬЯЬШKШKЪЬШЧЪЮгЬШKЦ[stream: STREAM]ЪЬЯЬЯЬШKШ
KЪЬШЧЪЮгЬШKЪЬЯЬЯЬШKШKЪЬШЧЪЮгЬШKЦ[stream: STREAM]ЪЬ
ЯЬЯЬШKШ
KЪЬШЧЪЮгЬШKЪЬ
ЯЬЯЬШKЪЬШKЪЬШЧKШ KЪЬ	ЯЬЯЬШKЪЬЯЬЯЬ4ШMKШKЪЬЯЬШKЪЬЯЬШKШ KШKШKШ KЪЯЬШЧ ЕЧ    x  1%  