CDImportsImpl.mesa (part of ChipNDale)
Copyright © 1984, 1986 by Xerox Corporation. All rights reserved.
by Christian Jacobi, March 20, 1984 5:50:51 pm PST
last edited Christian Jacobi, March 28, 1986 6:41:45 pm PST
DIRECTORY
CD,
CDBasics,
CDCallSpecific,
CDDirectory,
CDDirectoryOps,
CDEvents,
CDGenerate,
CDRemote,
CDImports,
CDImportsExtras,
CDInstances,
CDIO,
CDOps,
CDOrient,
CDProperties,
CDValue,
Rope,
TerminalIO,
TokenIO;
CDImportsImpl:
CEDAR
PROGRAM
IMPORTS CD, CDBasics, CDDirectory, CDDirectoryOps, CDEvents, CDGenerate, CDRemote, CDInstances, CDIO, CDOps, CDOrient, CDProperties, CDValue, Rope, TerminalIO, TokenIO
EXPORTS CDImports, CDImportsExtras
SHARES CDDirectory, CDRemote =
BEGIN
BoolOrInteractive: TYPE = CDImports.BoolOrInteractive;
ImportPtr: TYPE = CDImports.ImportPtr;
ImportRep: TYPE = CDImports.ImportRep;
ImportList: TYPE = CDImports.ImportList;
ImportDesign: TYPE = CDImports.ImportDesign;
ObList: TYPE = LIST OF CD.Object;
ROPE: TYPE = Rope.ROPE;
ImpList: TYPE = LIST OF REF ImportDesign;
importListKey: ATOM = $ImportList; -- for CDValue
importsClass:
PUBLIC CD.ObjectClass =
CD.RegisterObjectClass[$Import, [
drawMe: DrawForImport,
quickDrawMe: QuickDrawReference,
showMeSelected: DrawSelectionForImport,
internalRead: ReadImportOb,
internalWrite: WriteImportOb,
describe: DescribeImport,
interestRect: InterestRect
]];
ImpPrivate:
TYPE =
RECORD [
d: CD.Design←NIL,
obList: ObList←NIL
];
EnumerateItsObjects:
PROC [me:
CD.Object, p: CDDirectory.EnumerateObjectsProc, x:
REF] =
BEGIN
dont !!!
the imported objects are not part of this design
END;
ReplaceDirectChild: CDDirectory.ReplaceDChildsProc =
-- PROC[me: CD.Object, design: CD.Design, replace: LIST OF REF ReplaceRec] --
BEGIN
dont, don't ERROR:
don't ERROR, because the client doese not know that imports cannot be changed
END;
InternalCreateImport:
PROC [into:
CD.Design,
size: CD.Position←[1, 1], ir: CD.Rect ← [0, 0, -1, -1],
objectName, importeeName: ROPE,
autoLoad: BOOL ← FALSE, --loads file if neccessary; if loaded, import design is made
autoImport: BOOL ← FALSE, --import design even if not loaded successfully
autoCreateOb: BOOL ← FALSE, --creates ob if not found or design not loaded (but not if import not made)
allowConflicts: BoolOrInteractive�lse, --allow size conflicts on the object
include:
BOOL ←
TRUE]
RETURNS [ob: CD.Object ← NIL] =
BEGIN
referedOb: CD.Object ← NIL; iR: CD.Rect;
import: REF ImportDesign; impPriv: REF ImpPrivate;
probablySize: CD.Position ← CDBasics.MaxPoint[size, [1, 1]];
--make an import of the importee design
import ← GetImportEntry[into, importeeName, false];
IF (import=
NIL
OR ~import.loaded)
AND autoLoad
THEN {
loaded: BOOL ← Load[into: into, importeeName: importeeName, overload: false, allowConflicts: false];
};
IF import=NIL AND autoImport THEN import ← GetImportEntry[into, importeeName, true];
IF import=NIL THEN RETURN [NIL];
--search for an already existing import object
IF CDBasics.NonEmpty[ir] THEN iR ← ir ELSE iR ← CDBasics.RectAt[[0, 0], probablySize];
impPriv ← NARROW[import.reservedForCDImports];
FOR list: ObList ← impPriv.obList, list.rest
WHILE list#
NIL
DO
iPtr: ImportPtr ← NARROW[list.first.specificRef, ImportPtr];
IF Rope.Equal[iPtr.objectName, objectName]
AND Rope.Equal[iPtr.designName, importeeName]
THEN {
IF list.first.size=size AND (CD.InterestRect[list.first]=iR OR ~CDBasics.NonEmpty[ir]) THEN RETURN [list.first];
IF allowConflicts=true THEN RETURN [list.first];
IF allowConflicts=interactive AND TerminalIO.Confirm[choice: "ignore", label: "size conflicts"] THEN RETURN [list.first];
RETURN [NIL]
};
ENDLOOP;
--already existing imported object not found; make new object
--if not load, trust for the size... it is checked at binding time
IF import.loaded THEN referedOb ← CDDirectory.Fetch[impPriv.d, objectName].object;
IF referedOb=NIL AND ~autoCreateOb THEN RETURN [NIL];
IF allowConflicts=true
AND referedOb
#NIL THEN {
probablySize ← referedOb.size; iR ← CD.InterestRect[referedOb];
};
ob ←
NEW[
CD.ObjectRep←[
size: probablySize,
class: importsClass,
layer: CD.undefLayer,
specificRef:
NEW[ImportRep ← [
objectName: objectName,
ir: iR,
designName: importeeName
]]
]];
impPriv.obList ← CONS[ob, impPriv.obList];
IF include THEN [] ← CDDirectory.Include[design: into, object: ob, alternateName: Rope.Cat[importeeName, ".", objectName]];
IF import.loaded THEN [] ← BindReference[into, ob, impPriv.d, allowConflicts];
END;
CreateImport:
PUBLIC
PROC [into:
CD.Design, objectName, importeeName:
ROPE]
RETURNS [ob:
CD.Object] =
BEGIN
ob ← InternalCreateImport[into: into, objectName: objectName, importeeName: importeeName, autoCreateOb: FALSE, autoImport: FALSE, autoLoad: TRUE, allowConflicts: true, include: TRUE];
END;
ShortName:
PROC [me:
CD.Object, iPtr: ImportPtr]
RETURNS [n:
ROPE] =
INLINE
BEGIN
n ← CDDirectory.Name[me];
IF Rope.IsEmpty[n] THEN n ← iPtr.objectName;
END;
DescribeImport:
PROC[me:
CD.Object]
RETURNS [
ROPE] =
BEGIN
iPtr: ImportPtr = NARROW[me.specificRef];
RETURN [Rope.Cat["reference to ", iPtr.designName, ".", iPtr.objectName]];
END;
DrawForImport:
PROC [inst:
CD.Instance, pos:
CD.Position, orient:
CD.Orientation,
pr: CD.DrawRef] =
BEGIN
iPtr: ImportPtr = NARROW[inst.ob.specificRef];
IF iPtr.boundInstance#
NIL
THEN {
pr.drawChild[iPtr.boundInstance, pos, orient, pr];
}
ELSE {
r: CD.Rect = MappedInterestRect[inst.ob, pos, orient];
pr.drawRect[r, CD.shadeLayer, pr];
pr.drawComment[r, ShortName[inst.ob, iPtr], pr];
}
END;
MappedInterestRect:
PROC [ob:
CD.Object, pos:
CD.Position, orient:
CD.Orientation]
RETURNS [
CD.Rect] =
INLINE
BEGIN
RETURN [CDOrient.MapRect[
itemInCell: CD.InterestRect[ob],
cellSize: ob.size,
cellInstOrient: orient,
cellInstPos: pos
]]
END;
QuickDrawReference:
PROC [inst:
CD.Instance, pos:
CD.Position, orient:
CD.Orientation,
pr: CD.DrawRef] =
BEGIN
iPtr: ImportPtr = NARROW[inst.ob.specificRef];
IF iPtr.boundInstance#
NIL
THEN {
iPtr.boundInstance.ob.class.quickDrawMe[iPtr.boundInstance, pos, orient, pr];
}
ELSE {
r: CD.Rect = MappedInterestRect[inst.ob, pos, orient];
pr.drawRect[r, CD.shadeLayer, pr];
pr.drawComment[r, ShortName[inst.ob, iPtr], pr];
}
END;
DrawSelectionForImport:
PROC [inst:
CD.Instance, pos:
CD.Position, orient:
CD.Orientation,
pr: CD.DrawRef] =
BEGIN
iPtr: ImportPtr = NARROW[inst.ob.specificRef];
IF iPtr.boundInstance#
NIL
THEN
iPtr.boundInstance.ob.class.showMeSelected[iPtr.boundInstance, pos, orient, pr]
ELSE
pr.drawOutLine[MappedInterestRect[inst.ob, pos, orient], CD.selectionLayer, pr]
END;
InterestRect:
PROC [ob:
CD.Object]
RETURNS [
CD.Rect] =
BEGIN
RETURN [NARROW[ob.specificRef, ImportPtr].ir]
END;
WriteImportOb:
CD.InternalWriteProc
-- PROC [me: Object] -- =
BEGIN
iPtr: ImportPtr = NARROW[me.specificRef];
CDIO.WritePos[me.size];
CDIO.WriteRect[iPtr.ir];
TokenIO.WriteRope[iPtr.objectName];
TokenIO.WriteRope[iPtr.designName];
END;
ReadImportOb:
CD.InternalReadProc
--PROC [] RETURNS [Object]-- =
BEGIN
sz: CD.Position = CDIO.ReadPos[];
ir: CD.Rect;
objectName: ROPE;
importeeName: ROPE;
ob: CD.Object;
IF CDIO.VersionKey[] >= 8 THEN ir ← CDIO.ReadRect[]
ELSE ir ← CDBasics.RectAt[[0, 0], sz];
objectName ← TokenIO.ReadRope[];
importeeName ← TokenIO.ReadRope[];
ob ← InternalCreateImport[
into: CDIO.DesignInReadOperation[],
ir: ir, size: sz,
objectName: objectName, importeeName: importeeName,
autoCreateOb: TRUE,
autoImport: TRUE,
autoLoad: FALSE,
allowConflicts: interactive,
include: FALSE
];
RETURN [ob]
END;
GetImportList:
PUBLIC
PROC [design:
CD.Design]
RETURNS [imp:
REF ImportList] =
BEGIN
WITH CDValue.Fetch[boundTo: design, key: importListKey, propagation: design]
SELECT
FROM
imp: REF ImportList => RETURN[imp];
ENDCASE => {
imp ← NEW[ImportList ← [list: NIL]];
[] ← CDValue.StoreConditional[boundTo: design, key: importListKey, value: imp];
RETURN [GetImportList[design]]
};
END;
GetImportEntry:
PUBLIC
PROC [into:
CD.Design, importeeName:
ROPE←
NIL, createIfNotFound: BoolOrInteractive ← true]
RETURNS [
REF ImportDesign←
NIL] =
BEGIN
ToBool:
PROC[b: BoolOrInteractive, r:
ROPE, r2:
ROPE←
NIL]
RETURNS [
BOOL] =
BEGIN
SELECT b
FROM
true => RETURN [TRUE];
false => RETURN [FALSE];
ENDCASE => {
TerminalIO.WriteRopes[r, r2];
RETURN [TerminalIO.Confirm[r]]
}
END;
mdata: REF ImportDesign ← NIL;
impl: REF ImportList = GetImportList[into];
IF Rope.IsEmpty[importeeName]
THEN
ERROR CD.Error[ec: other, explanation: "design has empty name, but shouldn't"];
IF impl#
NIL
THEN
FOR l: ImpList ← impl.list, l.rest
WHILE l#
NIL
DO
IF l.first#NIL AND Rope.Equal[l.first.importeeName, importeeName] THEN RETURN [l.first]
ENDLOOP;
IF ToBool[createIfNotFound, "create an import", importeeName]
THEN {
pData: REF ImpPrivate ← NEW[ImpPrivate];
mdata ← NEW[ImportDesign ← [importeeName: importeeName, loaded: FALSE, reservedForCDImports: pData]];
IF Rope.Equal[into.name, importeeName]
THEN
ERROR CD.Error[ec: other, explanation: "circular import"];
impl.list ← CONS[mdata, impl.list]; --should be atomic--
};
RETURN [mdata]
END;
BindImportee:
PROC [importer, importee:
CD.Design,
allowSizeConflicts, overload: BoolOrInteractive ← true] =
BEGIN
ENABLE TerminalIO.UserAbort => GOTO UserAborted;
done1: BOOL←TRUE;
impPriv: REF ImpPrivate; mdata: REF ImportDesign;
IF importer=importee OR Rope.Equal[importer.name, importee.name] THEN ERROR;
mdata ← GetImportEntry[importer, importee.name, true];
IF mdata=NIL THEN ERROR;
impPriv ← NARROW[mdata.reservedForCDImports];
IF mdata.loaded
THEN {
IF overload=false THEN RETURN
ELSE
IF overload=interactive
THEN
IF
NOT TerminalIO.Confirm[label: "design already loaded", choice: "overload"]
THEN {
TerminalIO.WriteRope["dont overload; not done\n"];
RETURN
}
};
impPriv.d ← importee;
mdata.loaded ← TRUE;
FOR list: ObList ← impPriv.obList, list.rest
WHILE list#
NIL
DO
done1 ← done1 AND BindReference[importer, list.first, importee, allowSizeConflicts].ok
ENDLOOP;
IF NOT done1 THEN TerminalIO.WriteRope["some import not bound\n"];
CDOps.DelayedRedraw[importer];
EXITS
UserAborted => {TerminalIO.WriteRope["aborted, design not bound\n"]};
END;
BindReference:
PROC [design:
CD.Design, reference:
CD.Object, importee:
CD.Design, allowSizeConflicts: BoolOrInteractive ← true]
RETURNS [ok:
BOOL←
FALSE] =
BEGIN
ENABLE TerminalIO.UserAbort => GOTO UserAborted;
iPtr: ImportPtr = NARROW[reference.specificRef, ImportPtr];
oldRect, newRect: CD.Rect;
referedOb: CD.Object ← CDDirectory.Fetch[importee, iPtr.objectName].object;
IF referedOb=
NIL
THEN {
TerminalIO.WriteRopes["entry ", iPtr.objectName];
TerminalIO.WriteRopes[" in ", importee.name, " not found\n"];
RETURN
};
oldRect ← InterestRect[reference];
newRect ← CD.InterestRect[referedOb];
IF newRect#oldRect
THEN {
TerminalIO.WriteRopes["object ", iPtr.objectName, " has different size; "];
IF CDBasics.SizeOfRect[oldRect]=CDBasics.SizeOfRect[newRect]
THEN
TerminalIO.WriteRope[" has different outer size; "]
ELSE
TerminalIO.WriteRope[" has different interest size; "];
IF allowSizeConflicts=false
THEN {
TerminalIO.WriteRope["not resolved\n"];
RETURN
};
IF allowSizeConflicts=interactive
THEN {
IF ~TerminalIO.Confirm[choice: "import anyway", label: "size conflict"]
THEN {
TerminalIO.WriteRope["no\n"];
RETURN
};
TerminalIO.WriteRope["yes\n"];
};
};
iPtr.boundInstance ← CDInstances.NewInst[ob: referedOb];
BEGIN
oldSize: CD.Position = reference.size;
oldBase: CD.Position = CDBasics.BaseOfRect[oldRect];
newSize: CD.Position = referedOb.size;
newBase: CD.Position = CDBasics.BaseOfRect[newRect];
IF oldSize#newSize
OR oldRect#newRect
THEN {
reference.size ← newSize;
iPtr.ir ← newRect;
CDDirectory.RepositionObject[design: design,
ob: reference,
oldSize: oldSize,
baseOff: CDBasics.SubPoints[oldBase, newBase]
];
};
END;
CDDirectory.PropagateChange[reference, design];
ok ← TRUE;
EXITS
UserAborted => {TerminalIO.WriteRope["aborted, entry not replaced\n"]};
END;
GetImportee:
PROC [into:
CD.Design, importeeName:
ROPE]
RETURNS [d:
CD.Design←
NIL] =
BEGIN
ENABLE CDRemote.ioFailed => GOTO thatsit;
d ← CDRemote.FetchDesign[into, importeeName];
IF d=
NIL
THEN {
[] ← CDRemote.GetTableUsingFile[for: into, remoteDesign: importeeName];
d ← CDRemote.FetchDesign[into, importeeName];
}
EXITS thatsit => NULL;
END;
Load:
PUBLIC
PROC [into:
CD.Design, importeeName:
ROPE,
overload, allowConflicts: BoolOrInteractive←true] RETURNS [done: BOOL←FALSE] =
BEGIN
indirectImport: REF ImportList;
importee: CD.Design ← GetImportee[into, importeeName];
IF importee=
NIL
THEN {
TerminalIO.WriteRope["load not done\n"];
RETURN
};
indirectImport ← GetImportList[importee];
IF indirectImport^.list#NIL THEN TerminalIO.WriteRope["There are indirect imports\n"];
-- check for forbidden circular import
FOR list: ImpList ← indirectImport^, list.rest
WHILE list#
NIL
DO
IF Rope.Equal[list.first.importeeName, into.name]
THEN {
TerminalIO.WriteRope["**creates circular imports\n"];
RETURN
}
ENDLOOP;
-- now we certainly have no circular import
--
-- do the actual import
BindImportee[importer: into, importee: importee, allowSizeConflicts: allowConflicts, overload: overload];
--check all already imported designs for importing the new design
FOR list: ImpList ← GetImportList[into]^, list.rest
WHILE list#
NIL
DO
ip: REF ImpPrivate = NARROW[list.first.reservedForCDImports];
IF ip.d#
NIL
AND ip.d#importee
THEN
BindImportee[importer: ip.d, importee: importee, allowSizeConflicts: false, overload: true];
ENDLOOP;
--check the new design for importing of already imported and loaded designs
FOR list: ImpList ← indirectImport^, list.rest
WHILE list#
NIL
DO
ip: REF ImpPrivate = NARROW[list.first.reservedForCDImports];
IF ip.d=
NIL
THEN {
--new design did not load..
imp: REF ImportDesign ← GetImportEntry[into, list.first.importeeName, false];
IF imp#
NIL
THEN {
oldip: REF ImpPrivate = NARROW[imp.reservedForCDImports];
IF oldip.d#
NIL
AND oldip.d#importee
THEN
BindImportee[importer: importee, importee: oldip.d, allowSizeConflicts: false, overload: true];
};
}
ENDLOOP;
done ← TRUE;
END;
DesignHasBeenRenamed: CDEvents.EventProc
--PROC [event: REF, design: CD.Design, x: REF] RETURNS [dont: BOOL←FALSE]-- =
-- prevent a renaming which would cause circularity
BEGIN
imp: REF ImportDesign = GetImportEntry[into: design, importeeName: design.name, createIfNotFound: false];
IF imp#
NIL
THEN {
dont ← TRUE;
TerminalIO.WriteRope["rename causes circularities; not done\n"]
};
END;
OneLevelIncludedCopy:
PUBLIC
PROC [impObject:
CD.Object, design:
CD.Design]
RETURNS [
CD.Object] =
--imp is an imported and bound object which will be made local to design
BEGIN
ReplaceChildrenByImports:
PROC[me:
CD.Object, design:
CD.Design, importeeName:
ROPE] =
BEGIN
replaceList: CDDirectory.ReplaceList←NIL;
PerChild: CDDirectory.EnumerateObjectsProc
--PROC [me: CD.Object, x: REF] -- =
BEGIN
IF me.class.inDirectory
THEN {
impChild: CD.Object;
FOR list: CDDirectory.ReplaceList ← replaceList, list.rest
WHILE list#
NIL
DO
IF list.first.old=me THEN RETURN -- eliminate duplicates
ENDLOOP;
impChild ← InternalCreateImport[
into: design, objectName: CDDirectory.Name[me], importeeName: importeeName,
size: me.size,
autoImport: TRUE, autoLoad: FALSE,
autoCreateOb: TRUE, allowConflicts: true,
include: TRUE
];
replaceList ←
CONS[
NEW[CDDirectory.ReplaceRec←[
old: me,
oldSize: me.size,
new: impChild,
newSize: impChild.size,
off: [0, 0]
]],
replaceList
];
}
END;
--build list of direct children
CDDirectory.EnumerateChildObjects[me: me, p: PerChild, x: NIL];
--replace each direct child by an import
IF replaceList#
NIL
THEN
[] ← CDDirectory.ReplaceDirectChild[me: me, design: design, replace: replaceList];
END; --ReplaceChildrenByImports
--OneLevelIncludedCopy
WITH impObject.specificRef
SELECT
FROM
impPtr: ImportPtr => {
newOb: CD.Object; tm, cm: CDDirectory.DMode;
import: REF ImportDesign = GetImportEntry[design, impPtr.designName, false];
ip: REF ImpPrivate;
IF impPtr.boundInstance=
NIL
OR import=
NIL
OR ~import.loaded
THEN
ERROR CD.Error[callingError, "OneLevelIncludedCopy impObject not bound "];
ip ← NARROW[import.reservedForCDImports];
[newOb, tm, cm] ← CDDirectory.Another[me: impPtr.boundInstance.ob, fromOrNil: ip.d, into: design];
IF newOb=NIL OR tm=immutable THEN ERROR;
IF tm=ready THEN [] ← CDDirectory.Include[design, newOb];
IF cm=immutable
THEN
ReplaceChildrenByImports[me: newOb, design: design, importeeName: import.importeeName];
RETURN [newOb]
};
ENDCASE => ERROR CD.Error[callingError, "OneLevelIncludedCopy impObject not reference"]
END; --OneLevelIncludedCopy
Another:
PROC [me:
CD.Object, fromOrNil:
CD.Design, into:
CD.Design, friendly:
BOOL]
RETURNS [new:
CD.Object, topMode: CDDirectory.InclOrReady←included, childMode: CDDirectory.ImmOrIncl←included] =
BEGIN
impPtr: ImportPtr = NARROW[me.specificRef]; own: REF;
IF into=NIL THEN ERROR;
new ← InternalCreateImport[into: into, objectName: impPtr.objectName, importeeName: impPtr.designName, autoCreateOb: TRUE, autoImport: TRUE, allowConflicts: true, include: TRUE, size: me.size, autoLoad: FALSE];
IF new=NIL THEN ERROR;
own ← CDProperties.GetObjectProp[new, $OwnerDesign];
CDProperties.AppendProps[looser: me.properties, winner: new.properties, putOnto: new];
CDProperties.PutObjectProp[new, $OwnerDesign, own];
END;
Expand:
PROC [me:
CD.Object, fromOrNil:
CD.Design, into:
CD.Design, friendly:
BOOL]
RETURNS [new:
CD.Object, topMode: CDDirectory.DMode←immutable, childMode: CDDirectory.ImmOrIncl←immutable] =
BEGIN
impPtr: ImportPtr = NARROW[me.specificRef];
IF impPtr.boundInstance=NIL THEN RETURN [NIL]; --can not expand unloaded object
IF into#
NIL
--AND friendly--
THEN {
tm, cm: CDDirectory.DMode;
[me, tm, cm] ← CDDirectory.Another[me: me, fromOrNil: fromOrNil, into: into];
IF me#
NIL
AND tm=included
THEN {
new ← OneLevelIncludedCopy[impObject: me, design: into];
IF new#NIL THEN RETURN [new, included, included];
}
};
RETURN [impPtr.boundInstance.ob, immutable, immutable];
END;
MergeInImports:
PUBLIC
PROC [into:
CD.Design, importeeName:
ROPE] =
--Includes all the imported and bound objects from importeeName (including
--their transitive closure; but not indirect imports) into design.
BEGIN
imp: REF ImportDesign ← GetImportEntry[into, importeeName, false];
IF imp=
NIL
THEN {
TerminalIO.WriteRopes["MergeInImports not done; design ", importeeName, " is not imported\n"];
RETURN
}
ELSE
IF ~imp.loaded
THEN {
TerminalIO.WriteRopes["MerginImport not done; design ", importeeName, " is not loaded\n"];
RETURN
}
ELSE {
impPrivate: REF ImpPrivate = NARROW[imp.reservedForCDImports];
generatorTable: CDGenerate.Table;
importee: CD.Design ← impPrivate.d;
objectList: ObList ← NIL;
doList: ObList ← NIL;
dontList: ObList ← NIL;
CDRemote.CacheDesign[for: into, remote: importee];
generatorTable ← CDRemote.GetTable[imp.importeeName];
--split the reference list in bounded and not bounded
FOR list: ObList ← impPrivate.obList, list.rest
WHILE list#
NIL
DO
IF
NARROW[list.first.specificRef, ImportPtr].boundInstance#
NIL
THEN
doList ← CONS[list.first, doList]
ELSE dontList ← CONS[list.first, dontList];
ENDLOOP;
--make includes for all bounded references
FOR list: ObList ← doList, list.rest
WHILE list#
NIL
DO
pr: ImportPtr = NARROW[list.first.specificRef];
newOb: CD.Object ← CDGenerate.FetchNCall[table: generatorTable, design: into, key: pr.objectName, cache: TRUE];
IF newOb#
NIL
THEN {
CDDirectory.ReplaceObject[design: into, old: list.first, new: newOb];
IF CDDirectoryOps.RemoveIfUnused[design: into, ob: list.first].done
THEN {
[] ← CDDirectory.Rename[into, newOb, pr.objectName];
};
}
ELSE dontList ← CONS[list.first, dontList];
ENDLOOP;
impPrivate.obList ← dontList;
}
END;
HasUnloadedImports:
PUBLIC
PROC [design:
CD.Design]
RETURNS [yes:
BOOL←
FALSE] =
BEGIN
impList: REF CDImports.ImportList = GetImportList[design];
IF impList#
NIL
THEN
FOR list:
LIST
OF
REF CDImports.ImportDesign ← impList^, list.rest
WHILE list#
NIL
DO
IF ~list.first.loaded
THEN {
--a directly imported design is not loaded
RETURN [yes ← TRUE]
}
ELSE {
--check all objects of this design
p: REF ImpPrivate ← NARROW[list.first.reservedForCDImports];
FOR obl: ObList ← p.obList, obl.rest
WHILE obl#
NIL
DO
ip: ImportPtr = NARROW[obl.first.specificRef];
IF ip.boundInstance=NIL THEN RETURN [yes ← TRUE];
ENDLOOP;
--check for indirect objects; there are no loops
yes ← p.d#NIL AND HasUnloadedImports[p.d];
}
ENDLOOP;
END;
Init:
PROC [] =
BEGIN
dirProcs:
REF CDDirectory.DirectoryProcs = CDDirectory.InstallDirectoryProcs[importsClass, [
enumerateChildObjects: EnumerateItsObjects,
replaceDirectChilds: ReplaceDirectChild,
another: Another,
expand: Expand
]];
CDValue.RegisterKey[importListKey];
CDEvents.RegisterEventProc[$RenameDesign, DesignHasBeenRenamed];
END;
Init[];
END.