CDImportsImpl.mesa (part of ChipNDale)
Copyright © 1984, 1985 by Xerox Corporation. All rights reserved.
by Christian Jacobi, March 20, 1984 5:50:51 pm PST
last edited Christian Jacobi, April 11, 1985 9:30:55 am PST
DIRECTORY
CD,
CDApplications,
CDCallSpecific,
CDDirectory,
CDEvents,
CDExtras USING [MergeInObjects],
CDImports,
CDImportsExtras,
CDBasics,
CDIO,
CDOps,
CDOrient,
CDProperties,
CDValue,
Rope,
TerminalIO,
CDInterestRects,
TokenIO;
CDImportsImpl: CEDAR PROGRAM
IMPORTS CD, CDApplications, CDDirectory, CDEvents, CDExtras, CDBasics, CDIO, CDOps, CDOrient, CDProperties, CDValue, Rope, TerminalIO, TokenIO, CDInterestRects
EXPORTS CDImports, CDImportsExtras
SHARES CDDirectory =
BEGIN
BoolOrInteractive: TYPE = CDImports.BoolOrInteractive;
ReferencePtr: TYPE = CDImports.ReferencePtr;
ReferenceRep: TYPE = CDImports.ReferenceRep;
ImportList: TYPE = CDImports.ImportList;
Import: TYPE = CDImports.Import;
importListKey: ATOM = $ImportList; -- for CDValue
pForReference: REF CD.ObjectProcs = CD.RegisterObjectType[$Import];
EnumerateItsObjects: PROC [me: CD.ObPtr, p: CDDirectory.EnumerateObjectsProc, x: REF] =
BEGIN
dont !!!
rp: ReferencePtr ~ NARROW[me.specificRef];
IF rp.boundApp#NIL THEN p[rp.boundApp.ob, x];
END;
ReplaceDirectChild: CDDirectory.ReplaceDChildsProc =
-- PROC[me: CD.ObPtr, 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;
InternalCreateReference: PROC [design: CD.Design,
 size: CD.DesignPosition←[1, 1], --ignored if allowConflicts
 ir: CD.DesignRect ← [0, 0, -1, -1],
 objectName, importeeName: Rope.ROPE,
 autoImport: BoolOrInteractive�lse, --creates an import if not already done
 autoCreateOb: BoolOrInteractive�lse, --creates if not found but design available
 allowConflicts: BoolOrInteractive�lse, --allow size conflicts of the object
 include: BOOLTRUE] RETURNS [CD.ObPtr] =
BEGIN
ob: CD.ObPtr;
rp: ReferencePtr;
import: REF Import = GetImport[design, importeeName, autoImport];
probablySize: CD.DesignPosition ← CDBasics.MaxPoint[size, [1, 1]];
iR: CD.DesignRect;
IF CDBasics.NonEmpty[ir] THEN iR ← ir ELSE iR ← CDBasics.RectAt[[0, 0], probablySize];
IF import=NIL THEN RETURN [NIL];
--search first for an already imported object object
FOR list: LIST OF CD.ObPtr ← import.referenceList, list.rest WHILE list#NIL DO
ob ← list.first;
rp ← NARROW[ob.specificRef, ReferencePtr];
IF Rope.Equal[rp.objectName, objectName]
AND Rope.Equal[rp.designName, importeeName] THEN {
IF ob.size=size OR allowConflicts=true THEN RETURN [ob]
ELSE IF allowConflicts=interactive AND TerminalIO.UserSaysYes[
text: "size conflict\n",
label: "ignore?"
] THEN RETURN [ob]
ELSE RETURN [NIL]
};
ENDLOOP;
--already imported object has not been found; make import
IF import.importee#NIL THEN {
found: BOOL;
referedOb: CD.ObPtr;
[found, referedOb] ← CDDirectory.Fetch[import.importee, objectName];
IF ~found THEN {
IF autoCreateOb=false OR (autoCreateOb=interactive AND ~TerminalIO.UserSaysYes[
text: "object not found\n",
label: "ignore?"
]) THEN RETURN [NIL];
}
ELSE {
IF allowConflicts=true THEN {
probablySize ← referedOb.size;
iR ← CD.InterestRect[referedOb];
};
}
};
ob ← NEW[CD.ObjectDefinition←[
size: probablySize,
p: pForReference,
layer: CD.combined,
specificRef: NEW[ReferenceRep ← [
objectName: objectName,
ir: iR,
designName: importeeName
]]
]];
import.referenceList ← CONS[ob, import.referenceList];
IF include THEN [] ← CDDirectory.Include[design: design, object: ob, alternateName: Rope.Cat[importeeName, ".", objectName]];
IF import.importee#NIL THEN [] ← BindReference[design, ob, import.importee, allowConflicts];
RETURN [ob]
END;
GetReference: PUBLIC PROC [design: CD.Design, objectName, importeeName: Rope.ROPE] RETURNS [ob: CD.ObPtr] =
BEGIN
ob ← InternalCreateReference[design: design, objectName: objectName, importeeName: importeeName, autoCreateOb: false, autoImport: false, allowConflicts: true, include: TRUE];
END;
ReferenceName: PROC [me: CD.ObPtr] RETURNS [Rope.ROPE] =
BEGIN
n: Rope.ROPE = CDDirectory.Name[me];
IF Rope.IsEmpty[n] THEN {
rp: ReferencePtr = NARROW[me.specificRef];
RETURN [Rope.Cat[rp.designName, ".", rp.objectName]]
};
RETURN [n]
END;
ShortName: PROC [me: CD.ObPtr, rp: ReferencePtr] RETURNS [Rope.ROPE] = INLINE
BEGIN
n: Rope.ROPE = CDDirectory.Name[me];
IF Rope.IsEmpty[n] THEN {
RETURN [rp.objectName]
};
RETURN [n]
END;
DescribeReference: PROC[me: CD.ObPtr] RETURNS [Rope.ROPE] =
BEGIN
RETURN [Rope.Concat["reference to ", ReferenceName[me]]]
END;
DrawReference: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation,
pr: CD.DrawRef] =
BEGIN
ENABLE UNWIND =>
IF pr.nesting.table[pr.nestDepth-1]=aptr THEN pr.nestDepth ← pr.nestDepth-1;
rp: ReferencePtr = NARROW[aptr.ob.specificRef];
IF rp.boundApp#NIL THEN {
pr.nesting.table[pr.nestDepth] ← aptr;
pr.nestDepth ← pr.nestDepth+1;
pr.drawChild[rp.boundApp, pos, orient, pr];
pr.nestDepth ← pr.nestDepth-1;
}
ELSE {
r: CD.DesignRect = IntRect[aptr.ob, pos, orient];
pr.drawRect[r, CD.highLightShade, pr];
pr.drawComment[r, ShortName[aptr.ob, rp], pr];
}
END;
IntRect: PROC [ob: CD.ObPtr, pos: CD.DesignPosition, orient: CD.Orientation] RETURNS [CD.DesignRect] = INLINE
BEGIN
RETURN [CDOrient.MapRect[
itemInCell: CD.InterestRect[ob],
cellSize: ob.size,
cellInstOrient: orient,
cellInstPos: pos
]]
END;
QuickDrawReference: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation,
pr: CD.DrawRef] =
BEGIN
ENABLE UNWIND =>
IF pr.nesting.table[pr.nestDepth-1]=aptr THEN pr.nestDepth ← pr.nestDepth-1;
rp: ReferencePtr = NARROW[aptr.ob.specificRef];
IF rp.boundApp#NIL THEN {
pr.nesting.table[pr.nestDepth] ← aptr;
pr.nestDepth ← pr.nestDepth+1;
rp.boundApp.ob.p.quickDrawMe[rp.boundApp, pos, orient, pr];
pr.nestDepth ← pr.nestDepth-1;
}
ELSE {
r: CD.DesignRect = IntRect[aptr.ob, pos, orient];
pr.drawRect[r, CD.highLightShade, pr];
pr.drawComment[r, ShortName[aptr.ob, rp], pr];
}
END;
DrawReferenceSelection: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation,
pr: CD.DrawRef] =
BEGIN
rp: ReferencePtr = NARROW[aptr.ob.specificRef];
IF rp.boundApp#NIL THEN
rp.boundApp.ob.p.showMeSelected[rp.boundApp, pos, orient, pr]
ELSE
pr.outLineProc[IntRect[aptr.ob, pos, orient], pr]
END;
InterestRect: PROC [ob: CD.ObPtr] RETURNS [CD.DesignRect] =
BEGIN
RETURN [NARROW[ob.specificRef, ReferencePtr].ir]
END;
WriteRect: PROC[r: CD.Rect] =
BEGIN
TokenIO.WriteInt[r.x1];
TokenIO.WriteInt[r.y1];
TokenIO.WriteInt[r.x2];
TokenIO.WriteInt[r.y2];
END;
ReadRect: PROC [] RETURNS [CD.Rect] =
BEGIN
r: CD.Rect;
r.x1 ← TokenIO.ReadInt[];
r.y1 ← TokenIO.ReadInt[];
r.x2 ← TokenIO.ReadInt[];
r.y2 ← TokenIO.ReadInt[];
RETURN [r]
END;
WriteReference: CD.InternalWriteProc -- PROC [me: ObPtr] -- =
BEGIN
rp: ReferencePtr = NARROW[me.specificRef];
TokenIO.WriteInt[me.size.x];
TokenIO.WriteInt[me.size.y];
WriteRect[rp.ir];
TokenIO.WriteRope[rp.objectName];
TokenIO.WriteRope[rp.designName];
END;
ReadReference: CD.InternalReadProc --PROC [] RETURNS [ObPtr]-- =
BEGIN
x: INT = TokenIO.ReadInt[];
y: INT = TokenIO.ReadInt[];
ir: CD.DesignRect;
objectName: Rope.ROPE;
importeeName: Rope.ROPE;
ob: CD.ObPtr;
IF CDIO.VersionKey[] >= 8 THEN ir ← ReadRect[]
ELSE ir ← CDBasics.RectAt[[0, 0], [x, y]];
objectName ← TokenIO.ReadRope[];
importeeName ← TokenIO.ReadRope[];
ob ← InternalCreateReference[
design: CDIO.DesignInReadOperation[],
ir: ir,
size: [x, y],
objectName: objectName,
autoCreateOb: true,
importeeName: importeeName,
autoImport: true,
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.Store[boundTo: design, key: importListKey, value: imp];
};
END;
GetImport: PUBLIC PROC [design: CD.Design, importeeName: Rope.ROPENIL, createIfNotFound: BoolOrInteractive ← true] RETURNS [REF Import] =
BEGIN
ToBool: PROC[b: BoolOrInteractive, r: Rope.ROPE, default: BOOLTRUE, r2: Rope.ROPENIL] RETURNS [BOOL] =
BEGIN
SELECT b FROM
true => RETURN [TRUE];
false => RETURN [FALSE];
ENDCASE => {
TerminalIO.WriteRope[r];
TerminalIO.WriteRope[r2];
RETURN [TerminalIO.UserSaysYes[r,, default]]
}
END;
mdata: REF Import ← NIL;
impl: REF ImportList = GetImportList[design];
IF Rope.IsEmpty[importeeName] THEN ERROR CD.Error[ec: other,
explanation: "design has empty name, but shouldn't"
];
IF impl#NIL THEN
FOR l: LIST OF REF Import ← 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", TRUE, importeeName] THEN {
mdata ← NEW[Import ← [importeeName: importeeName, importee: NIL, referenceList: NIL]];
impl.list ← CONS[mdata, impl.list]; --atomic--
};
RETURN [mdata]
END;
BindImportee: PROC [importer, importee: CD.Design,
allowSizeConflicts, allowOverload: BoolOrInteractive ← true] =
BEGIN
ENABLE TerminalIO.UserAbort => GOTO UserAborted;
done1: BOOLTRUE;
mdata: REF Import = GetImport[importer, importee.name];
IF mdata=NIL THEN ERROR;
IF mdata.importee#NIL THEN {
IF allowOverload=false THEN RETURN
ELSE IF allowOverload=interactive THEN
IF NOT TerminalIO.UserSaysYes[
text: "design already loaded; shall overload?\n",
label: "overload?"] THEN {
TerminalIO.WriteRope["dont overload; not done\n"];
RETURN
}
};
mdata.importee ← importee;
FOR list: LIST OF CD.ObPtr ← mdata.referenceList, list.rest WHILE list#NIL DO
done1 ← done1 AND BindReference[importer, list.first, mdata.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.ObPtr, importee: CD.Design, allowSizeConflicts: BoolOrInteractive ← true] RETURNS [ok: BOOLFALSE] =
BEGIN
ENABLE TerminalIO.UserAbort => GOTO UserAborted;
rp: ReferencePtr = NARROW[reference.specificRef, ReferencePtr];
found: BOOL;
oldRect, newRect: CD.DesignRect;
referedOb: CD.ObPtr;
[found, referedOb] ← CDDirectory.Fetch[importee, rp.objectName];
IF NOT found THEN {
TerminalIO.WriteRope["entry "];
TerminalIO.WriteRope[rp.objectName];
TerminalIO.WriteRope[" in "];
TerminalIO.WriteRope[importee.name];
TerminalIO.WriteRope[" not found\n"];
RETURN
};
oldRect ← InterestRect[reference];
newRect ← CD.InterestRect[referedOb];
IF newRect#oldRect THEN {
TerminalIO.WriteRope["object "];
TerminalIO.WriteRope[rp.objectName];
TerminalIO.WriteRope[" 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.UserSaysYes[text: "import anyway? ",
label: "import different sized ob?"] THEN {
TerminalIO.WriteRope["no\n"];
RETURN
};
TerminalIO.WriteRope["yes\n"];
};
};
rp.boundApp ← CDApplications.NewApplicationI[ob: referedOb];
rp.boundApp.location ← [0, 0];
BEGIN
oldSize: CD.DesignPosition = reference.size;
oldBase: CD.DesignPosition = CDBasics.BaseOfRect[oldRect];
newSize: CD.DesignPosition = referedOb.size;
newBase: CD.DesignPosition = CDBasics.BaseOfRect[newRect];
IF oldSize#newSize OR oldRect#newRect THEN {
reference.size ← newSize;
rp.ir ← newRect;
CDDirectory.RepositionObject[design: design,
ob: reference,
oldSize: oldSize,
baseOff: CDBasics.SubPoints[oldBase, newBase]
];
};
END;
ok ← TRUE;
EXITS
UserAborted => {TerminalIO.WriteRope["aborted, entry not replaced\n"]};
END;
DoImport: PUBLIC PROC [design: CD.Design, importee: CD.Design,
allowOverload, allowConflicts: BoolOrInteractive←true] RETURNS [done: BOOLFALSE] =
BEGIN
indirectImport: REF ImportList ~ GetImportList[importee];
IF indirectImport^.list#NIL THEN TerminalIO.WriteRope["There are indirect imports\n"];
-- check for forbidden circular import
FOR list: LIST OF REF Import ← indirectImport^, list.rest WHILE list#NIL DO
IF Rope.Equal[list.first.importeeName, design.name] THEN {
TerminalIO.WriteRope["**creates circular imports\n"];
RETURN
}
ENDLOOP;
-- no circular import
BindImportee[importer: design, importee: importee, allowSizeConflicts: allowConflicts, allowOverload: allowOverload];
--check already imported designs for importing the new design
FOR list: LIST OF REF Import ← GetImportList[design]^, list.rest WHILE list#NIL DO
IF list.first.importee#NIL THEN
BindImportee[importer: list.first.importee, importee: importee, allowSizeConflicts: false, allowOverload: true];
ENDLOOP;
--check the new design for importing of already imported designs
FOR list: LIST OF REF Import ← indirectImport^, list.rest WHILE list#NIL DO
IF list.first.importee=NIL THEN {
imp: REF Import ← GetImport[design, list.first.importeeName, false];
IF imp#NIL AND imp.importee#NIL THEN
BindImportee[importer: importee, importee: imp.importee, allowSizeConflicts: false, allowOverload: true];
}
ENDLOOP;
done ← TRUE;
END;
DesignHasBeenRenamed: CDEvents.EventProc
--PROC [event: REF, design: CD.Design, x: REF] RETURNS [dont: BOOLFALSE]-- =
-- prevent a renaming which would cause circularity
BEGIN
imp: REF Import ~ GetImport[design: design, importeeName: design.name, createIfNotFound: false];
IF imp#NIL THEN {
dont ← TRUE;
TerminalIO.WriteRope["rename causes circularities; not done\n"]
};
END;
ReplaceChildrenByImports: PROC[me: CD.ObPtr, design: CD.Design, importeeName: Rope.ROPE] =
BEGIN
replaceList: CDDirectory.ReplaceList←NIL;
PerChild: CDDirectory.EnumerateObjectsProc --PROC [me: CD.ObPtr, x: REF] -- =
BEGIN
IF me.p.inDirectory THEN {
impChild: CD.ObPtr;
FOR list: CDDirectory.ReplaceList ← replaceList, list.rest WHILE list#NIL DO
IF list.first.old=me THEN RETURN -- eliminate duplicates
ENDLOOP;
impChild ← InternalCreateReference[
design: design, objectName: CDDirectory.Name[me], importeeName: importeeName,
size: me.size, autoImport: true, 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.DoReplaceDirectChild[me: me, design: design, replace: replaceList];
END;
OneLevelIncludedCopy: PUBLIC PROC [impObject: CD.ObPtr, design: CD.Design] RETURNS [CD.ObPtr] =
--imp is an imported and bound object which will be made local to design
BEGIN
WITH impObject.specificRef SELECT FROM
rp: ReferencePtr => {
newOb: CD.ObPtr;
import: REF Import = GetImport[design, rp.designName, false];
IF rp.boundApp=NIL OR import=NIL OR import.importee=NIL THEN
ERROR CD.Error[callingError, "OneLevelIncludedCopy impObject not bound "];
newOb ← CDDirectory.Another[me: rp.boundApp.ob, from: import.importee, to: design];
ReplaceChildrenByImports[me: newOb, design: design, importeeName: import.importeeName];
RETURN [newOb]
};
ENDCASE => ERROR CD.Error[callingError, "OneLevelIncludedCopy impObject not reference"]
END;
Another: PROC [me: CD.ObPtr, from, to: CD.Design] RETURNS [CD.ObPtr] =
BEGIN
rp: ReferencePtr = NARROW[me.specificRef];
newOb: CD.ObPtr = InternalCreateReference[design: to, objectName: rp.objectName, importeeName: rp.designName, autoCreateOb: true, autoImport: true, allowConflicts: true, include: TRUE, size: me.size];
newOb.properties ← CDProperties.AppendProps[looser: me.properties, winner: newOb.properties];
IF newOb=NIL THEN ERROR;
RETURN [newOb];
END;
MergeInImport: PUBLIC PROC [design: CD.Design, importeeName: Rope.ROPE] =
--Includes all the imported and bound objects from importeeName (including
--their transitive closure; but not indirect imports) into design.
BEGIN
imp: REF Import ← GetImport[design, importeeName, false];
IF imp=NIL THEN {
TerminalIO.WriteRope["MergeInImport not done; design "];
TerminalIO.WriteRope[importeeName];
TerminalIO.WriteRope[" is not imported\n"];
RETURN
}
ELSE IF imp.importee=NIL THEN {
TerminalIO.WriteRope["MerginImport not done; design "];
TerminalIO.WriteRope[importeeName];
TerminalIO.WriteRope[" is not loaded\n"];
RETURN
}
ELSE {
importee: CD.Design ← imp.importee;
objectList: LIST OF CD.ObPtr ← NIL;
doList: LIST OF CD.ObPtr ← NIL;
dontList: LIST OF CD.ObPtr ← NIL;
--split the reference list in doList and dontList
FOR list: LIST OF CD.ObPtr ← imp.referenceList, list.rest WHILE list#NIL DO
IF NARROW[list.first.specificRef, ReferencePtr].boundApp#NIL THEN
doList ← CONS[list.first, doList]
ELSE dontList ← CONS[list.first, dontList];
ENDLOOP;
imp.importee ← NIL;
imp.referenceList ← dontList;
--merge in objects from doList
FOR list: LIST OF CD.ObPtr ← doList, list.rest WHILE list#NIL DO
pr: ReferencePtr = NARROW[list.first.specificRef];
objectList ← CONS[pr.boundApp.ob, objectList];
ENDLOOP;
CDExtras.MergeInObjects[design: design, from: importee, objects: objectList];
--now remove old references
FOR list: LIST OF CD.ObPtr ← doList, list.rest WHILE list#NIL DO
[] ← CDDirectory.Remove[design: design,
name: CDDirectory.Name[list.first],
expectObject: list.first
]
ENDLOOP;
FOR list: LIST OF CD.ObPtr ← doList, list.rest WHILE list#NIL DO
pr: ReferencePtr = NARROW[list.first.specificRef];
CDDirectory.ReplaceObject[design: design, old: list.first, new: pr.boundApp.ob]
ENDLOOP;
}
END;
HasUnloadedImports: PUBLIC PROC [design: CD.Design] RETURNS [yes: BOOLFALSE] =
BEGIN
impList: REF CDImports.ImportList = GetImportList[design];
IF impList#NIL THEN
FOR list: LIST OF REF CDImports.Import ← impList^, list.rest WHILE list#NIL DO
IF list.first.importee=NIL THEN {
RETURN [yes ← TRUE]
}
ENDLOOP;
END;
OldSetInterest: PROC [ob: CD.ObPtr, r: CD.DesignRect] =
BEGIN
cptr: ReferencePtr = NARROW[ob.specificRef];
cptr.ir ← r;
END;
Init: PROC [] =
BEGIN
rp: REF CDDirectory.DirectoryProcs ~ CDDirectory.InstallDirectoryProcs[pForReference];
rp.enumerateChildObjects ← EnumerateItsObjects;
rp.replaceDirectChilds ← ReplaceDirectChild;
rp.another ← Another;
pForReference.drawMe ← DrawReference;
pForReference.quickDrawMe ← QuickDrawReference;
pForReference.showMeSelected ← DrawReferenceSelection;
pForReference.internalRead ← ReadReference;
pForReference.internalWrite ← WriteReference;
pForReference.describe ← DescribeReference;
pForReference.interestRect ← InterestRect;
CDInterestRects.InstallOldSetInterest[pForReference, OldSetInterest];
CDValue.EnregisterKey[importListKey];
CDEvents.RegisterEventProc[$RenameDesign, DesignHasBeenRenamed];
END;
Init[];
END.