CDCoreImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
by Christian Jacobi, August 14, 1985 2:35:33 pm PDT
Last Edited by Christian Jacobi, October 4, 1985 4:40:21 pm PDT
DIRECTORY
Atom,
CD,
CDCore,
CDDirectory,
CDEvents,
CDProperties,
Core,
CoreProperties,
RefTab,
Rope;
CDCoreImpl: CEDAR MONITOR
IMPORTS Atom, CD, CDDirectory, CDEvents, CDProperties, CoreProperties, RefTab
EXPORTS CDCore =
BEGIN
Problem: PUBLIC SIGNAL [messagetype: CDCore.ProblemType, message: Rope.ROPENIL] = CODE;
myCDProperty: ATOM ← $CDToCore;
myCoreProperty: ATOM ← $CDToCore;
registrationTab: RefTab.Ref ← RefTab.Create[];
CoreCellDescriptorRec: TYPE = RECORD [c: Core.CellType, d: Core.Design];
RegistrationRec: TYPE = RECORD [createProc: CDCore.CreateProc, registrationKey: REFNIL];
RegisterGenerator: PUBLIC ENTRY PROC [createProc: CDCore.CreateProc, name: ATOM, registrationKey: REF NIL] =
BEGIN ENABLE UNWIND => NULL;
WITH RefTab.Fetch[registrationTab, name].val SELECT FROM
r: REF RegistrationRec => {
IF r.registrationKey#registrationKey OR registrationKey=NIL THEN
RETURN WITH ERROR CD.Error[doubleRegistration];
r.createProc ← createProc;
}
ENDCASE =>
[] ← RefTab.Store[registrationTab, name, NEW[RegistrationRec ← [createProc, registrationKey]]]
END;
CreateCDFromCore: PUBLIC PROC [coreDesign: Core.Design, coreCellType: Core.CellType, cdDesign: CD.Design] RETURNS [ob: CD.Object ← NIL] =
BEGIN
FetchGenerator: PROC [key: ATOM] RETURNS [createProc: CDCore.CreateProc←NIL] =
BEGIN
WITH RefTab.Fetch[registrationTab, key].val SELECT FROM
r: REF RegistrationRec => createProc ← r.createProc;
ENDCASE => ERROR Problem[noGenerator];
END;
GetParameter: PROC [coreCellType: Core.CellType] RETURNS [key: ATOM, param: LIST OF REF ANY NIL] =
BEGIN
x: REF ← CoreProperties.GetProp[coreCellType.properties, coreGenerateLayout];
IF x=NIL THEN
x ← CoreProperties.GetProp[coreCellType.class.properties, coreGenerateLayout];
WITH x SELECT FROM
a: ATOM => key ← a;
lora: LIST OF REF ANY => {
param ← lora.rest;
WITH lora.first SELECT FROM
a: ATOM => key ← a;
r: Rope.ROPE => key ← Atom.MakeAtom[r];
ENDCASE => ERROR Problem[generatorParameterError, "type of property"];
};
loa: LIST OF ATOM => {
TRUSTED {param ← LOOPHOLE[loa.rest]};
key ← loa.first;
};
r: Rope.ROPE => key ← Atom.MakeAtom[r];
lor: LIST OF Rope.ROPE => {
TRUSTED {param ← LOOPHOLE[lor.rest]};
key ← Atom.MakeAtom[lor.first];
};
ENDCASE => ERROR Problem[generatorParameterError, "type of property"];
END;
--CreateCDFromCore
ob ← FetchCDFromCore[cdDesign, coreDesign, coreCellType];
IF ob=NIL THEN {
proc: CDCore.CreateProc;
key: ATOM;
param: LIST OF REF ANY;
[key, param] ← GetParameter[coreCellType];
proc ← FetchGenerator[key];
ob ← proc[coreDesign: coreDesign, coreCellType: coreCellType, cdDesign: cdDesign, param: param, key: key];
IF ob=NIL THEN ERROR Problem[generatorFailed];
MakeMatch[cdDesign, ob, coreDesign, coreCellType];
}
END;
FetchCDFromCore: PROC [cdDesign: CD.Design, coreDesign: Core.Design, coreCellType: Core.CellType] RETURNS [ob: CD.Object ← NIL] =
BEGIN
CheckMatch: PROC [design: CD.Design, ob: CD.Object, coreDesign: Core.Design, coreCellType: Core.CellType] RETURNS [ok: BOOLTRUE] =
BEGIN
IF ob.class.inDirectory THEN {
ob1: CD.Object ← CDDirectory.Fetch[design, CDDirectory.Name[ob]].object;
IF ob1=NIL OR ob1#ob THEN RETURN [ok←FALSE];
WITH CDProperties.GetPropFromObject[from: ob1, prop: myCDProperty] SELECT FROM
r: REF CoreCellDescriptorRec => ok ← r.d=coreDesign AND r.c=coreCellType;
ENDCASE => ok ← FALSE;
};
IF ok THEN ok ← ob=CoreProperties.GetProp[coreCellType.properties, myCoreProperty];
END;
WITH CoreProperties.GetProp[coreCellType.properties, myCoreProperty] SELECT FROM
o: CD.Object => IF CheckMatch[cdDesign, o, coreDesign, coreCellType] THEN ob←o;
ENDCASE => NULL;
END;
MakeMatch: PROC [design: CD.Design, ob: CD.Object, coreDesign: Core.Design, coreCellType: Core.CellType] =
BEGIN
coreCellType.properties ← CoreProperties.PutProp[coreCellType.properties, myCoreProperty, ob];
CDProperties.PutPropOnObject[ob, myCDProperty,
NEW[CoreCellDescriptorRec ← [c: coreCellType, d: coreDesign]]];
END;
InvalidateCache: PUBLIC PROC [what: REF] =
BEGIN
WITH what SELECT FROM
ob: CD.Object => CDProperties.PutPropOnObject[ob, myCDProperty, NIL];
cc: Core.CellType =>
cc.properties ← CoreProperties.PutProp[cc.properties, myCoreProperty, NIL];
ENDCASE => NULL;
END;
ObjectHasChanged: CDEvents.EventProc =
BEGIN
InvalidateCache[x];
END;
coreGenerateLayout: ATOM--CDCore.generateLayout-- $GenLayout;
[] ← CoreProperties.RegisterProperty[coreGenerateLayout];
[] ← CoreProperties.RegisterProperty[myCoreProperty];
[] ← CDProperties.RegisterProperty[myCDProperty];
CDEvents.RegisterEventProc[event: $AfterChange, proc: ObjectHasChanged];
END.