CDImportsImpl.mesa (part of ChipNDale)
Copyright © 1984, 1986, 1987 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, March 20, 1984 5:50:51 pm PST
Last edited by: Christian Jacobi, October 19, 1987 2:24:28 pm PDT
DIRECTORY
BasicTime,
CD,
CDBasics,
CDDesignCache,
CDDirectory,
CDEvents,
CDImports,
CDIO,
CDOps,
CDProperties,
CDSequencer,
CDValue,
CedarProcess,
RefTab,
Rope,
SymTab,
TerminalIO,
TokenIO;
CDImportsImpl:
CEDAR
PROGRAM
IMPORTS CD, CDBasics, CDDirectory, CDDesignCache,
CDEvents, CDImports, CDIO, CDOps, CDProperties, CDSequencer, CDValue, CedarProcess, RefTab, Rope, SymTab, TerminalIO, TokenIO
EXPORTS CDImports
SHARES CDDirectory =
BEGIN OPEN CDImports;
ROPE: TYPE = Rope.ROPE;
Object: TYPE = CD.Object;
Design: TYPE = CD.Design;
cacheListKey: ATOM = $CacheList; -- a CDValue key
importsClass:
PUBLIC
CD.ObjectClass =
CD.RegisterObjectClass[$Import, [
drawMe: DrawForImport,
quickDrawMe: QuickDrawReference,
showMeSelected: DrawSelectionForImport,
internalRead: ReadImportOb,
internalWrite: WriteImportOb,
describe: DescribeImport,
interestRect: ImportIR,
xDesign: TRUE
]];
CacheL: TYPE = LIST OF Cache;
EnumerateItsObjects:
PROC [me: Object, proc: CDDirectory.EachObjectProc, data:
REF]
RETURNS [quit:
BOOL←
FALSE] = {
dont !!!
the imported objects are not accessible for this design
};
ReplaceDirectChild: CDDirectory.ReplaceDChildsProc = {
can't replace children
the imported objects are not accessible for this design
};
FetchImport:
PUBLIC
PROC [into: Design, objectName, importeeName:
ROPE]
RETURNS [Object←
NIL] = {
cache: Cache ← GetCache[into, importeeName, false];
IF cache#
NIL
THEN {
WITH SymTab.Fetch[cache.objects, objectName].val
SELECT
FROM
ob1: Object => {
IF CDDirectory.CompatibleOwner[into, ob1] THEN RETURN [ob1];
[] ← SymTab.Delete[cache.objects, objectName];
};
ENDCASE => NULL;
};
};
CreateImportFromCache:
PUBLIC
PROC [into: Design, objectName, importeeName:
ROPE, load:
BOOL]
RETURNS [ob: Object←
NIL] = {
cache: Cache ← GetCache[into, importeeName, IF load THEN true ELSE false];
ob ← FetchImport[into, objectName, importeeName];
IF ob#NIL THEN RETURN [ob];
IF cache#
NIL
AND cache.importee=
NIL
AND load
THEN
[] ← LoadAndBindDesign[into: into, importeeName: importeeName, forceBind: FALSE, allowConflicts: false];
IF cache#
NIL
AND cache.importee#
NIL
THEN
ob ← CreateImportWithSource[into, objectName, cache.importee, FALSE];
};
CreateImport:
PROC [into: Design, objectName, importeeName:
ROPE, ir, bbox:
CD.Rect, doCache:
BOOL←
TRUE]
RETURNS [ob: Object] = {
ob ←
NEW[
CD.ObjectRep←[
bbox: bbox,
class: importsClass,
specific:
NEW[ImportRep ← [ir: ir,
objectName: objectName, designName: importeeName
]]
]];
IF into#
NIL
THEN {
IF doCache
THEN {
cache: Cache ← GetCache[into, importeeName, true];
IF cache#NIL THEN [] ← SymTab.Store[cache.objects, objectName, ob];
};
CDDirectory.SetOwner[into, ob];
}
};
CreateImportWithoutSource:
PUBLIC
PROC [into: Design, objectName, importeeName:
ROPE, ir, bbox:
CD.Rect, exact: BoolOrInteractive]
RETURNS [ob: Object] = {
cache: Cache ← GetCache[into, importeeName, true];
IF ~CDBasics.NonEmpty[bbox] THEN bbox ← ir;
IF ~CDBasics.NonEmpty[ir] THEN ir ← bbox;
IF exact=true AND ~CDBasics.NonEmpty[ir] THEN RETURN [NIL];
bbox ← CDBasics.Surround[bbox, ir];
ob ← FetchImport[into, objectName, importeeName];
IF ob=
NIL
AND cache#
NIL
AND cache.importee#
NIL
THEN
ob ← CreateImportWithSource[into, objectName, cache.importee, FALSE];
IF ob#
NIL
THEN {
IF ob.bbox=bbox AND CD.InterestRect[ob]=ir THEN RETURN [ob];
IF exact=false THEN RETURN [ob];
IF exact#true
THEN
IF ~ToBool[exact, Rope.Cat["size missmatch for ",
CD.Describe[ob], "enforce exact size"]]
THEN RETURN [ob];
};
ob ← CreateImport[into, objectName, importeeName, ir, bbox, FALSE];
IF cache#NIL THEN [] ← SymTab.Store[cache.objects, objectName, ob];
};
CreateImportWithSource:
PUBLIC
PROC [into: Design, objectName:
ROPE, source: Design, exact:
BOOL]
RETURNS [ob: Object] = {
obx: Object;
IF source.mutability#readonly THEN ERROR CD.Error[calling];
ob ← FetchImport[into, objectName, source.name];
IF ob#
NIL
THEN {
IF ~exact THEN RETURN [ob];
IF NARROW[ob.specific, CDImports.ImportSpecific].boundDesign=source THEN RETURN [ob];
ob ← NIL;
};
obx ← CDDirectory.Fetch[source, objectName];
IF obx#
NIL
THEN {
ob ←
NEW[
CD.ObjectRep←[
class: importsClass,
bbox: obx.bbox,
specific:
NEW[CDImports.ImportRep←[
boundOb: obx,
boundDesign: source,
ir: CD.InterestRect[obx],
objectName: objectName,
designName: source.name
]]
]];
IF into#
NIL
THEN {
cache: Cache ← GetCache[into, source.name, true];
IF cache#
NIL
THEN {
[] ← SymTab.Store[cache.objects, objectName, ob];
IF cache.importee=NIL THEN cache.importee ← source;
};
CDDirectory.SetOwner[into, ob];
};
};
};
DescribeImport:
CD.DescribeProc = {
iPtr: ImportSpecific = NARROW[ob.specific];
RETURN [Rope.Cat["reference to ", iPtr.designName, ".", iPtr.objectName]];
};
DrawForImport:
CD.DrawProc = {
iPtr: ImportSpecific = NARROW[ob.specific];
IF iPtr.boundOb#NIL THEN pr.drawChild[pr, iPtr.boundOb, trans]
ELSE {
r: CD.Rect = CDBasics.MapRect[CD.InterestRect[ob], trans];
pr.drawRect[pr, r, CD.shadeLayer];
pr.drawComment[pr, r, iPtr.objectName];
}
};
QuickDrawReference:
CD.DrawProc = {
iPtr: ImportSpecific = NARROW[ob.specific];
IF iPtr.boundOb#
NIL
THEN
iPtr.boundOb.class.quickDrawMe[pr, iPtr.boundOb, trans]
ELSE {
r: CD.Rect = CDBasics.MapRect[CD.InterestRect[ob], trans];
pr.drawRect[pr, r, CD.shadeLayer];
pr.drawComment[pr, r, iPtr.objectName];
}
};
DrawSelectionForImport:
CD.DrawProc = {
iPtr: ImportSpecific = NARROW[ob.specific];
IF iPtr.boundOb#
NIL
THEN
iPtr.boundOb.class.showMeSelected[pr, iPtr.boundOb, trans]
ELSE
pr.drawOutLine[pr, CDBasics.MapRect[CD.InterestRect[ob], trans], CD.selectionLayer]
};
ImportIR:
PROC [ob: Object]
RETURNS [
CD.Rect] = {
RETURN [NARROW[ob.specific, ImportSpecific].ir]
};
WriteImportOb:
CD.InternalWriteProc = {
iPtr: ImportSpecific = NARROW[ob.specific];
CDIO.WriteRect[h, ob.bbox];
CDIO.WriteRect[h, iPtr.ir];
TokenIO.WriteRope[h, iPtr.objectName];
TokenIO.WriteRope[h, iPtr.designName];
};
ReadImportOb:
CD.InternalReadProc = {
bbox, ir: CD.Rect; objectName, importeeName: ROPE; ob: 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 ← CreateImport[
into: CDIO.DesignInReadOperation[h],
ir: ir, bbox: bbox,
objectName: objectName, importeeName: importeeName,
doCache: TRUE
];
IF ob=NIL THEN ERROR;
RETURN [ob]
};
GetCacheList:
PUBLIC
PROC [design: Design]
RETURNS [cacheL: CacheList] = {
WITH CDValue.Fetch[design, cacheListKey, design]
SELECT
FROM
cacheL: CacheList => RETURN[cacheL];
ENDCASE => {
cacheL ← NEW[CacheListRec ← [list: NIL]];
[] ← CDValue.StoreConditional[boundTo: design, key: cacheListKey, value: cacheL];
RETURN [GetCacheList[design]]
};
};
NameTest:
PROC [into: 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]
};
};
CheckNaming:
PROC [into: Design, importeeName:
ROPE] =
INLINE {
IF Rope.IsEmpty[importeeName]
THEN
ERROR CD.Error[ec: other, explanation: "can't import design with empty name"];
IF into#
NIL
AND Rope.Equal[into.name, importeeName]
THEN
ERROR CD.Error[ec: other, explanation: "can't import design with equal name"];
};
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]]
}
};
GetCache:
PUBLIC
PROC [into: Design, importeeName:
ROPE←
NIL, createIfNotFound: BoolOrInteractive ← true]
RETURNS [cache: Cache←
NIL] = {
--get the entry in design into telling about importing importeeName
cacheL: CacheList;
IF Rope.IsEmpty[importeeName] THEN RETURN [NIL];
IF into=NIL THEN RETURN [NIL];
IF Rope.Equal[into.name, importeeName] THEN RETURN [NIL];
cacheL ← GetCacheList[into];
IF cacheL#
NIL
THEN
FOR l: CacheL ← cacheL.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 {
cache ←
NEW[CacheRec ← [
importeeName: importeeName, objects: SymTab.Create[]
]];
cacheL.list ← CONS[cache, cacheL.list]; --should be atomic--
};
};
DoCacheDesign:
PUBLIC
PROC [into:
CD.Design, importee:
CD.Design] = {
cache: Cache ← GetCache[into, importee.name];
IF importee.mutability#readonly THEN ERROR;
IF cache#NIL THEN cache.importee ← importee;
};
BindDesign:
PROC [importer, importee: Design, allowSizeConflicts: BoolOrInteractive ← true, forceBind:
BOOL←
FALSE] = {
--No caching involved
done: BOOL ← TRUE;
EachObjectProc: CDDirectory.EachObjectProc = {
IF CDImports.IsImport[me]
THEN {
imp: CDImports.ImportSpecific ← NARROW[me.specific];
IF Rope.Equal[imp.designName, importee.name]
THEN
IF forceBind
OR imp.boundOb=
NIL
THEN
IF ~ReBindObject[importer, me, importee, allowSizeConflicts].ok THEN done ← FALSE
}
};
CheckNaming[importer, importee.name];
IF importer=NIL OR importee=NIL THEN ERROR;
IF importee.mutability#readonly THEN ERROR;
[] ← CDDirectory.EnumerateDesign[design: importer, proc: EachObjectProc];
IF ~done
THEN
TerminalIO.PutRopes["some imported object from ", importee.name, " not bound\n"];
CDOps.Redraw[importer];
};
ReBindObject:
PUBLIC PROC [design: Design, ob: Object, importee: Design, allowSizeConflicts: BoolOrInteractive ← true]
RETURNS [ok:
BOOL←
FALSE] = {
--No caching involved
iPtr: ImportSpecific = NARROW[ob.specific, ImportSpecific];
oldIr, newIr, oldBb, newBb: CD.Rect;
referedOb: 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
};
IF ob.immutable
THEN {
TerminalIO.PutF["can not re-bind immutable object %g\n",
[rope[CD.Describe[ob, NIL, design]]]
];
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.boundOb ← referedOb;
iPtr.boundDesign ← importee;
CDDirectory.PropagateChange[ob, design];
ok ← TRUE;
}
ELSE {
--size conflict
r:
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"]; RETURN
};
IF allowSizeConflicts=interactive
AND ~TerminalIO.Confirm["size conflict; import anyway"]
THEN {
TerminalIO.PutRope["don't resolve\n"]; RETURN
};
IF OccursInDrawing[ob, referedOb]
THEN {
TerminalIO.PutF["re-binding %g would cause circularity; object not bound\n",
[rope[CD.Describe[ob]]]
];
RETURN
};
--XXX check circularity
iPtr.boundOb ← referedOb;
iPtr.boundDesign ← importee;
--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[design, ob, ob, trans];
}
ELSE {
TerminalIO.PutRopes[" keep origin at constant position\n"];
CDDirectory.PropagateResize[design, ob];
};
CDDirectory.PropagateChange[ob, design];
ok ← TRUE;
};
};
EnsureCacheing:
PROC [into: Design] = {
--enumerates design to make sure it has caches for all direct imports
EachObjectProc: CDDirectory.EachObjectProc = {
IF CDImports.IsImport[me]
THEN {
imp: CDImports.ImportSpecific ← NARROW[me.specific];
cache: Cache ← GetCache[into, imp.designName, true];
IF cache#NIL THEN [] ← SymTab.Insert[cache.objects, imp.objectName, me];
}
};
[] ← CDDirectory.EnumerateDesign[design: into, proc: EachObjectProc];
};
LoadAndBindDesign:
PUBLIC
PROC [into: Design, importeeName:
ROPE, allowConflicts: CDImports.BoolOrInteractive←true, forceBind:
BOOL←
FALSE, useCache:
BOOL←
FALSE, fileName: Rope.
ROPE←
NIL, forceFile:
BOOL←
FALSE]
RETURNS [done:
BOOL←
FALSE] = {
Check: CDDesignCache.CheckProc = {
ok ← TRUE; -- ??? ~HasUnloadedImports[design].yes
};
indirectCaches: CacheList; importee: Design; cache: Cache;
time: BasicTime.GMT ← BasicTime.nullGMT;
IF into=NIL OR NameTest[into, importeeName].fail THEN RETURN [done←FALSE];
IF ~forceFile THEN importee ← CDDesignCache.Fetch[into, importeeName];
IF importee=
NIL
OR ~useCache
THEN {
importee ← CDDesignCache.GetOrRead[for: into, remoteName: importeeName, remoteFile: fileName, reload: ~useCache, checkFile: TRUE, check: Check].remote;
};
IF importee=
NIL
THEN {
TerminalIO.PutRopes["load import ", importeeName, " not done\n"];
RETURN [FALSE]
};
EnsureCacheing[importee];
EnsureCacheing[into];
indirectCaches ← GetCacheList[importee];
IF indirectCaches^.list#NIL THEN TerminalIO.PutRope["there are indirect imports\n"];
-- bind
cache ← GetCache[into, importeeName, true];
IF cache=NIL THEN RETURN [done←FALSE];
cache.importee ← importee;
BindDesign[importer: into, importee: importee, allowSizeConflicts: allowConflicts, forceBind: forceBind];
--check all already imported designs for importing the new design
FOR list: CacheL ← GetCacheList[into]^, list.rest
WHILE list#
NIL
DO
IF ~Rope.Equal[list.first.importeeName, importeeName]
AND list.first.importee#
NIL
THEN {
cache: Cache ← GetCache[list.first.importee, importeeName, false];
IF cache#
NIL
THEN {
IF cache.importee=NIL OR forceBind THEN cache.importee ← importee;
};
BindDesign[importer: list.first.importee, importee: importee, allowSizeConflicts: false, forceBind: forceBind];
}
ENDLOOP;
--check the new design for importing of already imported and loaded designs
FOR list: CacheL ← indirectCaches^, list.rest
WHILE list#
NIL
DO
iCache: Cache ← list.first;
IF ~Rope.Equal[iCache.importeeName, into.name]
THEN {
originalCache: Cache ← GetCache[into, iCache.importeeName, true];
IF originalCache#NIL THEN iCache.importee ← originalCache.importee;
IF iCache.importee#
NIL
THEN
BindDesign[importer: importee, importee: iCache.importee, allowSizeConflicts: false];
}
ENDLOOP;
done ← TRUE;
};
LoadAndBindAll:
PUBLIC PROC [into:
CD.Design, allowConflicts: BoolOrInteractive←true, forceBind:
BOOL←
FALSE]
RETURNS [done:
BOOL�LSE] = {
done1: BOOL←TRUE;
CheckOne:
PROC [d:
CD.Design] = {
IF d#
NIL
THEN
FOR list: CacheL ← GetCacheList[d]^, list.rest
WHILE list#
NIL
DO
[] ← SymTab.Insert[toTreat, list.first.importeeName, $y];
ENDLOOP;
};
TreatOne: SymTab.EachPairAction = {
name: Rope.ROPE ← key; cache: Cache;
IF SymTab.Fetch[treated, name].found THEN RETURN;
CedarProcess.CheckAbort[NIL];
IF CDSequencer.Aborted[into]
THEN {
TerminalIO.PutRope["interrupted\n"]; done1 ← FALSE; [] ← SymTab.Erase[toTreat];
RETURN [quit ← TRUE];
};
IF ~LoadAndBindDesign[into: into, importeeName: name, allowConflicts: allowConflicts, forceBind: forceBind, useCache:
TRUE]
THEN {
done1 ← FALSE
};
IF ~Rope.Equal[into.name, name]
THEN {
cache ← GetCache[into, name];
IF cache#NIL THEN CheckOne[cache.importee];
};
[] ← SymTab.Insert[treated, name, $x];
quit ← TRUE;
};
toTreat: SymTab.Ref ← SymTab.Create[];
treated: SymTab.Ref ← SymTab.Create[];
EnsureCacheing[into];
CheckOne[into];
WHILE SymTab.Pairs[toTreat, TreatOne] DO {} ENDLOOP;
done ← done1;
};
DesignRenameEventProc: CDEvents.EventProc = {
newName: Rope.ROPE ← NIL;
WITH x
SELECT
FROM
r: Rope.ROPE => newName ← r;
ENDCASE => NULL;
IF design=NIL THEN RETURN;
IF design.mutability=readonly
THEN {
TerminalIO.PutF["don't rename design %g to %g; it is read only\n", [rope[design.name]], [rope[newName]]];
RETURN [dont ← TRUE];
};
--The test for circular imports is too weak: it recognizes problems only when imports are
--cached. However, in case of interactive operations imports will be cached; bad use from
--programs does not worry me, since the programs can be rerun after fixing.
--In case of empty caching: too bad write the design and read it in again, then the cache
--will be gone
IF newName#
NIL
THEN {
cache: Cache ← GetCache[design, newName, false];
IF cache#
NIL
THEN {
TerminalIO.PutF["don't rename design %g to %g; it would create circular imports or caching problems\n", [rope[design.name]], [rope[newName]]];
RETURN [dont ← TRUE];
};
};
};
LocalCopy:
PUBLIC
PROC [into: Design, import: Object]
RETURNS [Object] = {
--imp is an imported and bound object which will be made local to design
InRepList:
PROC [rl: CDDirectory.ReplaceList, ob: Object]
RETURNS [
BOOL←
FALSE] = {
FOR list: CDDirectory.ReplaceList ← rl, list.rest
WHILE list#
NIL
DO
IF list.first.old=ob THEN RETURN [TRUE];
ENDLOOP;
};
ReplaceChildrenByImports:
PROC [me: Object, design: Design, fromDesign: Design] = {
--but makes copy of children which are not importable because they don't have a name
replaceList: CDDirectory.ReplaceList ← NIL;
PerChild: CDDirectory.EachObjectProc = {
child: Object;
IF me.class.composed
THEN {
IF InRepList[replaceList, me] THEN RETURN; -- eliminate duplicates
IF CDDirectory.IsIncluded[fromDesign, me]
THEN {
child ← CreateImportWithSource[into: design, objectName: CDDirectory.Name[me, fromDesign], source: fromDesign, exact: FALSE];
IF child=
NIL
OR
CD.InterestRect[child]#
CD.InterestRect[me]
OR child.bbox#me.bbox
THEN
child ← CreateImportWithoutSource[into: design, objectName: CDDirectory.Name[me, fromDesign], importeeName: fromDesign.name, ir: CD.InterestRect[me], bbox: me.bbox, exact: true];
IF child=NIL THEN ERROR;
}
ELSE {
ca: BOOL;
[child, ca] ← CDDirectory.Another1[me: me, fromOrNil: fromDesign, into: design];
IF child=NIL THEN ERROR;
IF ~ca
THEN
ReplaceChildrenByImports[me: me, design: design, fromDesign: fromDesign];
};
replaceList ← CONS[NEW[CDDirectory.ReplaceRec←[old: me, new: child]], replaceList];
}
};
--build list of direct children
[] ← CDDirectory.EnumerateChildObjects[me: me, proc: PerChild];
--replace each direct child by an import
IF replaceList#
NIL
THEN
[] ← CDDirectory.ReplaceDirectChild[me: me, design: design, replace: replaceList];
}; --ReplaceChildrenByImports
--LocalCopy
WITH import.specific
SELECT
FROM
impPtr: ImportSpecific => {
newOb: Object; ca: BOOL;
IF impPtr.boundDesign=NIL THEN ERROR;
[newOb, ca] ← CDDirectory.Another1[me: impPtr.boundOb, fromOrNil: impPtr.boundDesign, into: into];
IF newOb=NIL THEN ERROR;
IF ~ca
THEN
ReplaceChildrenByImports[me: newOb, design: into, fromDesign: impPtr.boundDesign];
RETURN [newOb]
};
ENDCASE => ERROR CD.Error[calling, "bad object class"]
};
Another1:
PROC [me: Object, fromOrNil: Design, into: Design, friendly:
BOOL]
RETURNS [new:
CD.Object←
NIL, childAccessible:
BOOL←
TRUE] = {
impPtr: ImportSpecific = NARROW[me.specific]; own: REF;
IF into=fromOrNil AND into#NIL THEN RETURN [me, TRUE];
IF into#
NIL
THEN {
IF into=impPtr.boundDesign
AND impPtr.boundOb#
NIL
THEN {
--Don't; we better give the real thing back
[new, childAccessible] ← CDDirectory.Another1[me: impPtr.boundOb, fromOrNil: impPtr.boundDesign, into: into, friendly: friendly];
RETURN [new←impPtr.boundOb, childAccessible←TRUE];
};
IF Rope.Equal[into.name, impPtr.designName]
THEN {
x: CD.Object ← CDDirectory.Fetch[into, impPtr.objectName];
IF x#
NIL
THEN {
new ← x; childAccessible ← TRUE
--what about a bbox, ir check?
--Don't; we better give the real thing back
[new, childAccessible] ← CDDirectory.Another1[me: x, fromOrNil: into, into: into, friendly: friendly];
};
RETURN;
};
};
new ← FetchImport[into: into, objectName: impPtr.objectName, importeeName: impPtr.designName];
IF new=
NIL
AND impPtr.boundOb#
NIL
AND impPtr.boundDesign#
NIL
THEN
new ← CreateImportWithSource[into: into, objectName: impPtr.objectName, source: impPtr.boundDesign, exact: FALSE];
IF new=
NIL
OR impPtr.ir#
CD.InterestRect[new]
OR me.bbox#new.bbox
THEN
new ← CreateImportWithoutSource[into: into, objectName: impPtr.objectName, importeeName: impPtr.designName, ir: impPtr.ir, bbox: me.bbox, exact: true];
IF new=
NIL
THEN {
cache: Cache ← GetCache[into, impPtr.designName, true];
new ←
NEW[
CD.ObjectRep ← [
bbox: impPtr.boundOb.bbox,
class: importsClass,
layer: CD.undefLayer,
specific: NEW[ImportRep ← impPtr^]
]];
IF cache#
NIL
THEN {
[] ← SymTab.Store[cache.objects, impPtr.objectName, new];
IF cache.importee=NIL THEN cache.importee ← impPtr.boundDesign;
CDDirectory.SetOwner[into, new];
}
};
IF new#me
THEN {
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←
NIL, into:
CD.Design←
NIL, friendly:
BOOL←
FALSE]
RETURNS [new:
CD.Object←
NIL, topAccessible:
BOOL←
FALSE, childAccessible:
BOOL←
FALSE] = {
impPtr: ImportSpecific = NARROW[me.specific];
IF impPtr.boundOb=NIL THEN RETURN []; --can not expand unloaded object
IF into#
NIL
--AND friendly--
THEN {
[me, childAccessible] ← CDDirectory.Another1[me: me, fromOrNil: fromOrNil, into: into];
IF me#
NIL
THEN {
IF ~CDImports.IsImport[me] THEN RETURN [me, TRUE, childAccessible];
new ← LocalCopy[import: me, into: into];
IF new#NIL THEN RETURN [new, TRUE, TRUE];
};
};
RETURN [impPtr.boundOb, FALSE, FALSE];
};
DeleteListFromSymTab:
PROC [ref: SymTab.Ref, list:
LIST
OF
ROPE] = {
FOR l:
LIST
OF
ROPE ← list, l.rest
WHILE l#
NIL
DO
[] ← SymTab.Delete[ref, l.first];
ENDLOOP
};
MergeInImports:
PUBLIC
PROC [into: Design, importeeName:
ROPE] = {
--Includes all the imported and bound objects from importeeName (including
--their transitive closure; but not indirect imports) into design.
obList: LIST OF CD.Object;
cnt: INT ← 0;
objectCache: RefTab.Ref ← RefTab.Create[];
cache: Cache ← GetCache[into, importeeName, false];
ListFirst: CDDirectory.EachObjectProc = {
--this is a separate step because we want to modify and enumerate directory independent
WITH me.specific
SELECT
FROM
imp: CDImports.ImportSpecific =>
IF imp.boundOb#
NIL
THEN
IF Rope.Equal[imp.designName, importeeName, TRUE] THEN obList ← CONS[me, obList]
ENDCASE => {};
};
PutCache: CDDirectory.PutInCacheProc = {
CDProperties.PutObjectProp[cacheOb, $CameFrom, importeeName];
CDProperties.PutObjectProp[cacheOb, $OriginalName, CDDirectory.Name[forOb, NARROW[data]]];
};
ReplaceObject:
PROC [me:
CD.Object] = {
WITH me.specific
SELECT
FROM
imp: CDImports.ImportSpecific => {
new: CD.Object ← CDDirectory.AnotherRecursed[me: imp.boundOb, into: into, fromOrNil: imp.boundDesign, cx: objectCache, putInCache: PutCache, data: imp.boundDesign];
IF new#
NIL
THEN {cnt ← cnt+1;
CDDirectory.ReplaceObject[design: into, old: me, new: new];
--The object should not really be used anymore
-- but it might itself be contained in the directory.
--Do not check whether CDDirectory.ReplaceObject missed an instance due
-- to funny classes; bad luck but nothing really bad would happen.
IF CDDirectory.IsIncluded[into, me]
THEN {
[] ← CDDirectory.Remove[design: into, name: CDDirectory.Name[me, into]];
--Put merged-in object into the directory, iff original was.
[] ← CDDirectory.Rename[design: into, object: new, newName: imp.objectName, fiddle: FALSE, fiddleFirst: TRUE];
};
IF cache#NIL THEN [] ← SymTab.Delete[cache.objects, imp.objectName];
};
}
ENDCASE => ERROR;
};
--Improvement: find already merged in objects;
--objectCache ← BuildObjectCache[];
[] ← CDDirectory.EnumerateDesign[design: into, proc: ListFirst];
FOR ol:
LIST
OF
CD.Object ← obList, ol.rest
WHILE ol#
NIL
DO
ReplaceObject[ol.first]
ENDLOOP;
TerminalIO.PutF["%g objects merged in from %g into %g\n", [integer[cnt]], [rope[importeeName]], [rope[CD.DesignName[into]]]];
};
HasUnloadedImports:
PUBLIC
PROC [design: Design, object:
CD.Object←
NIL, recurse:
BOOL←
TRUE]
RETURNS [yes:
BOOL←
FALSE, where:
LIST
OF Object←
NIL] = {
checked: RefTab.Ref ← RefTab.Create[];
EachObjectProc: CDDirectory.EachObjectProc = {
IF me.class.xDesign
THEN {
WITH me.specific
SELECT
FROM
imp: CDImports.ImportSpecific => {
IF imp.boundOb=NIL THEN {quit ← TRUE; where ← CONS[me, where]}
ELSE
IF recurse
THEN {
where ← CONS[me, where];
quit ← CDDirectory.EnumerateObject[ob: imp.boundOb, proc: EachObjectProc, visited: checked];
IF ~quit
THEN {
[] ← RefTab.Insert[checked, imp.boundOb, NIL];
where ← where.rest
}
};
}
ENDCASE => {
TerminalIO.PutRopes[CD.Describe[me], " is funny class; we dont know how to check this class for unloaded imports\n"];
};
};
};
IF design#
NIL
THEN
yes ← CDDirectory.EnumerateDesign[design: design, proc: EachObjectProc, visited: checked];
IF object#
NIL
AND ~yes
THEN
yes ← EachObjectProc[object];
};
OccursInDrawing:
PUBLIC
PROC [x:
CD.Object, in:
CD.Object]
RETURNS [yes:
BOOL←
FALSE] = {
h: REF HandleRec ~ NEW[HandleRec ← [seen: RefTab.Create[], x: x]];
pr: CD.DrawRef ~ CD.CreateDrawRef[[drawChild: PrunedDrawChild, devicePrivate: h]];
CD.DrawOb[pr, in ! found => {yes←TRUE; CONTINUE}];
};
found: ERROR = CODE;
HandleRec: TYPE = RECORD [seen: RefTab.Ref, x: CD.Object];
PrunedDrawChild:
CD.DrawProc = {
h: REF HandleRec ← NARROW[pr.devicePrivate];
IF ob=h.x THEN ERROR found;
IF ob.class.composed
AND RefTab.Insert[h.seen, ob, $x]
THEN
CD.DrawOb[pr: pr, ob: ob, trans: trans, readOnlyInstProps: readOnlyInstProps];
};
DirectoryOp:
PROC [me: Object, design: Design, name:
ROPE, function: CDDirectory.DirectoryFunction] = {
IF design#
NIL
AND function#remove
THEN {
iPtr: ImportSpecific = NARROW[me.specific];
cache: Cache ← GetCache[design, iPtr.designName, true];
IF cache#
NIL
THEN
[] ← SymTab.Insert[cache.objects, iPtr.objectName, me];
};
};
FindCachedDesign:
PUBLIC
PROC [designName: Rope.
ROPE, fileName: Rope.
ROPE←
NIL, createdTime: BasicTime.
GMT ← BasicTime.nullGMT, checkUnloadedImps:
BOOL←
FALSE]
RETURNS [found:
CD.Design←
NIL] = {
Check: CDDesignCache.CheckProc = {
ok ← ~checkUnloadedImps OR ~HasUnloadedImports[design].yes
};
RETURN [CDDesignCache.Search[designName, fileName, createdTime, Check]]
};
dirProcs:
REF CDDirectory.DirectoryProcs ~ CDDirectory.InstallDirectoryProcs[importsClass, [
directoryOp: DirectoryOp,
enumerateChildObjects: EnumerateItsObjects,
replaceDirectChilds: ReplaceDirectChild,
another: Another1,
expand: Expand
]];
CDValue.RegisterKey[cacheListKey];
CDEvents.RegisterEventProc[$BeforeRenameDesign, DesignRenameEventProc];
END.