CDPropertiesImpl.mesa a Chipndale module
by Ch. Jacobi September 27, 1983 2:06 pm
last edited Christian Jacobi February 14, 1984 1:28 pm
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
--Registration
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] =
--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.
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;
--Usage
HasNoCDProperties: ERROR = CODE;
PutProp:
PUBLIC
PROC [onto:
REF, prop:
REF, val:
REF] =
--a NIL val removes the property
BEGIN
WITH onto
SELECT
FROM
a: CD.ApplicationPtr => PutPropOnApplication[a, prop, val];
--considered bad: o: CD.ObPtr => PutPropOnObject[o, 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] =
--NIL if prop is not found
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;
--speed ups
PutPropOnObject:
PUBLIC
ENTRY
PROC [onto:
CD.ObPtr, prop:
REF, val:
REF] =
--a NIL val removes the property
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] =
--a NIL val removes the property
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] =
--a NIL val removes the property
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] =
--a NIL val removes the property
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] =
--a NIL val removes the property
{PutPropOnRef[onto: onto, prop: prop, val: val]};
PutPropOnLevel:
PUBLIC
ENTRY
PROC[onto:
CD.Level, prop:
REF, val:
REF] =
--a NIL val removes the property
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] =
--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
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] =
--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
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] =
--NIL if prop is not found
{RETURN[CDProperties.GetPropFromList[from.properties, prop]]};
GetPropFromApplication:
PUBLIC
PROC [from:
CD.ApplicationPtr, prop:
REF]
RETURNS [
REF] =
--NIL if prop is not found
{RETURN[CDProperties.GetPropFromList[from.properties, prop]]};
GetPropFromDesign:
PUBLIC
PROC [from:
CD.Design, prop:
REF]
RETURNS [
REF] =
--NIL if prop is not found
{RETURN[CDProperties.GetPropFromList[from.properties, prop]]};
GetPropFromTechnology:
PUBLIC
PROC [from:
CD.Technology, prop:
REF]
RETURNS [
REF] =
--NIL if prop is not found
{RETURN[CDProperties.GetPropFromList[from.properties, prop]]};
GetPropFromLevel:
PUBLIC
PROC [from:
CD.Level, prop:
REF]
RETURNS [
REF] =
--NIL if prop is not found
{RETURN[CDProperties.GetPropFromList[CDPrivate.levels[from].properties, prop]]};
GetPropFromAtom:
PUBLIC
PROC [from:
ATOM, prop:
REF]
RETURNS [
REF] =
--NIL if prop is not found
{RETURN[GetPropFromRef[from: from, prop: prop]]};
--property procedures
InstallProcs:
PUBLIC
ENTRY
PROC [prop:
REF, new: PropertyProcsRec] =
--prop must be registered and yours
--overwrites values for which new has non NIL entries
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] =
--never copy PropertyProcs^; it can be extended by future calls of InstallProcs
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;
-------------
--now register some properties
[] ← 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.