CDImportsImpl.mesa (part of ChipNDale)
Copyright © 1984, 1986 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, March 20, 1984 5:50:51 pm PST
Last edited by: Christian Jacobi, January 12, 1987 12:03:12 pm PST
DIRECTORY
CD,
CDBasics,
CDDirectory,
CDDirectoryOps,
CDEvents,
CDGenerate,
CDRemote,
CDImports,
CDImportsBackdoor,
CDInstances,
CDIO,
CDOps,
CDProperties,
CDValue,
RefTab,
Rope,
RopeList,
SymTab,
TerminalIO,
TokenIO;
CDImportsImpl:
CEDAR
PROGRAM
IMPORTS CD, CDBasics, CDDirectory, CDDirectoryOps, CDEvents, CDGenerate, CDRemote, CDInstances, CDIO, CDOps, CDProperties, CDValue, RefTab, Rope, RopeList, SymTab, TerminalIO, TokenIO
EXPORTS CDImports, CDImportsBackdoor
SHARES CDDirectory, CDRemote =
BEGIN OPEN CDImports;
ROPE: TYPE = Rope.ROPE;
BoolOrInteractive: TYPE = CDImports.BoolOrInteractive;
importListKey: ATOM = $ImportListRec; -- for CDValue
importsClass:
PUBLIC
CD.ObjectClass =
CD.RegisterObjectClass[$Import, [
drawMe: DrawForImport,
quickDrawMe: QuickDrawReference,
showMeSelected: DrawSelectionForImport,
internalRead: ReadImportOb,
internalWrite: WriteImportOb,
describe: DescribeImport,
interestRect: ImportIR
]];
ImpEntryList: TYPE = LIST OF ImportEntry;
EachImpOb:
PROC [id: ImportEntry, proc:
PROC [ob:
CD.Object]] = {
EachPair: PROC [key: REF, val: REF] RETURNS [quit: BOOL←FALSE] = {proc[NARROW[val]]};
[] ← SymTab.Pairs[NARROW[id.implData], EachPair]
};
EnumerateItsObjects:
PROC [me:
CD.Object, p: CDDirectory.EnumerateObjectsProc, x:
REF] = {
dont !!!
the imported objects are not part of this design
};
ReplaceDirectChild: CDDirectory.ReplaceDChildsProc = {
-- PROC[me: CD.Object, design: CD.Design, replace: LIST OF REF ReplaceRec] --
dont, don't ERROR:
don't ERROR, because the client doese not know that imports cannot be changed
};
InternalCreateImport:
PROC [into:
CD.Design,
bbox:
CD.Rect ← [0, 0, 1, 1], ir:
CD.Rect ← [0, 0, -1, -1],
objectName, importeeName:
ROPE,
autoLoad:
BOOL ←
FALSE,
--loads file if necessary; if loaded, import design is made
autoImport:
BOOL ←
FALSE,
--import design even if not loaded successfully
autoCreateOb:
BOOL ←
FALSE,
--creates ob if ~found or design ~loaded (but not if import not made)
allowConflicts: BoolOrInteractive�lse,
--allow size conflicts on the object
include:
BOOL ←
TRUE]
RETURNS [ob:
CD.Object ←
NIL] = {
CheckOb:
PROC [ob:
CD.Object]
RETURNS [checked:
CD.Object ←
NIL] = {
--checks the object against global rects, returns it or NIL dependent on conflicts
checked ← ob;
IF ob#
NIL
THEN
IF (bbox#ob.bbox
AND CDBasics.NonEmpty[bbox])
OR
(ir#CD.InterestRect[ob] AND CDBasics.NonEmpty[ir]) THEN {
--size conflict
IF allowConflicts=true THEN RETURN [ob];
IF allowConflicts=interactive AND TerminalIO.Confirm["ignore size conflicts"] THEN RETURN [ob];
RETURN [NIL]
};
};
referedOb: CD.Object ← NIL; iR: CD.Rect;
import: ImportEntry; obtab: SymTab.Ref;
--check for silly self imports
IF into#
NIL
AND Rope.Equal[importeeName, into.name]
THEN {
RETURN [CheckOb[CDDirectory.Fetch[into, objectName].object]]
};
--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 loaded AND import=NIL THEN import ← GetImportEntry[into, importeeName, 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 ← bbox;
obtab ← NARROW[import.implData];
WITH SymTab.Fetch[obtab, objectName].val
SELECT
FROM
ob: CD.Object => RETURN [CheckOb[ob]];
ENDCASE => NULL;
--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[import.d, objectName].object;
IF referedOb=NIL AND ~autoCreateOb THEN RETURN [NIL];
IF allowConflicts=true
AND referedOb#
NIL
THEN {
bbox ← referedOb.bbox; iR ← CD.InterestRect[referedOb];
};
IF ~CDBasics.NonEmpty[bbox] THEN bbox ← iR;
ob ←
NEW[
CD.ObjectRep←[
bbox: bbox,
class: importsClass,
layer: CD.undefLayer,
specific:
NEW[ImportRep ← [
objectName: objectName,
ir: iR,
designName: importeeName
]]
]];
[] ← SymTab.Store[obtab, objectName, ob];
IF include
THEN
[] ← CDDirectory.Include[design: into, object: ob, alternateName: Rope.Cat[importeeName, ".", objectName]];
IF import.loaded THEN [] ← BindObject[into, ob, import.d, allowConflicts];
};
CreateImport:
PUBLIC
PROC [into:
CD.Design, objectName, importeeName:
ROPE]
RETURNS [ob:
CD.Object] = {
ob ← InternalCreateImport[into: into, objectName: objectName, importeeName: importeeName, autoCreateOb: FALSE, autoImport: FALSE, autoLoad: TRUE, allowConflicts: true, include: TRUE];
};
TrustedCreateImport:
PUBLIC
PROC [into:
CD.Design, objectName, importeeName: Rope.
ROPE, ir, bbox:
CD.Rect]
RETURNS [ob:
CD.Object] = {
ob ← InternalCreateImport[into: into, bbox: bbox, ir: ir, objectName: objectName, importeeName: importeeName, autoCreateOb: TRUE, autoImport: TRUE, autoLoad: FALSE, allowConflicts: true, include: TRUE];
};
ShortName:
PROC [me:
CD.Object, iPtr: ImportSpecific]
RETURNS [n:
ROPE] =
INLINE {
n ← CDDirectory.Name[me];
IF Rope.IsEmpty[n] THEN n ← iPtr.objectName;
};
DescribeImport:
PROC[me:
CD.Object]
RETURNS [
ROPE] = {
iPtr: ImportSpecific = NARROW[me.specific];
RETURN [Rope.Cat["reference to ", iPtr.designName, ".", iPtr.objectName]];
};
DrawForImport:
PROC [inst:
CD.Instance, trans:
CD.Transformation, pr:
CD.DrawRef] = {
iPtr: ImportSpecific = NARROW[inst.ob.specific];
IF iPtr.boundInstance#NIL THEN pr.drawChild[iPtr.boundInstance, trans, pr]
ELSE {
r: CD.Rect = CDBasics.MapRect[CD.InterestRect[inst.ob], trans];
pr.drawRect[r, CD.shadeLayer, pr];
pr.drawComment[r, ShortName[inst.ob, iPtr], pr];
}
};
QuickDrawReference:
PROC [inst:
CD.Instance, trans:
CD.Transformation, pr:
CD.DrawRef] = {
iPtr: ImportSpecific = NARROW[inst.ob.specific];
IF iPtr.boundInstance#
NIL
THEN
iPtr.boundInstance.ob.class.quickDrawMe[iPtr.boundInstance, trans, pr]
ELSE {
r: CD.Rect = CDBasics.MapRect[CD.InterestRect[inst.ob], trans];
pr.drawRect[r, CD.shadeLayer, pr];
pr.drawComment[r, ShortName[inst.ob, iPtr], pr];
}
};
DrawSelectionForImport:
PROC [inst:
CD.Instance, trans:
CD.Transformation, pr:
CD.DrawRef] = {
iPtr: ImportSpecific = NARROW[inst.ob.specific];
IF iPtr.boundInstance#
NIL
THEN
iPtr.boundInstance.ob.class.showMeSelected[iPtr.boundInstance, trans, pr]
ELSE
pr.drawOutLine[CDBasics.MapRect[CD.InterestRect[inst.ob], trans], CD.selectionLayer, pr]
};
ImportIR:
PROC [ob:
CD.Object]
RETURNS [
CD.Rect] = {
RETURN [NARROW[ob.specific, ImportSpecific].ir]
};
WriteImportOb:
CD.InternalWriteProc
-- PROC [ob: Object] -- = {
iPtr: ImportSpecific = NARROW[ob.specific];
CDIO.WriteRect[h, ob.bbox]; --??? think if we want it
CDIO.WriteRect[h, iPtr.ir];
TokenIO.WriteRope[h, iPtr.objectName];
TokenIO.WriteRope[h, iPtr.designName];
};
ReadImportOb:
CD.InternalReadProc
--PROC [] RETURNS [Object]-- = {
bbox, ir: CD.Rect;
objectName, importeeName: ROPE;
ob: CD.Object;
IF
CDIO.VersionKey[h] > 15
THEN {
bbox ← CDIO.ReadRect[h];
ir ← CDIO.ReadRect[h];
}
ELSE {
bbox ← CDBasics.RectAt[[0,0], CDIO.ReadPos[h]];
IF CDIO.VersionKey[h] >= 8 THEN ir ← CDIO.ReadRect[h]
ELSE ir ← bbox;
};
objectName ← TokenIO.ReadRope[h];
importeeName ← TokenIO.ReadRope[h];
ob ← InternalCreateImport[
into: CDIO.DesignInReadOperation[h],
ir: ir, bbox: bbox,
objectName: objectName, importeeName: importeeName,
autoCreateOb: TRUE,
autoImport: TRUE,
autoLoad: FALSE,
allowConflicts: interactive,
include: FALSE
];
RETURN [ob]
};
GetImportList:
PUBLIC
PROC [design:
CD.Design]
RETURNS [imp: ImportList] = {
WITH CDValue.Fetch[design, importListKey, design]
SELECT
FROM
imp: ImportList => RETURN[imp];
ENDCASE => {
imp ← NEW[ImportListRec ← [list: NIL]];
[] ← CDValue.StoreConditional[boundTo: design, key: importListKey, value: imp];
RETURN [GetImportList[design]]
};
};
GetImportEntry:
PUBLIC
PROC [into:
CD.Design, importeeName:
ROPE←
NIL, createIfNotFound: BoolOrInteractive ← true]
RETURNS [ImportEntry←
NIL] = {
--get the entry in design into telling about importing importeeName
ToBool:
PROC[b: BoolOrInteractive, r, r2:
ROPE←
NIL]
RETURNS [
BOOL] = {
SELECT b
FROM
true => RETURN [TRUE];
false => RETURN [FALSE];
ENDCASE => {
TerminalIO.PutRopes[r, r2];
RETURN [TerminalIO.Confirm[r]]
}
};
mdata: ImportEntry ← NIL;
impl: ImportList = GetImportList[into];
IF Rope.IsEmpty[importeeName]
THEN
ERROR CD.Error[ec: other, explanation: "can't import design with empty name"];
IF Rope.Equal[into.name, importeeName]
THEN
ERROR CD.Error[ec: other, explanation: "can't import design with equal name"];
IF impl#
NIL
THEN
FOR l: ImpEntryList ← 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 {
mdata ←
NEW[ImportEntryRec ← [
importeeName: importeeName, loaded: FALSE, implData: SymTab.Create[17]
]];
impl.list ← CONS[mdata, impl.list]; --should be atomic--
};
RETURN [mdata]
};
BindDesign:
PROC [importer, importee:
CD.Design, allowSizeConflicts: BoolOrInteractive ← true] = {
done: BOOL ← TRUE;
BindOneOb:
PROC [ob:
CD.Object] = {
IF ~BindObject[importer, ob, importee, allowSizeConflicts].ok THEN done ← FALSE
};
mdata: ImportEntry ← GetImportEntry[importer, importee.name, true];
IF mdata=NIL THEN ERROR;
mdata.d ← importee; mdata.loaded ← TRUE;
EachImpOb[mdata, BindOneOb];
IF ~done
THEN
TerminalIO.PutRopes["some imported object from ", importee.name, " not bound\n"];
CDOps.Redraw[importer];
};
UnBindObject:
PROC [ob:
CD.Object] = {
iPtr: ImportSpecific = NARROW[ob.specific, ImportSpecific];
iPtr.boundInstance ← NIL
};
BindObject:
PROC [into:
CD.Design, ob:
CD.Object, importee:
CD.Design, allowSizeConflicts: BoolOrInteractive ← true]
RETURNS [ok:
BOOL←
FALSE] = {
iPtr: ImportSpecific = NARROW[ob.specific, ImportSpecific];
oldIr, newIr, oldBb, newBb: CD.Rect;
referedOb: CD.Object ← CDDirectory.Fetch[importee, iPtr.objectName].object;
IF referedOb=
NIL
THEN {
TerminalIO.PutF["object %g not found in directory of %g\n",
[rope[iPtr.objectName]], [rope[importee.name]]
];
RETURN
};
oldIr ← ImportIR[ob]; oldBb ← ob.bbox;
newIr ← CD.InterestRect[referedOb]; newBb ← referedOb.bbox;
IF newIr=oldIr
AND newBb=oldBb
THEN {
--everything is ok
iPtr.boundInstance ← CDInstances.NewInst[ob: referedOb];
CDDirectory.PropagateChange[ob, into];
ok ← TRUE;
}
ELSE {
--size conflict
r: Rope.
ROPE ←
IF newIr=oldIr THEN "bounding box miss-match for "
ELSE IF newBb=oldBb THEN "interest rect miss-match for "
ELSE "bounding box and interest rect miss-match for ";
TerminalIO.PutRopes[r, iPtr.objectName, " "];
--check whether we should continue binding
IF allowSizeConflicts=false
THEN {
TerminalIO.PutRope["not resolved\n"];
UnBindObject[ob];
RETURN
};
IF allowSizeConflicts=interactive
AND ~TerminalIO.Confirm["size conflict; import anyway"]
THEN {
UnBindObject[ob];
RETURN
};
iPtr.boundInstance ← CDInstances.NewInst[ob: referedOb];
--continue binding
ob.bbox ← newBb; iPtr.ir ← newIr;
IF newIr=oldIr
THEN {
--interest rects match; not only size but also location! in this case we assume
--that it might (probably, but not always) be a conversion problem from cd23
trans: CD.Transformation ← [[oldIr.x1-newIr.x1, oldIr.y1-newIr.y1], original];
TerminalIO.PutRopes[" keep interest rect at constant position\n"];
CDDirectory.ReplaceObject[into, ob, ob, trans];
}
ELSE {
TerminalIO.PutRopes[" keep origin at constant position\n"];
CDDirectory.PropagateResize[into, ob];
};
CDDirectory.PropagateChange[ob, into];
ok ← TRUE;
};
};
ImportsOne:
PROC [into:
CD.Design, names:
LIST
OF
ROPE]
RETURNS [
BOOL←
FALSE] = {
--Checks whether into imports any of the named designs
--Recursion is finite because there are no circular imports
--but I don't really trust it; procedure returns true on circularity
impl: ImportList ← GetImportList[into];
FOR l: ImpEntryList ← impl.list, l.rest
WHILE l#
NIL
DO
IF l.first#NIL AND RopeList.Memb[names, l.first.importeeName] THEN RETURN [TRUE];
ENDLOOP;
FOR l: ImpEntryList ← impl.list, l.rest
WHILE l#
NIL
DO
IF l.first#
NIL
THEN {
d: CD.Design ← l.first.d;
IF d#
NIL
AND d.name#
NIL
THEN
IF ImportsOne[d, CONS[d.name, names]] THEN RETURN [TRUE];
}
ENDLOOP;
};
NameTest:
PROC [into:
CD.Design, importeeName:
ROPE]
RETURNS [fail:
BOOL←
FALSE] = {
IF Rope.IsEmpty[importeeName]
THEN {
TerminalIO.PutRope["**can't import design with empty name\n"];
RETURN [fail←TRUE]
};
IF Rope.Equal[importeeName, into.name]
THEN {
TerminalIO.PutRopes["**can't make circular imports for ", importeeName, "\n"];
RETURN [fail←TRUE]
};
};
OverLoadTest:
PROC [into:
CD.Design, importeeName:
ROPE, overload: BoolOrInteractive←true]
RETURNS [fail:
BOOL←
FALSE] = {
mdata: ImportEntry ← GetImportEntry[into, importeeName, false];
IF mdata#
NIL
AND mdata.loaded
THEN {
IF overload=false
THEN
{
TerminalIO.PutRopes["imported ", importeeName, " is loaded\n"];
RETURN [fail←TRUE]
}
ELSE
IF overload=interactive
AND ~TerminalIO.Confirm[Rope.Cat["overload already loaded import ", importeeName]]
THEN {
TerminalIO.PutRopes["dont overload ", importeeName, "\n"];
RETURN [fail←TRUE]
}
};
};
Load:
PUBLIC
PROC [into:
CD.Design, importeeName:
ROPE, overload, allowConflicts: BoolOrInteractive←true]
RETURNS [done:
BOOL←
FALSE] = {
done ← LoadDesign[into: into, importeeName: importeeName, overload: overload, allowConflicts: allowConflicts, useCache: FALSE];
};
LoadDesign:
PUBLIC PROC [into:
CD.Design, importeeName: Rope.
ROPE, overload, allowConflicts: CDImports.BoolOrInteractive←true, useCache:
BOOL←
FALSE]
RETURNS [done:
BOOL←
FALSE] = {
indirectImport: ImportList; importee: CD.Design;
IF NameTest[into, importeeName].fail THEN RETURN [done←FALSE];
IF OverLoadTest[into, importeeName, overload].fail THEN RETURN [done←FALSE];
[] ← CDRemote.LoadCache[for: into, remoteDesign: importeeName, reload: ~useCache];
importee ← CDRemote.FetchDesign[into, importeeName];
IF importee=
NIL
THEN {
TerminalIO.PutRopes["load ", importeeName, "not done\n"]; RETURN [FALSE]
};
indirectImport ← GetImportList[importee];
IF indirectImport^.list#NIL THEN TerminalIO.PutRope["there are indirect imports\n"];
-- check the newly loaded design whether it causes forbidden circular import
IF ImportsOne[importee,
LIST[into.name]]
THEN {
TerminalIO.PutRopes["**", importeeName, " would creates forbidden circular imports\n"];
CDRemote.ForgetCache[into, importeeName];
RETURN [FALSE]
};
-- now we have no direct circular import
-- bind
BindDesign[importer: into, importee: importee, allowSizeConflicts: allowConflicts];
--check all already imported designs for importing the new design
FOR list: ImpEntryList ← GetImportList[into]^, list.rest
WHILE list#
NIL
DO
IF list.first.d#
NIL
AND list.first.d#importee
THEN
BindDesign[importer: list.first.d, importee: importee, allowSizeConflicts: false];
ENDLOOP;
--check the new design for importing of already imported and loaded designs
FOR list: ImpEntryList ← indirectImport^, list.rest
WHILE list#
NIL
DO
IF list.first.d=
NIL
THEN {
--new design did not load..
imp: ImportEntry ← GetImportEntry[into, list.first.importeeName, false];
IF imp#
NIL
THEN {
IF imp.d#
NIL
AND imp.d#importee
THEN
BindDesign[importer: importee, importee: imp.d, allowSizeConflicts: false];
};
}
ENDLOOP;
done ← TRUE;
};
DesignHasBeenRenamed: CDEvents.EventProc = {
-- prevent renaming if it would cause circularity
IF ImportsOne[design,
LIST[design.name]]
THEN {
dont ← TRUE;
TerminalIO.PutRope["rename causes forbidden circular imports\n"]
};
};
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
ReplaceChildrenByImports:
PROC[me:
CD.Object, design:
CD.Design, importeeName:
ROPE] = {
replaceList: CDDirectory.ReplaceList←NIL;
PerChild: CDDirectory.EnumerateObjectsProc = {
--PROC [me: CD.Object, x: REF]
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,
bbox: me.bbox,
ir: CD.InterestRect[me],
autoImport: TRUE, autoLoad: FALSE,
autoCreateOb: TRUE, allowConflicts: true,
include: TRUE
];
replaceList ← CONS[NEW[CDDirectory.ReplaceRec←[old: me, new: impChild]], replaceList];
}
};
--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];
}; --ReplaceChildrenByImports
--OneLevelIncludedCopy
WITH impObject.specific
SELECT
FROM
impPtr: ImportSpecific => {
newOb: CD.Object; tm, cm: CDDirectory.DMode;
import: ImportEntry = GetImportEntry[design, impPtr.designName, false];
IF impPtr.boundInstance=
NIL
OR import=
NIL
OR ~import.loaded
THEN
ERROR CD.Error[callingError, "OneLevelIncludedCopy impObject not bound "];
[newOb, tm, cm] ← CDDirectory.Another[me: impPtr.boundInstance.ob, fromOrNil: import.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, "bad object class"]
};
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] = {
impPtr: ImportSpecific = NARROW[me.specific]; own: REF;
IF into=NIL THEN ERROR;
IF into=fromOrNil THEN RETURN [new: me, topMode: included, childMode: included];
new ← InternalCreateImport[into: into, objectName: impPtr.objectName, importeeName: impPtr.designName, autoCreateOb: TRUE, autoImport: TRUE, allowConflicts: true, include: TRUE, bbox: me.bbox, ir: impPtr.ir, autoLoad: FALSE];
IF new#me
THEN {
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];
};
};
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] = {
impPtr: ImportSpecific = NARROW[me.specific];
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];
};
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.
imp: ImportEntry ← GetImportEntry[into, importeeName, false];
IF imp=
NIL
THEN {
TerminalIO.PutRopes["MergeInImports not done; ", importeeName, " is not imported\n"];
RETURN
};
IF ~imp.loaded
THEN {
TerminalIO.PutRopes["MerginImport not done; ", importeeName, " is not loaded\n"];
RETURN
};
BEGIN
EachOb:
PROC [ob:
CD.Object] = {
pr: ImportSpecific = NARROW[ob.specific];
IF pr.boundInstance#
NIL
THEN {
newOb: CD.Object ← CDGenerate.FetchNCall[context: generatorContext, design: into, key: pr.objectName, cache: TRUE];
IF newOb#
NIL
THEN {
remList ← CONS[pr.objectName, remList];
CDDirectory.ReplaceObject[design: into, old: ob, new: newOb];
IF CDDirectoryOps.RemoveIfUnused[design: into, ob: ob].done
THEN {
[] ← CDDirectory.Rename[into, newOb, pr.objectName];
};
}
}
};
remList: LIST OF ROPE ← NIL;
generatorContext: CDGenerate.Context ← CDRemote.GetContext[imp.importeeName];
CDRemote.CacheDesign[for: into, remote: imp.d];
EachImpOb[imp, EachOb];
FOR l:
LIST
OF
ROPE ← remList, l.rest
WHILE l#
NIL
DO
[] ← SymTab.Delete[NARROW[imp.implData], l.first];
ENDLOOP
END
};
HasUnloadedImports:
PUBLIC
PROC [design:
CD.Design]
RETURNS [yes:
BOOL←
FALSE] = {
checked: RefTab.Ref←RefTab.Create[];
XHasUnloadedImports:
PROC [design:
CD.Design]
RETURNS [yes:
BOOL←
FALSE] = {
CheckObjectLoaded:
PROC [ob:
CD.Object] = {
ip: ImportSpecific = NARROW[ob.specific];
IF ip.boundInstance=NIL THEN ERROR unLoaded;
};
unLoaded: ERROR = CODE;
impList: REF CDImports.ImportListRec = GetImportList[design];
IF impList#
NIL
THEN
FOR list:
LIST
OF
REF CDImports.ImportEntryRec ← 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
EachImpOb[list.first, CheckObjectLoaded ! unLoaded => GOTO HasUnLoaded];
--check for indirect objects; there are no loops; OOPS there are !
IF list.first.d=NIL THEN RETURN [yes ← TRUE];
IF RefTab.Insert[checked, list.first.d, list.first.d]
THEN
RETURN [XHasUnloadedImports[list.first.d]];
}
ENDLOOP;
EXITS HasUnLoaded => RETURN [TRUE]
};
[] ← RefTab.Insert[checked, design, design];
RETURN [XHasUnloadedImports[design]];
};
DirectoryOp:
PROC [me:
CD.Object, design:
CD.Design, name: Rope.
ROPE, function: CDDirectory.DirectoryFunction]
RETURNS [proceed:
BOOL←
TRUE] = {
iPtr: ImportSpecific = NARROW[me.specific];
IF function=rename
THEN {
CDProperties.PutObjectProp[onto: me, prop: nameKey, val: name];
RETURN [proceed←TRUE]
};
IF design=NIL THEN ERROR;
IF function=remove
THEN {
import: ImportEntry ← GetImportEntry[design, iPtr.designName, false];
iPtr.boundInstance ← NIL;
IF import#
NIL
THEN
IF SymTab.Fetch[
NARROW[import.implData], iPtr.objectName].val=me
THEN
[] ← SymTab.Delete[NARROW[import.implData], iPtr.objectName];
};
IF function=include
THEN {
import: ImportEntry ← GetImportEntry[design, iPtr.designName, true];
iPtr.boundInstance ← NIL;
IF import=NIL THEN ERROR;
SELECT SymTab.Fetch[
NARROW[import.implData], iPtr.objectName].val
FROM
me => proceed ← TRUE;
NIL => proceed ← SymTab.Insert[NARROW[import.implData], iPtr.objectName, me];
ENDCASE => proceed ← FALSE;
IF proceed
THEN
CDProperties.PutObjectProp[onto: me, prop: nameKey, val: name];
}
};
DirectorysName:
PROC [me:
CD.Object]
RETURNS [Rope.
ROPE] = {
WITH CDProperties.GetObjectProp[from: me, prop: nameKey]
SELECT
FROM
r: Rope.ROPE => RETURN [r];
ENDCASE => RETURN ["-no name"]
};
nameKey: REF ATOM = NEW[ATOM ← $Name]; -- make it non accessible, non write on file
dirProcs:
REF CDDirectory.DirectoryProcs ~ CDDirectory.InstallDirectoryProcs[importsClass, [
name: DirectorysName,
directoryOp: DirectoryOp,
enumerateChildObjects: EnumerateItsObjects,
replaceDirectChilds: ReplaceDirectChild,
another: Another,
expand: Expand
]];
CDProperties.InstallProcs[prop: nameKey, procs: CDProperties.PropertyProcsRec[exclusive: TRUE]];
CDValue.RegisterKey[importListKey];
CDEvents.RegisterEventProc[$RenameDesign, DesignHasBeenRenamed];
END.