CDDirectoryImpl.mesa (part of ChipNDale)
Copyright © 1983, 1986 by Xerox Corporation. All rights reserved.
by Christian Jacobi, June 24, 1983 5:00 pm
last edited Christian Jacobi, March 25, 1986 1:58:47 pm PST
Last Edited by: Jacobi July 14, 1986 4:59:39 pm PDT
DIRECTORY
CD,
CDInstances,
CDCallSpecific,
CDCells,
CDDirectory,
CDEvents,
CDBasics,
CDOrient,
CDOps,
CDProperties,
CDRects,
CDValue,
HashTable,
IO,
PropertyLists,
Rope,
TerminalIO;
CDDirectoryImpl:
CEDAR
MONITOR
IMPORTS CD, CDInstances, CDDirectory, CDCells, CDEvents, CDBasics, CDOps, CDOrient, CDProperties, CDRects, CDValue, HashTable, IO, PropertyLists, Rope, TerminalIO
EXPORTS CDDirectory
SHARES CD, CDCells =
BEGIN
--all object which contain other objects are supposed to be in the directory;
--which is necessary for enumeration and for repositioning
SetOwner:
PROC [ob:
CD.Object, d:
CD.Design] = {
x: REF ~ (IF d=NIL THEN NIL ELSE d.reserved);
CDProperties.PutObjectProp[ob, ownerKey, x];
};
IsOwner:
PROC [ob:
CD.Object, d:
CD.Design]
RETURNS [
BOOL] = {
x: REF ~ (IF d=NIL THEN NIL ELSE d.reserved);
RETURN [ CDProperties.GetObjectProp[ob, ownerKey]=x ];
};
EachEntryAction: TYPE = PROC [name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL�LSE];
Fetch:
PUBLIC
PROC [design:
CD.Design, name: Rope.
ROPE]
RETURNS [found: BOOL, object: CD.Object←NIL] =
--search for object in directory
BEGIN
x: HashTable.Value;
[found, x] ← HashTable.Fetch[NARROW[design.cdDirectoryPriv], name];
IF found THEN object ← NARROW[x, CD.Object];
END;
Remove:
PUBLIC PROC [design:
CD.Design, name: Rope.
ROPE, expectObject:
CD.Object←
NIL]
RETURNS [done:
BOOL�LSE] =
--if expectObject#NIL removes name only, iff named object=expectObject
--if removed objects are still used, they are neither enumerated correctly anymore,
--nor repositioned if internal objects change
BEGIN
object: CD.Object ← Fetch[design, name].object;
IF object#
NIL
AND (expectObject=
NIL
OR object=expectObject)
THEN {
IF ~IsOwner[object, design]
THEN
ERROR CD.Error[callingError, "Removed ob not in design"];
done ← HashTable.Delete[NARROW[design.cdDirectoryPriv], name];
IF done
THEN {
SetOwner[object, NIL];
IncludeEtAll[object, NIL, name]
};
};
END;
IncludeEtAll:
PROC[object:
CD.Object, design:
CD.Design, name: Rope.
ROPE] =
BEGIN
IF object.class.inDirectory
THEN {
includeEtAll: CDDirectory.IncludeEtAllProc = CDDirectory.ObToDirectoryProcs[object].includeEtAll;
IF includeEtAll#NIL THEN includeEtAll[object, design, name];
}
END;
SetName:
PROC[me:
CD.Object, r: Rope.
ROPE] =
INLINE {
IF me.class.inDirectory THEN CDDirectory.ObToDirectoryProcs[me].setName[me, r]
};
Include:
PUBLIC
PROC [design:
CD.Design, object:
CD.Object, alternateName: Rope.
ROPE←
NIL, fiddleName:
BOOL←
TRUE]
RETURNS [done:
BOOL] =
--it is an ERROR to include an object into several design's
--but it is ok to include an object twice in the same design
BEGIN
try: INT ← 0;
IF Rope.IsEmpty[alternateName]
THEN {
alternateName ← CDDirectory.Name[object];
IF Rope.IsEmpty[alternateName] THEN alternateName ← "-noname-";
};
IF ~IsOwner[object,
NIL]
THEN {
IF ~IsOwner[object, design]
THEN
ERROR CD.Error[callingError, "cant include object in two designs"]
ELSE {
--ignore whether name is right or wrong
IF ~fiddleName
AND ~Rope.Equal[alternateName, CDDirectory.Name[object]]
THEN
RETURN [done ← FALSE];
RETURN [done ← TRUE]
};
};
DO
IF HashTable.Insert[
NARROW[design.cdDirectoryPriv], alternateName, object]
THEN {
SetName[object, alternateName];
SetOwner[object, design];
IncludeEtAll[object, design, alternateName];
RETURN [done ← TRUE]
};
IF ~fiddleName THEN RETURN [done ← FALSE];
try ← try+1;
IF try<3 THEN alternateName ← FiddleName[alternateName, design]
ELSE {
try ← 0;
alternateName ← FiddleGlobal[alternateName];
}
ENDLOOP;
END;
globalCount:
INT ←
LOOPHOLE[nameKey,
INT]
MOD 99999 / 8;
--some value which might differ next time ChipNDale is started
FiddleGlobal:
PROC [name: Rope.
ROPE]
RETURNS [Rope.
ROPE] =
BEGIN
globalCount ← globalCount MOD 1000000B + 1;
RETURN [IO.PutFR["%g@%g@0", IO.rope[name], IO.int[globalCount]]];
END;
FiddleName:
PROC [name: Rope.
ROPE, design:
CD.Design]
RETURNS [Rope.
ROPE] =
BEGIN
modifier: INT ← CDValue.FetchInt[design, $CDxNextInt] MOD 10000000000B;
leng: INT ← name.Length[];
WHILE leng>0
DO
leng ← leng-1;
IF name.Fetch[leng]='@
THEN {
name ← name.Substr[0, leng];
EXIT
}
ENDLOOP;
name ← IO.PutFR["%g@%g", IO.rope[name], IO.int[modifier]];
CDValue.StoreInt[design, $CDxNextInt, modifier+1];
RETURN [name];
END;
Rename:
PUBLIC
PROC [design:
CD.Design, object:
CD.Object,
newName: Rope.ROPE ← NIL, fiddleName: BOOL←FALSE] RETURNS [done: BOOL ← FALSE] =
BEGIN
oldName: Rope.ROPE = CDDirectory.Name[object];
removed: BOOL = Remove[design, oldName, object];
IF removed
THEN {
back: BOOL ← Include[design, object, newName, fiddleName];
IF back THEN RETURN [done ← TRUE];
back ← Include[design, object, oldName, TRUE];
IF NOT back THEN ERROR CD.Error[programmingError, "rename removed an object"]
}
END;
Enumerate:
PUBLIC
PROC [design:
CD.Design, action: EachEntryAction]
RETURNS [quit:
BOOL] =
BEGIN
EachPairAction: HashTable.EachPairAction ~ {
quit ← action[name: NARROW[key], ob: NARROW[value, CD.Object]]
};
quit ← HashTable.Pairs[NARROW[design.cdDirectoryPriv], EachPairAction]
END;
DirSize:
PUBLIC
PROC [design:
CD.Design]
RETURNS [
INT] = {
RETURN [HashTable.GetSize[NARROW[design.cdDirectoryPriv]]]
};
InstallDirectoryProcs:
PUBLIC
PROC [type:
CD.ObjectClass, dp: CDDirectory.DirectoryProcs]
RETURNS [
REF CDDirectory.DirectoryProcs] =
BEGIN
dpr: REF CDDirectory.DirectoryProcs ~ NEW[CDDirectory.DirectoryProcs𡤍p];
IF type.directoryProcs#
NIL
OR type.inDirectory
THEN
ERROR CD.Error[ec: doubleRegistration, explanation: "object type includes already directory"];
type.directoryProcs ← dpr;
type.inDirectory ← TRUE;
IF dpr.enumerateChildObjects=NIL THEN dpr.enumerateChildObjects ← DefaultEnumerate;
IF dpr.replaceDirectChilds=NIL THEN dpr.replaceDirectChilds ← DefaultReplaceDirectChilds;
IF dpr.another=NIL THEN dpr.another ← DefaultAnother;
IF dpr.expand=NIL THEN dpr.expand ← DefaultExpand;
IF dpr.name=NIL THEN dpr.name ← DefaultName;
IF dpr.setName=NIL THEN dpr.setName ← DefaultSetName;
RETURN [dpr]
END;
DefaultAnother: CDDirectory.AnotherProc =
--crazy another proc which makes a copy of the object-definition
BEGIN
new ← NEW[CD.ObjectRep←me^];
new.properties ← CDProperties.DCopyProps[me.properties];
topMode ← ready;
childMode ← IF into#NIL AND into=fromOrNil THEN included ELSE immutable;
END;
DefaultExpand: CDDirectory.ExpandProc =
BEGIN
new ← ExpandByDraw[me: me, flatDir: FALSE, flatAll: FALSE];
topMode ← ready;
childMode←IF into#fromOrNil OR into=NIL THEN immutable ELSE included;
END;
DefaultReplaceDirectChilds: CDDirectory.ReplaceDChildsProc =
BEGIN
ERROR
END;
DefaultEnumerate:
PROC [me:
CD.Object, p: CDDirectory.EnumerateObjectsProc, x:
REF] =
BEGIN
END;
DefaultSetName:
PROC [me:
CD.Object, r: Rope.
ROPE] =
BEGIN
CDProperties.PutObjectProp[onto: me, prop: nameKey, val: r]
END;
DefaultName:
PROC [me:
CD.Object]
RETURNS [Rope.
ROPE] =
BEGIN
WITH CDProperties.GetObjectProp[from: me, prop: nameKey]
SELECT
FROM
r: Rope.ROPE => RETURN [r];
ENDCASE => RETURN ["-no name"]
END;
-- -- -- -- -- -- -- -- -- -- -- --
Another:
PUBLIC
PROC [me:
CD.Object, fromOrNil:
CD.Design←
NIL, into:
CD.Design←
NIL, friendly:
BOOL←
FALSE]
RETURNS [new:
CD.Object, topMode: CDDirectory.InclOrReady, childMode: CDDirectory.ImmOrIncl] =
BEGIN
IF ~me.class.inDirectory THEN RETURN [me, included, included]
ELSE {
another: CDDirectory.AnotherProc ← CDDirectory.ObToDirectoryProcs[me].another;
IF another=NIL THEN ERROR;
[new, topMode, childMode] ← another[me, fromOrNil, into, friendly];
};
END;
Expand:
PUBLIC
PROC [me:
CD.Object, fromOrNil:
CD.Design←
NIL, into:
CD.Design←
NIL, friendly:
BOOL←
FALSE]
RETURNS [new:
CD.Object, topMode: CDDirectory.DMode, childMode: CDDirectory.ImmOrIncl] =
BEGIN
IF ~me.class.inDirectory THEN RETURN [NIL, included, included]
ELSE {
expand: CDDirectory.ExpandProc = CDDirectory.ObToDirectoryProcs[me].expand;
IF expand=NIL THEN ERROR;
[new, topMode, childMode] ← expand[me, fromOrNil, into, friendly];
};
END;
ReplaceChildren:
PUBLIC PROC [me:
CD.Object, into:
CD.Design]
RETURNS [ok:
BOOL] =
BEGIN
replaceByKey: REF ← NEW[INT];
ok ← ReplaceChildrenI[me: me, into: into, replaceByKey: replaceByKey];
END;
ReplaceChildrenI:
PROC [me:
CD.Object, into:
CD.Design, replaceByKey:
REF]
RETURNS [ok:
BOOL←TRUE] =
BEGIN
replaceList: CDDirectory.ReplaceList←NIL;
PerChild: CDDirectory.EnumerateObjectsProc
--PROC [me: CD.Object, x: REF] -- =
BEGIN
IF me.class.inDirectory
THEN {
newChild: CD.Object; tm, cm: CDDirectory.DMode;
FOR list: CDDirectory.ReplaceList ← replaceList, list.rest
WHILE list#
NIL
DO
IF list.first.old=me THEN RETURN -- eliminate duplicates
ENDLOOP;
WITH CDProperties.GetObjectProp[me, replaceByKey]
SELECT
FROM
cob: CD.Object => newChild ← cob;
ENDCASE => {
[newChild, tm, cm] ← Another[me: me, fromOrNil: NIL, into: into, friendly: TRUE];
IF newChild=NIL THEN {ok ← FALSE; RETURN};
IF cm=immutable
THEN {
IF ~ReplaceChildrenI[newChild, into, replaceByKey].ok THEN ok ← FALSE
};
IF tm=ready
THEN {
[] ← Include[into, newChild]
};
CDProperties.PutObjectProp[me, replaceByKey, newChild];
};
replaceList ←
CONS[
NEW[CDDirectory.ReplaceRec←[
old: me,
oldSize: me.size,
new: newChild,
newSize: newChild.size,
off: [0, 0]
]],
replaceList
];
}
END;
CDDirectory.EnumerateChildObjects[me: me, p: PerChild, x: NIL];
IF replaceList#
NIL
THEN
[] ← CDDirectory.ReplaceDirectChild[me: me, design: into, replace: replaceList];
END;
AnotherComplete:
PUBLIC PROC [me:
CD.Object, fromOrNil:
CD.Design←
NIL, into:
CD.Design←
NIL]
RETURNS [new:
CD.Object←
NIL] =
BEGIN
tm, cm: CDDirectory.DMode;
[new, tm, cm] ← Another[me, fromOrNil, into, TRUE];
IF new#
NIL
THEN {
IF cm=immutable
THEN {
IF ~ReplaceChildren[new, into].ok THEN RETURN [NIL]
};
IF tm=ready
THEN {
[] ← Include[into, new]
};
};
END;
ExpandComplete:
PUBLIC PROC [me:
CD.Object, fromOrNil:
CD.Design←
NIL, into:
CD.Design←
NIL]
RETURNS [new:
CD.Object] =
BEGIN
tm, cm: CDDirectory.DMode;
[new, tm, cm] ← Expand[me, fromOrNil, into, TRUE];
IF new#
NIL
THEN {
IF tm=immutable
THEN {
fromOrNil ← NIL;
[new, tm, cm] ← Another[new, fromOrNil, into];
IF new=NIL THEN RETURN;
};
IF cm=immutable
THEN {
IF ~ReplaceChildren[new, into].ok THEN RETURN [NIL]
};
IF tm=ready
THEN {
[] ← Include[into, new]
};
};
END;
ExpandRec:
TYPE =
RECORD [
cell: CD.Object,
cellPtr: CD.CellPtr,
flatDir: BOOL ← FALSE,
flatAll: BOOL ← FALSE
];
globalContextFilter: REF CD.ContextFilter = NEW[CD.ContextFilter←ALL[TRUE]];
ExpandByDraw:
PUBLIC
PROC [me:
CD.Object, flatDir, flatAll:
BOOL ←
FALSE]
RETURNS [new:
CD.Object←
NIL] =
BEGIN
dummyInst: CD.Instance = NEW[CD.InstanceRep];
expandRef: REF ExpandRec = NEW[ExpandRec];
expandPr:
CD.DrawRef =
CD.CreateDrawRef[[
design: NIL,
interestClip: CDBasics.universe,
drawRect: ExpandBareRect,
drawChild: ExpandChild,
devicePrivate: expandRef,
contextFilter: globalContextFilter
]];
dummyInst^.ob ← me;
expandRef.cell ← CDCells.CreateEmptyCell[];
expandRef.cellPtr ← NARROW[expandRef.cell.specificRef];
expandRef.flatDir ← flatDir;
expandRef.flatAll ← flatAll;
me.class.drawMe[inst: dummyInst, pos: [0, 0], orient: 0, pr: expandPr];
IF expandRef.cellPtr.contents#
NIL
THEN {
name: Rope.ROPE ← CDDirectory.Name[me];
IF Rope.IsEmpty[name] THEN name ← CDOps.ObjectInfo[me];
expandRef.cellPtr.name ← Rope.Concat["!", name];
expandRef.cellPtr.dIr ← CDInstances.BoundingRectI[expandRef.cellPtr.contents];
expandRef.cell.size ← me.size; --we dont reposition! size might have been bad and we want to get exactly the same size back
expandRef.cellPtr.ir ← CD.InterestRect[me];
expandRef.cellPtr.useDIr ← FALSE;
expandRef.cellPtr.origin ← CD.ClientOrigin[me];
new ← expandRef.cell
};
END;
ExpandBareRect:
PROC [r:
CD.Rect, l:
CD.Layer, pr:
CD.DrawRef] =
BEGIN
expandRef: REF ExpandRec = NARROW[pr.devicePrivate];
inst:
CD.Instance ←
NEW[
CD.InstanceRep←[
ob: CDRects.CreateBareRect[size: CDBasics.SizeOfRect[r], l: l],
location: CDBasics.BaseOfRect[r]
]];
expandRef.cellPtr.contents ← CONS[inst, expandRef.cellPtr.contents];
END;
ExpandChild:
PROC [inst:
CD.Instance, pos:
CD.Position, orient:
CD.Orientation, pr:
REF
CD.DrawInformation]
-- CD.DrawProc -- =
BEGIN
newInst: CD.Instance;
expandRef: REF ExpandRec = NARROW[pr.devicePrivate];
IF inst.ob.class.inDirectory
THEN {
IF expandRef.flatDir THEN {inst.ob.class.drawMe[inst, pos, orient, pr]; RETURN}
}
ELSE {
IF expandRef.flatAll THEN {inst.ob.class.drawMe[inst, pos, orient, pr]; RETURN};
};
newInst ←
NEW[
CD.InstanceRep←[
ob: inst.ob,
location: pos,
orientation: orient,
selected: FALSE,
properties: CDProperties.DCopyProps[inst.properties]
]];
expandRef.cellPtr.contents ← CONS[newInst, expandRef.cellPtr.contents];
END;
-- -- -- -- -- -- -- -- -- -- -- --
RepositionList: TYPE = LIST OF CD.Object;
changeEvent: CDEvents.EventRegistration ~ CDEvents.RegisterEventType[$AfterChange];
ReplaceObject:
PUBLIC
PROC [design:
CD.Design, old:
CD.Object, new:
CD.Object, off:
CD.Position ← [0, 0]] =
--all over in the design replace old by new
--may be delayed
BEGIN
repRef:
REF CDDirectory.ReplaceRec ←
NEW[CDDirectory.ReplaceRec←[
old: old,
oldSize: old.size,
newSize: new.size,
new: new,
off: off
]];
IF design=NIL THEN ERROR;
FOR plist:
LIST
OF
CD.PushRec ← design.actual, plist.rest
WHILE plist#
NIL
DO
IF plist.first.mightReplace#
NIL
AND plist.first.mightReplace.ob=old
THEN
TerminalIO.WriteRope["** Tries to replace pushed in cell; does not work\n"];
ENDLOOP;
ReplaceAllChilds[design, repRef]
END;
RepositionObject:
PUBLIC
PROC [design:
CD.Design, ob:
CD.Object, oldSize:
CD.Position, baseOff:
CD.Position ← [0, 0]] =
--all over in the design tries to reposition ob;
--may be delayed
BEGIN
repRef:
REF CDDirectory.ReplaceRec ←
NEW[CDDirectory.ReplaceRec←[
old: ob,
oldSize: oldSize,
newSize: ob.size,
new: ob,
off: baseOff
]];
[] ← CDEvents.ProcessEvent[
ev: repositionEvent,
design: design,
x: NEW[CDDirectory.ReplaceRec ← repRef^], --copy for safety
listenToDont: FALSE
];
IF design#NIL THEN ReplaceAllChilds[design, repRef]
END;
ReplaceAllChilds:
PROC [design:
CD.Design, repRef:
REF CDDirectory.ReplaceRec] =
--catches recursive calls and transformes them into sequential calls...
--the list of what to do is found using CDValue on the design
BEGIN
ENABLE
UNWIND => {
CDValue.Store[design, repositioningListKey, NIL];
TerminalIO.WriteRope["****repositioning or replace failed [maybe, partly]\n"];
};
ref:
REF CDDirectory.ReplaceList ←
NARROW[
CDValue.Fetch[boundTo: design, key: repositioningListKey, propagation: design]
];
IF ref#
NIL
THEN {
-- we are inside replace process, remember object
IF ref^=NIL THEN ref^ ← LIST[repRef]
ELSE {
FOR l: CDDirectory.ReplaceList ← ref^, l.rest
DO
IF l.first.old=repRef.old
THEN
--impossible; call me to debug this
ERROR;
IF l.rest=NIL THEN {l.rest ← LIST[repRef]; EXIT}
ENDLOOP;
};
RETURN
};
-- we are not inside reposition process, start one
ref ← NEW[CDDirectory.ReplaceList←LIST[repRef]];
CDValue.Store[boundTo: design, key: repositioningListKey, value: ref];
WHILE ref^#
NIL
DO
repList: CDDirectory.ReplaceList ← ref^;
ref^ ← NIL;
DoReplaceAllChilds[design, repList];
ENDLOOP;
CDValue.Store[design, repositioningListKey, NIL];
CDOps.DelayedRedraw[design];
END;
ReplaceDirectChild:
PUBLIC
PROC [me:
CD.Object, design:
CD.Design, replace: CDDirectory.ReplaceList]
RETURNS [changed:
BOOL←
FALSE] =
BEGIN
IF me.class.inDirectory
THEN
changed ← CDDirectory.ObToDirectoryProcs[me].replaceDirectChilds[me, design, replace];
IF changed THEN PropagateChange[me, design];
END;
DoReplaceAllChilds:
PUBLIC
PROC [design:
CD.Design, repList: CDDirectory.ReplaceList] =
BEGIN
ReplaceForOne: CDDirectory.EachEntryAction =
-- PROC [name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL�LSE] --
BEGIN
[] ← ReplaceDirectChild[me: ob, design: design, replace: repList];
END;
FOR list: CDDirectory.ReplaceList ← repList, list.rest
WHILE list#
NIL
DO
list.first.newSize ← list.first.new.size;
ENDLOOP;
[] ← CDDirectory.Enumerate[design, ReplaceForOne];
FOR plist:
LIST
OF
CD.PushRec ← design.actual, plist.rest
WHILE plist#
NIL
DO
inst: CD.Instance ← plist.first.mightReplace;
SetOwner[plist.first.dummyCell.ob, design]; --HACK XXX XXX
FOR rlist: CDDirectory.ReplaceList ← repList, rlist.rest
WHILE rlist#
NIL
DO
rep: REF CDDirectory.ReplaceRec = rlist.first;
IF inst#
NIL
AND inst.ob=rep.old
THEN {
realPos:
CD.Position = CDOrient.MapPoint[
pointInCell: rep.off,
cellSize: rep.oldSize,
cellInstOrient: inst.orientation,
cellInstPos: inst.location
];
fakePos:
CD.Position = CDOrient.MapPoint[
pointInCell: [0, 0],
cellSize: rep.newSize,
cellInstOrient: inst.orientation,
cellInstPos: [0, 0]
];
inst.location ← CDBasics.SubPoints[realPos, fakePos];
}
ENDLOOP;
[] ← CDCells.ReplaceDirectChildForDummyCells[plist.first.dummyCell.ob, repList];
ENDLOOP;
END;
RemovePropsEvent: CDEvents.EventProc =
BEGIN
ob: CD.Object = NARROW[x];
Rem: PropertyLists.EachProp = {
p: CDProperties.PropertyProcs ~ CDProperties.FetchProcs[key];
IF p#NIL AND p.autoRem THEN CDProperties.PutObjectProp[ob, key, NIL];
};
IF ob#NIL THEN [] ← PropertyLists.Enumerate[ob.properties, Rem]
END;
PropagateChange:
PUBLIC
PROC [ob:
CD.Object, design:
CD.Design] =
-- processes an CDEvent $AfterChange
BEGIN
[] ← CDEvents.ProcessEvent[changeEvent, design, ob];
END;
repositionEventKey: ATOM = $reposition;
repositionEvent: CDEvents.EventRegistration = CDEvents.RegisterEventType[repositionEventKey];
repositioningListKey: REF ATOM = NEW[ATOM←$RepositioningList];
ownerKey: ATOM = $OwnerDesign; --HACK XXX: property is also used by cdcellsimpl
nameKey: REF ATOM = NEW[ATOM ← $Name]; -- make it non accessible, non write on file
[] ← CDProperties.RegisterProperty[ownerKey];
CDProperties.InstallProcs[prop: ownerKey, new: CDProperties.PropertyProcsRec[exclusive: TRUE]];
CDProperties.InstallProcs[prop: nameKey, new: CDProperties.PropertyProcsRec[exclusive: TRUE]];
CDValue.RegisterKey[repositioningListKey];
CDEvents.RegisterEventProc[event: changeEvent, proc: RemovePropsEvent];
END.