DIRECTORY
CDProperties,
CD,
CDPrivate,
Atom,
RefTab,
Rope,
TokenIO;

CDPropertiesImpl: CEDAR MONITOR 
IMPORTS CD, CDPrivate, CDProperties, Atom, RefTab, TokenIO 
EXPORTS CDProperties =
BEGIN

Properties: TYPE = CD.Properties;
PropertyProcs: TYPE = CDProperties.PropertyProcs;
PropertyProcsRec: TYPE = CDProperties.PropertyProcsRec;

atomTab: RefTab.Ref = RefTab.Create[]; -- contains atoms [maybe in future ref's] where properties hang


propertyNameTab: RefTab.Ref = RefTab.Create[]; -- key: propertynames; value: PropertyProcs
registrationTab: RefTab.Ref = RefTab.Create[]; -- contains registrationKeys

RegisterProperty: PUBLIC ENTRY PROC [prop: REF, registrationKey: REF_NIL] RETURNS [first: BOOLEAN_TRUE] =
BEGIN
val: RefTab.Val;
found: BOOL;
[found, val] _ RefTab.Fetch[x: registrationTab, key: prop];  -- returns a registration key
IF found THEN {
IF registrationKey#NIL AND registrationKey=val THEN RETURN [FALSE];
RETURN WITH ERROR CD.Error[doubleRegistration]
}
ELSE {
pp: PropertyProcs _ NEW[PropertyProcsRec];
[] _ RefTab.Insert[propertyNameTab, prop, pp]; -- procs
[] _ RefTab.Insert[registrationTab, prop, registrationKey]; -- registration
};
END;



HasNoCDProperties: ERROR = CODE;

PutProp: PUBLIC PROC [onto: REF, prop: REF, val: REF] =
BEGIN
WITH onto SELECT FROM
a: CD.ApplicationPtr => PutPropOnApplication[a, prop, val];
d: CD.Design => PutPropOnDesign[d, prop, val];
t: CD.Technology => PutPropOnTechnology[t, prop, val];
--l: CD.LevelRef => PutPropOnLevelRef[l, prop, val];
at: ATOM => PutPropOnAtom[at, prop, val];
ENDCASE => ERROR HasNoCDProperties
END;

GetProp: PUBLIC PROC [from: REF, prop: REF] RETURNS [REF] =
BEGIN
RETURN [WITH from SELECT FROM
a: CD.ApplicationPtr => CDProperties.GetPropFromList[a.properties, prop],
o: CD.ObPtr => CDProperties.GetPropFromList[o.properties, prop],
d: CD.Design => CDProperties.GetPropFromList[d.properties, prop],
t: CD.Technology => CDProperties.GetPropFromList[t.properties, prop],
--l: CD.LevelRef => CDProperties.GetPropFromList[l.properties, prop],
at: ATOM => GetPropFromAtom[at, prop],
ENDCASE => ERROR HasNoCDProperties]
END;


PutPropOnObject: PUBLIC ENTRY PROC [onto: CD.ObPtr, prop: REF, val: REF] =
BEGIN
IF val#NIL THEN onto.properties _ Atom.PutPropOnList[onto.properties, prop, val]
ELSE onto.properties _ Atom.RemPropFromList[onto.properties, prop]
END;

PutPropOnApplication: PUBLIC ENTRY PROC[onto: CD.ApplicationPtr, prop: REF, val: REF] =
BEGIN
IF val#NIL THEN onto.properties _ Atom.PutPropOnList[onto.properties, prop, val]
ELSE onto.properties _ Atom.RemPropFromList[onto.properties, prop]
END;

PutPropOnDesign: PUBLIC ENTRY PROC [onto: CD.Design, prop: REF, val: REF] =
BEGIN
IF val#NIL THEN onto.properties _ Atom.PutPropOnList[onto.properties, prop, val]
ELSE onto.properties _ Atom.RemPropFromList[onto.properties, prop]
END;

PutPropOnTechnology: PUBLIC ENTRY PROC[onto: CD.Technology, prop: REF, val: REF] =
BEGIN
IF val#NIL THEN onto.properties _ Atom.PutPropOnList[onto.properties, prop, val]
ELSE onto.properties _ Atom.RemPropFromList[onto.properties, prop]
END;

PutPropOnAtom: PUBLIC PROC[onto: ATOM, prop: REF, val: REF] =
{PutPropOnRef[onto: onto, prop: prop, val: val]};

PutPropOnLevel: PUBLIC ENTRY PROC[onto: CD.Level, prop: REF, val: REF] =
BEGIN
CDPrivate.levels[onto].properties _ 
IF val#NIL THEN Atom.PutPropOnList[CDPrivate.levels[onto].properties, prop, val]
ELSE Atom.RemPropFromList[CDPrivate.levels[onto].properties, prop];
END;

PutPropOnRef: ENTRY PROC[onto: REF, prop: REF, val: REF] =
BEGIN
x: REF;
found: BOOL;
pp: REF CD.Properties;
[found, x] _ RefTab.Fetch[x: atomTab, key: onto];
IF found THEN pp _ NARROW[x, REF CD.Properties]
ELSE {
IF prop=NIL THEN RETURN;
pp _ NEW[CD.Properties_NIL];
[] _ RefTab.Store[x: atomTab, key: onto, val: pp];
};
IF prop#NIL THEN pp^ _ Atom.PutPropOnList[propList: pp^, prop: prop, val: val]
ELSE {
pp^ _ Atom.RemPropFromList[propList: pp^, prop: prop];
IF pp^=NIL THEN [] _ RefTab.Delete[x: atomTab, key: onto]
}
END;

GetPropFromRef: ENTRY PROC [from: REF, prop: REF] RETURNS [REF] =
INLINE BEGIN
x: REF;
found: BOOL;
pp: REF CD.Properties;
[found, x] _ RefTab.Fetch[x: atomTab, key: from];
IF NOT found THEN RETURN[NIL];
pp _ NARROW[x, REF CD.Properties];
RETURN[Atom.GetPropFromList[propList: pp^, prop: prop]]
END;

GetPropFromObject: PUBLIC PROC [from: CD.ObPtr, prop: REF] RETURNS [REF] =
{RETURN[CDProperties.GetPropFromList[from.properties, prop]]};

GetPropFromApplication: PUBLIC PROC [from: CD.ApplicationPtr, prop: REF] RETURNS [REF] =
{RETURN[CDProperties.GetPropFromList[from.properties, prop]]};

GetPropFromDesign: PUBLIC PROC [from: CD.Design, prop: REF] RETURNS [REF] =
{RETURN[CDProperties.GetPropFromList[from.properties, prop]]};

GetPropFromTechnology: PUBLIC PROC [from: CD.Technology, prop: REF] RETURNS [REF] =
{RETURN[CDProperties.GetPropFromList[from.properties, prop]]};

GetPropFromLevel: PUBLIC PROC [from: CD.Level, prop: REF] RETURNS [REF] =
{RETURN[CDProperties.GetPropFromList[CDPrivate.levels[from].properties, prop]]};

GetPropFromAtom: PUBLIC PROC [from: ATOM, prop: REF] RETURNS [REF] =
{RETURN[GetPropFromRef[from: from, prop: prop]]};


InstallProcs: PUBLIC ENTRY PROC [prop: REF, new: PropertyProcsRec] =
BEGIN
p: PropertyProcs _ FetchProcs[prop];
IF p#NIL THEN
BEGIN
IF new.exclusive THEN p.exclusive_TRUE;
IF new.makeCopy#NIL THEN p.makeCopy _ new.makeCopy;
IF new.internalWrite#NIL THEN p.internalWrite _ new.internalWrite;
IF new.internalRead#NIL THEN p.internalRead _ new.internalRead;
IF new.ownersData#NIL THEN p.ownersData _ new.ownersData;
END
END;

FetchProcs: PUBLIC PROC [prop: REF] RETURNS [PropertyProcs] =
BEGIN
x: REF;
found: BOOL;
[found: found, val: x] _ RefTab.Fetch[propertyNameTab, prop];
IF found THEN RETURN [NARROW[x, PropertyProcs]] ELSE RETURN [NIL] 
END;

CopyVal: PUBLIC PROC [prop: REF, val: REF] RETURNS [valCopy: REF] =
{valCopy _ val};

DontCopy: PUBLIC PROC [prop: REF, val: REF] RETURNS [nil: REF] =
{nil _ NIL};

CopyProps: PUBLIC PROC [propList: Properties] RETURNS [copy: Properties_NIL] =
BEGIN
p: CDProperties.PropertyProcs;
FOR l: Properties _ propList, l.rest WHILE l#NIL DO
p _ FetchProcs[l.first.key];
IF p#NIL AND p.makeCopy#NIL THEN {
copy _ Atom.PutPropOnList[
propList: copy, 
prop: l.first.key,
val: p.makeCopy[prop: l.first.key, val: l.first.val]
];
}
ELSE IF ISTYPE[l.first.key, ATOM] THEN 
WITH l.first.val SELECT FROM
r: Rope.ROPE => {
copy _ Atom.PutPropOnList[
propList: copy, 
prop: l.first.key,
val: r
];
};
at: ATOM => {
copy _ Atom.PutPropOnList[
propList: copy, 
prop: l.first.key,
val: at
];
}
ENDCASE => NULL; 
ENDLOOP;
END;

RopePWrite: PUBLIC PROC [prop: REF, val: REF] =
BEGIN
WITH val SELECT FROM
r: Rope.ROPE => TokenIO.WriteRope[r];
at: ATOM => TokenIO.WriteRope[Atom.GetPName[at]];
ENDCASE => TokenIO.WriteRope["bad property value"];
END;

AtomPWrite: PUBLIC PROC [prop: REF, val: REF] =
BEGIN
WITH val SELECT FROM
at: ATOM => TokenIO.WriteAtom[at];
r: Rope.ROPE => TokenIO.WriteAtom[Atom.MakeAtom[r]];
ENDCASE => TokenIO.WriteAtom[$Bad];
END;

IntPWrite: PUBLIC PROC [prop: REF, val: REF] =
BEGIN
WITH val SELECT FROM
ri: REF INT => TokenIO.WriteInt[ri^];
rc: REF CARDINAL => TokenIO.WriteInt[rc^];
rn: REF NAT => TokenIO.WriteInt[rn^];
ENDCASE => TokenIO.WriteInt[0];
END;

SomePWrite: PUBLIC PROC [prop: REF, val: REF] =
BEGIN
WITH val SELECT FROM
at: ATOM => TokenIO.WriteAtom[at];
r: Rope.ROPE => TokenIO.WriteRope[r];
ri: REF INT => TokenIO.WriteInt[ri^];
rc: REF CARDINAL => TokenIO.WriteInt[rc^];
rn: REF NAT => TokenIO.WriteInt[rn^];
ENDCASE => TokenIO.WriteAtom[$Unknown];
END;

RopePRead: PUBLIC PROC [prop: ATOM] RETURNS [val: REF] =
BEGIN
val _ TokenIO.ReadRope[]
END;

AtomPRead: PUBLIC PROC [prop: ATOM] RETURNS [val: REF] =
BEGIN
val _ TokenIO.ReadAtom[]
END;

IntPRead: PUBLIC PROC [prop: ATOM] RETURNS [val: REF] =
BEGIN
val _ NEW[INT_TokenIO.ReadInt[]]
END;

SomePRead: PUBLIC PROC [prop: ATOM] RETURNS [val: REF] =
BEGIN
t: TokenIO.Token _ TokenIO.ReadToken[];
SELECT t.kind FROM
atom, int, rope => val _ t.ref;
ENDCASE => val _ $Error;
END;

[] _ CDProperties.RegisterProperty[$SignalName];
[] _  CDProperties.RegisterProperty[$InstanceName];
CDProperties.InstallProcs[prop: $SignalName, new: 
CDProperties.PropertyProcsRec[
makeCopy: CDProperties.CopyVal,
internalWrite: CDProperties.RopePWrite,
internalRead: CDProperties.RopePRead
]];
CDProperties.InstallProcs[prop: $InstanceName, new: 
CDProperties.PropertyProcsRec[
makeCopy: CDProperties.CopyVal,
internalWrite: CDProperties.RopePWrite,
internalRead: CDProperties.RopePRead
]];
END.


ZCDPropertiesImpl.mesa   a Chipndale module
by Ch. Jacobi   September 27, 1983 2:06 pm
last edited Christian Jacobi   February 14, 1984 1:28 pm
--Registration
--registers "prop" in a table; any program which wants to use an ATOM 
--as a "prop" gets to know if it is already in use. 
--Usage
--a NIL val removes the property
--considered bad: o: CD.ObPtr => PutPropOnObject[o, prop, val];
--NIL if prop is not found
--speed ups  
--a NIL val removes the property
--a NIL val removes the property
--a NIL val removes the property
--a NIL val removes the property
--a NIL val removes the property
--a NIL val removes the property
--a NIL val removes the property
--here onto MUST NOT be a Chipndale ref pointing to a record with properties,
--since then the properties must be used, not the hash table
--NIL if prop is not found
--here from MUST NOT be a Chipndale ref pointing to a record with properties,
--since then the properties must be used, not the hash table
--NIL if prop is not found
--NIL if prop is not found
--NIL if prop is not found
--NIL if prop is not found
--NIL if prop is not found
--NIL if prop is not found
--property procedures
--prop must be registered and yours
--overwrites values for which new has non NIL entries
--never copy PropertyProcs^; it can be extended by future calls of InstallProcs
-------------
--now register some properties
�Ê
y˜Jš
œ*™*Jš
œ*™*Jš
œ8™8J˜š
Ïk	˜	J˜
Jš�œ
˜J˜
J˜J˜J˜Jš
œ˜J˜—šÏnœ�œ
�œ
˜ Jš�œ4˜;Jš�œ˜—Jš
�˜J˜Jšœ�œ�œ˜!Jšœ�œ˜1Jšœ�œ!˜7J˜Jšœ'Ïc?˜fJ˜Jš
œ™J˜Jšœ/Ÿ+˜ZJšœ/Ÿ˜KJ˜šžœ�œ
�
œ�œ�œ
�œ�œ	�œ˜iJš
œF™FJš
œ4™4Jš
�˜Jš
œ˜Jšœ�œ
˜Jšœ=Ÿ˜Zš�œ�œ˜Jš�œ�œ
�œ�œ
�œ�œ˜CJš�œ
�œ
�œ
�œ˜.J˜
—š�œ˜Jšœ�œ˜*Jšœ/Ÿ˜7Jšœ<Ÿ˜KJ˜—Jš�œ
˜J˜J˜—Jš
œ™J˜Jšœ�œ�œ
˜ J˜šžœ�œ
�œ�œ�œ�œ˜7Jš
œ ™ Jš
�˜š�œ�œ
�˜Jšœ�œ6˜;Jš
œ?™?Jšœ�œ)˜.Jšœ�œ1˜6Jšœ�œ-˜4Jš
œ)˜)Jš�œ�œ˜"—Jš�œ
˜J˜—šžœ�œ
�œ�œ�œ�œ�œ˜;Jš
œ™Jš
�˜š�œ�œ�œ
�˜Jšœ�œD˜IJšœ�œ;˜@Jšœ�œ<˜AJšœ�œ@˜EJšœ�œ>˜EJš
œ&˜&Jš�œ�œ˜#—Jš�œ
˜J˜—Jš
œ
™
J˜šžœ�œ
�œ
�œ�œ�œ�œ˜JJš
œ ™ Jš
�˜Jš�œ�œ
�œA˜PJš�œ>˜BJš�œ
˜J˜—šžœ�œ
�œ
�œ�œ�œ�œ˜WJš
œ ™ Jš
�˜Jš�œ�œ
�œA˜PJš�œ>˜BJš�œ
˜J˜—šžœ�œ
�œ
�œ�œ�œ�œ˜KJš
œ ™ Jš
�˜Jš�œ�œ
�œA˜PJš�œ>˜BJš�œ
˜J˜—šžœ�œ
�œ
�œ�œ�œ�œ˜RJš
œ ™ Jš
�˜Jš�œ�œ
�œA˜PJš�œ>˜BJš�œ
˜J˜—šž
œ�œ
�œ�œ�œ�œ˜=Jš
œ ™ Jš
œ1˜1J˜—šžœ�œ
�œ
�œ�œ�œ�œ˜HJš
œ ™ Jš
�˜š
œ$˜$Jš�œ�œ
�œA˜PJš�œ?˜C—Jš�œ
˜J˜—šžœ�œ
�œ�œ�œ�œ˜:Jš
œ ™ Jš
œM™MJš
œ<™<Jš
�˜Jšœ�œ
˜Jšœ�œ
˜Jšœ�œ
�œ˜Jš
œ1˜1Jš
�œ�œ�œ�œ
�œ˜/š�œ˜Jš�œ�œ
�œ
�œ
˜Jšœ�œ
�œ�œ˜Jš
œ2˜2J˜—Jš�œ�œ
�œ>˜Nš�œ˜Jš
œ6˜6Jš�œ�œ
�œ*˜9Jš
œ
˜
—Jš�œ
˜J˜—šžœ�
œ�œ�œ�œ�œ˜AJš
œ™Jš
œM™MJš
œ<™<Jš
�˜Jšœ�œ
˜Jšœ�œ
˜Jšœ�œ
�œ˜Jš
œ1˜1Jš
�œ
�œ�œ
�œ
�œ˜Jšœ�œ�œ
�œ
˜"Jš�œ1˜7Jš�œ
˜J˜—šžœ�œ
�œ�œ�œ�œ�œ˜JJš
œ™Jšœ
�œ7˜>J˜—šžœ�œ
�œ�œ�œ�œ�œ˜XJš
œ™Jšœ
�œ7˜>J˜—šžœ�œ
�œ�œ�œ�œ�œ˜KJš
œ™Jšœ
�œ7˜>J˜—šžœ�œ
�œ�œ�œ�œ�œ˜SJš
œ™Jšœ
�œ7˜>—J˜šžœ�œ
�œ�œ�œ�œ�œ˜IJš
œ™Jšœ
�œI˜PJ˜—šžœ�œ
�œ�œ�œ�œ�œ˜DJš
œ™Jšœ
�œ*˜1—J˜Jš
œ™J˜š
žœ�œ
�œ
�œ�œ˜DJš
œ#™#Jš
œ5™5Jš
�˜J˜$š�œ�œ
�˜
Jš
�˜Jš�œ�œ
�œ
˜'Jš�œ�œ
�œ˜3Jš�œ�œ
�œ%˜BJš�œ�œ
�œ#˜?Jš�œ�œ
�œ˜9Jš
�˜—Jš�œ
˜J˜—š
ž
œ�œ
�œ�œ�œ˜=Jš
œO™OJš
�˜Jšœ�œ
˜Jšœ�œ
˜J˜=Jš�œ�œ
�œ�œ�œ
�œ�œ˜BJš�œ
˜J˜—šžœ�œ
�œ�œ�œ�œ�œ˜CJ˜J˜—šžœ�œ
�œ�œ�œ�œ�œ˜@Jšœ�œ˜J˜—š
ž	œ�œ
�œ�œ�œ˜NJš
�˜J˜š�œ"�œ�œ
�˜3Jš
œ˜š
�œ�œ
�œ�œ
�œ˜"˜J˜J˜J˜4J˜—J˜
—š
�œ
�œ
�œ�œ�œ
˜'š�œ
�œ
�˜šœ�œ˜˜J˜J˜J˜J˜—J˜—šœ�œ˜
˜J˜J˜Jš
œ˜J˜—J˜
—Jš�œ�œ˜——Jš�œ
˜—Jš�œ
˜J˜—šÏb
œ�œ�œ�œ˜/Jš
�˜š�œ�œ
�˜Jšœ�œ˜%Jšœ�œ)˜1Jš�œ,˜3—Jš�œ
˜J˜—š 
œ�œ�œ�œ˜/Jš
�˜š�œ�œ
�˜Jšœ�œ˜"Jšœ�œ(˜4Jš�œ˜#—Jš�œ
˜J˜—š
Ðbn	œ�œ
�œ�œ�œ˜.Jš
�˜š�œ�œ
�˜Jšœ�œ
�œ˜%Jšœ�œ
�œ˜*Jšœ�œ
�œ˜%Jš�œ˜—Jš�œ
˜J˜—š
¡
œ�œ
�œ�œ�œ˜/Jš
�˜š�œ�œ
�˜Jšœ�œ˜"Jšœ�œ˜%Jšœ�œ
�œ˜%Jšœ�œ
�œ˜*Jšœ�œ
�œ˜%Jš�œ ˜'—Jš�œ
˜J˜—š
 	œ�œ�œ�œ�œ˜8Jš
�˜J˜Jš�œ
˜J˜—š
 	œ�œ�œ�œ�œ˜8Jš
�˜J˜Jš�œ
˜J˜—š¡œ�œ
�œ�œ�œ�œ˜7Jš
�˜Jšœ�œ
�œ˜ Jš�œ
˜J˜—š¡	œ�œ
�œ�œ�œ�œ˜8Jš
�˜Jš
œ'˜'š�œ�˜Jš
œ˜Jš�œ˜—Jš�œ
˜J˜—Jš
œ
™
Jš
œ™Jš
œ0˜0Jš
œ3˜3š
œ2˜2š
œ˜Jš
œ˜Jš
œ'˜'Jš
œ$˜$Jš
œ˜——š
œ4˜4š
œ˜Jš
œ˜Jš
œ'˜'Jš
œ$˜$Jš
œ˜——Jš�œ
˜J˜J˜—…—!V4)