CDPropertiesImpl.mesa a ChipNDale module
Copyright © 1983, 1985 by Xerox Corporation. All rights reserved.
by Ch. Jacobi, September 27, 1983 2:06 pm
last edited Christian Jacobi, September 16, 1985 5:38:10 pm PDT
DIRECTORY
CDProperties,
CD,
CDPrivate,
Atom,
RefTab,
Rope,
TokenIO,
ViewerTools USING [TiogaContents, TiogaContentsRec];
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];
pp.key ← prop;
[] ← 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.Instance => PutPropOnInstance[a, prop, val];
o:
CD.Object =>
IF o.class.inDirectory THEN PutPropOnObject[o, prop, val]
ELSE ERROR HasNoCDProperties;
d: CD.Design => PutPropOnDesign[d, prop, val];
t: CD.Technology => PutPropOnTechnology[t, prop, val];
--l: CD.LayerRef => PutPropOnLayerRef[l, prop, val];
at: ATOM => PutPropOnAtom[at, prop, val];
class: REF CD.ObjectClass => PutPropOnClass[class, 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.Instance => CDProperties.GetPropFromList[a.properties, prop],
o: CD.Object => CDProperties.GetPropFromList[o.properties, prop],
d: CD.Design => CDProperties.GetPropFromList[d.properties, prop],
t: CD.Technology => CDProperties.GetPropFromList[t.properties, prop],
--l: CD.LayerRef => CDProperties.GetPropFromList[l.properties, prop],
at: ATOM => GetPropFromAtom[at, prop],
class: REF CD.ObjectClass => CDProperties.GetPropFromList[class.properties, prop],
ENDCASE => ERROR HasNoCDProperties]
END;
--speed ups
PutPropOnObject:
PUBLIC
ENTRY
PROC [onto:
CD.Object, prop:
REF, val:
REF] =
--a NIL val removes the property
BEGIN
ENABLE UNWIND => NULL;
IF val#NIL THEN onto.properties ← Atom.PutPropOnList[onto.properties, prop, val]
ELSE onto.properties ← Atom.RemPropFromList[onto.properties, prop]
END;
PutPropOnInstance:
PUBLIC
ENTRY
PROC[onto:
CD.Instance, prop:
REF, val:
REF] =
--a NIL val removes the property
BEGIN
ENABLE UNWIND => NULL;
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
ENABLE UNWIND => NULL;
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
ENABLE UNWIND => NULL;
IF val#NIL THEN onto.properties ← Atom.PutPropOnList[onto.properties, prop, val]
ELSE onto.properties ← Atom.RemPropFromList[onto.properties, prop]
END;
PutPropOnClass:
PUBLIC
ENTRY
PROC[onto:
REF
CD.ObjectClass, prop:
REF, val:
REF] =
--a NIL val removes the property
BEGIN
ENABLE UNWIND => NULL;
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]};
PutPropOnLayer:
PUBLIC
ENTRY
PROC[onto:
CD.Layer, prop:
REF, val:
REF] =
--a NIL val removes the property
BEGIN
ENABLE UNWIND => NULL;
CDPrivate.layers[onto].properties ←
IF val#NIL THEN Atom.PutPropOnList[CDPrivate.layers[onto].properties, prop, val]
ELSE Atom.RemPropFromList[CDPrivate.layers[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.Object, prop:
REF]
RETURNS [
REF] =
--NIL if prop is not found
BEGIN
ENABLE UNWIND => NULL;
RETURN[CDProperties.GetPropFromList[from.properties, prop]]
END;
GetPropFromInstance:
PUBLIC
PROC [from:
CD.Instance, prop:
REF]
RETURNS [
REF] =
--NIL if prop is not found
BEGIN
ENABLE UNWIND => NULL;
RETURN[CDProperties.GetPropFromList[from.properties, prop]]
END;
GetPropFromDesign:
PUBLIC
PROC [from:
CD.Design, prop:
REF]
RETURNS [
REF] =
--NIL if prop is not found
BEGIN
ENABLE UNWIND => NULL;
RETURN[CDProperties.GetPropFromList[from.properties, prop]]
END;
GetPropFromTechnology:
PUBLIC
PROC [from:
CD.Technology, prop:
REF]
RETURNS [
REF] =
--NIL if prop is not found
BEGIN
ENABLE UNWIND => NULL;
RETURN[CDProperties.GetPropFromList[from.properties, prop]]
END;
GetPropFromLayer:
PUBLIC
PROC [from:
CD.Layer, prop:
REF]
RETURNS [
REF] =
--NIL if prop is not found
BEGIN
ENABLE UNWIND => NULL;
RETURN[CDProperties.GetPropFromList[CDPrivate.layers[from].properties, prop]]
END;
GetPropFromAtom:
PUBLIC
PROC [from:
ATOM, prop:
REF]
RETURNS [
REF] =
--NIL if prop is not found
BEGIN
RETURN[GetPropFromRef[from: from, prop: prop]];
END;
--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
class: PropertyProcs ← FetchProcs[prop];
IF class#
NIL
THEN {
IF new.exclusive THEN class.exclusive←TRUE;
IF new.makeCopy#NIL THEN class.makeCopy ← new.makeCopy;
IF new.internalWrite#NIL THEN class.internalWrite ← new.internalWrite;
IF new.internalRead#NIL THEN class.internalRead ← new.internalRead;
FOR l: Properties ← new.properties, l.rest
WHILE l#
NIL
DO
class.properties ←
(IF l.first.val#
NIL
THEN Atom.PutPropOnList[class.properties, l.first.key, l.first.val]
ELSE Atom.RemPropFromList[class.properties, l.first.key]);
ENDLOOP;
}
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, purpose:
REF]
RETURNS [valCopy:
REF] =
BEGIN
valCopy ← val;
END;
DontCopy:
PUBLIC
PROC [prop:
REF, val:
REF, purpose:
REF]
RETURNS [nil:
REF←
NIL] =
BEGIN
END;
CopyProps:
PUBLIC
PROC [propList: Properties, purpose:
REF]
RETURNS [copy: Properties←
NIL] =
BEGIN
FOR l: Properties ← propList, l.rest
WHILE l#
NIL
DO
copy ← CopyItem[copy, l.first, purpose]
ENDLOOP;
END;
CopyItem:
PROC[list: CDProperties.Properties, item: Atom.DottedPair, purpose:
REF]
RETURNS [newList: CDProperties.Properties] =
BEGIN
class: CDProperties.PropertyProcs = FetchProcs[item.key];
IF class#
NIL
AND class.makeCopy#
NIL
THEN {
newVal: REF = class.makeCopy[prop: item.key, val: item.val, purpose: purpose];
IF newVal=NIL THEN newList ← list
ELSE
newList ← Atom.PutPropOnList[
propList: list,
prop: item.key,
val: newVal
];
}
ELSE
IF
ISTYPE[item.key,
ATOM]
AND item.val#
NIL
THEN
WITH item.val
SELECT
FROM
r: Rope.
ROPE => {
newList ← Atom.PutPropOnList[
propList: list,
prop: item.key,
val: r
];
};
at:
ATOM => {
newList ← Atom.PutPropOnList[
propList: list,
prop: item.key,
val: at
];
};
pl:
CD.Properties => {
newList ← Atom.PutPropOnList[
propList: list,
prop: item.key,
val: CopyProps[pl, purpose]
];
};
ri:
REF
INT => {
newList ← Atom.PutPropOnList[
propList: list,
prop: item.key,
val: NEW[INT←ri^]
];
};
ENDCASE => newList ← list
ELSE newList ← list;
END;
AppendProps:
PUBLIC
PROC [winner, looser: CDProperties.Properties
, purpose:
REF]
RETURNS [copy: CDProperties.Properties] =
BEGIN
copy ← CopyProps[looser, purpose];
FOR l: Properties ← winner, l.rest
WHILE l#
NIL
DO
copy ← CopyItem[copy, l.first, purpose]
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 some special properties
TiogaPCopy:
PROC [prop:
REF, val:
REF, purpose:
REF]
RETURNS [copy:
REF] =
BEGIN
contents: Rope.ROPE ← NIL;
formatting: Rope.ROPE ← NIL;
WITH val
SELECT
FROM
t: ViewerTools.TiogaContents => {
contents ← t.contents;
formatting ← t.formatting};
r: Rope.ROPE => contents ← r;
ENDCASE => contents ← "$Error";
copy ← NEW[ViewerTools.TiogaContentsRec←[contents: contents, formatting: formatting]]
END;
TiogaPWrite:
PROC [prop:
REF, val:
REF] =
BEGIN
contents: Rope.ROPE ← NIL;
formatting: Rope.ROPE ← NIL;
WITH val
SELECT
FROM
t: ViewerTools.TiogaContents => {
contents ← t.contents;
formatting ← t.formatting};
r: Rope.ROPE => contents ← r;
ENDCASE => NULL;
TokenIO.WriteRope[contents];
TokenIO.WriteRope[formatting];
END;
TiogaPRead:
PROC [prop:
ATOM]
RETURNS [val:
REF] =
BEGIN
contents: Rope.ROPE ← TokenIO.ReadRope[];
formatting: Rope.ROPE ← TokenIO.ReadRope[];
val ← NEW[ViewerTools.TiogaContentsRec←[contents: contents, formatting: formatting]]
END;
[] ← CDProperties.RegisterProperty[$SignalName];
[] ← CDProperties.RegisterProperty[$InstanceName];
[] ← CDProperties.RegisterProperty[$Tioga];
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
]];
CDProperties.InstallProcs[prop: $Tioga, new:
CDProperties.PropertyProcsRec[
makeCopy: TiogaPCopy,
internalWrite: TiogaPWrite,
internalRead: TiogaPRead
]];
END.