DIRECTORY
CD, 
CDCacheBase,
CDCells,
CDCellsBackdoor,
CDDefaultProcs,
CDDirectory,
CDEvents,
CDBasics,
CDOps,
CDProperties,
CDRects,
CDValue,
IO,
Properties,
Random,
RefTab,
Rope,
SymTab,
TerminalIO;

CDDirectoryImpl: CEDAR MONITOR 
IMPORTS CD, CDDirectory, CDCells, CDCellsBackdoor, CDDefaultProcs, CDEvents, CDBasics, CDOps, CDProperties, CDRects, CDValue, IO, Properties, Random, RefTab, Rope, SymTab, TerminalIO
EXPORTS CDDirectory, CDCacheBase
SHARES CD, CDRects = 
BEGIN


SetOwner: PUBLIC PROC [design: CD.Design, object: CD.Object, check: BOOL_TRUE] = {
x: REF _ (IF design=NIL THEN NIL ELSE design.cdDirectoryPriv2);
IF check THEN 
SELECT CDProperties.GetObjectProp[object, ownerKey] FROM
x => RETURN; 
NIL => {}; 
ENDCASE => ERROR CD.Error[directoryInvariant, "object in different design"]; 
IF object.immutable AND design#NIL THEN ERROR CD.Error[calling, "don't set ownership of immutable object"];
CDProperties.PutObjectProp[object, ownerKey, x];
};

IsOwner: PUBLIC PROC [design: CD.Design, object: CD.Object] RETURNS [BOOL] = {
x: REF ~ (IF design=NIL THEN NIL ELSE design.cdDirectoryPriv2);
SELECT CDProperties.GetObjectProp[object, ownerKey] FROM
x => RETURN [TRUE]; 
ENDCASE => RETURN [FALSE]; 
};

CompatibleOwner: PUBLIC PROC [design: CD.Design, object: CD.Object] RETURNS [BOOL] = {
x: REF ~ (IF design=NIL THEN NIL ELSE design.cdDirectoryPriv2);
SELECT CDProperties.GetObjectProp[object, ownerKey] FROM
x => RETURN [TRUE]; 
NIL => RETURN [TRUE]; 
ENDCASE => RETURN [FALSE]; 
};

EachEntryAction: TYPE = PROC [name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL_FALSE];

Fetch: PUBLIC PROC [design: CD.Design, name: Rope.ROPE] RETURNS [object: CD.Object_NIL] = {
WITH SymTab.Fetch[design.cdDirectory1, name].val SELECT FROM
ob: CD.Object => RETURN [ob]
ENDCASE => RETURN [NIL];
};
Remove: PUBLIC PROC [design: CD.Design, name: Rope.ROPE, expectObject: CD.Object_NIL] RETURNS [ob: CD.Object] = {
ob _ MyRemove[design, name, expectObject].removed;
IF ob#NIL THEN {
[] _ DirectoryOp[ob, design, name, remove];
};
};

Fiddle: PUBLIC PROC [design: CD.Design, name: Rope.ROPE] RETURNS [ob: CD.Object] = {
ob _ MyRemove[design, name].removed;
IF ob#NIL THEN {
newName: Rope.ROPE _ IncludeFiddled[design, ob, name];
[] _ DirectoryOp[ob, design, newName, rename];
};
};

IncludeFiddled: PROC [design: CD.Design, ob: CD.Object, name: Rope.ROPE] RETURNS [newName: Rope.ROPE] = {
try: INT _ 0;
DO
IF (try _ try+1) < 3 
THEN {name _ FiddleName[name, design]}
ELSE {try _ 0; name _ FiddleGlobal[name]};
IF SymTab.Insert[design.cdDirectory1, name, ob] THEN {
[] _ RefTab.Store[design.cdDirectory2, ob, name];
RETURN [name];
}
ENDLOOP;
};

Status: TYPE = {done, ok, failed};

MyRemove: PROC [design: CD.Design, name: Rope.ROPE, expectObject: CD.Object_NIL] RETURNS [status: Status_failed, removed: CD.Object_NIL] = {
object: CD.Object _ Fetch[design, name].object;
IF object=NIL THEN RETURN [ok, NIL];  
IF (object=expectObject OR expectObject=NIL) THEN {
IF ~CompatibleOwner[design, object] THEN 
ERROR CD.Error[directoryInvariant, "Removed object in different design"];
IF RefTab.Delete[design.cdDirectory2, object] THEN removed _ object;
IF SymTab.Delete[design.cdDirectory1, name] THEN removed _ object;
IF removed#NIL THEN status _ done
};
};

DirectoryOp: PROC[me: CD.Object, design: CD.Design, name: Rope.ROPE, function: CDDirectory.DirectoryFunction] = {
IF me.class.composed THEN {
dop: CDDirectory.DirectoryProc = CDDirectory.ObToDirectoryProcs[me].directoryOp;
IF dop#NIL THEN dop[me, design, name, function];
}
};

IsIncluded: PUBLIC PROC [design: CD.Design, object: CD.Object] RETURNS [BOOL] = {
name: Rope.ROPE _ CDDirectory.Name[object, design];
RETURN [name#NIL]
};

Include: PUBLIC PROC [design: CD.Design, object: CD.Object, name: Rope.ROPE, fiddle: BOOL_TRUE] RETURNS [done: BOOL_FALSE] = {
oldName: Rope.ROPE _ NIL;
try: INT _ 0;
IF Rope.IsEmpty[name] THEN name _ "-noname-";
IF ~object.immutable AND object.class.composed THEN SetOwner[design, object, TRUE];
IF (oldName _ CDDirectory.Name[object, design])#NIL THEN {
IF Rope.Equal[oldName, name] THEN RETURN [TRUE];
RETURN [FALSE];
};
IF SymTab.Insert[design.cdDirectory1, name, object] THEN {
[] _ RefTab.Store[design.cdDirectory2, object, name];
DirectoryOp[object, design, name, include];
RETURN [TRUE]
};
IF fiddle THEN {
name  _ IncludeFiddled[design, object, name];
DirectoryOp[object, design, name, include];
RETURN [TRUE]
};
RETURN [FALSE]
};
FiddleGlobal: PROC [name: Rope.ROPE] RETURNS [Rope.ROPE] = {
RETURN [IO.PutFR["%g@%g@0", IO.rope[name], IO.int[Random.ChooseInt[max: LAST[NAT]]]]];
};

NextFiddleKey: PROC [design: CD.Design] RETURNS [key: INT] = {
WITH CDProperties.GetDesignProp[design, $FiddleKey] SELECT FROM
i: REF INT => {key _ i^; i^ _ i^ MOD 1000000B + 1};
ENDCASE => {key _ 0; CDProperties.PutDesignProp[design, $FiddleKey, NEW[INT_1]]};
};

FiddleName: PROC [name: Rope.ROPE, design: CD.Design] RETURNS [Rope.ROPE] = {
modifier: INT _ NextFiddleKey[design];
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]];
RETURN [name];
};

Rename: PUBLIC PROC [design: CD.Design, object: CD.Object, newName: Rope.ROPE _ NIL, fiddle: BOOL _ TRUE, fiddleFirst: BOOL _ FALSE, removeFirst: BOOL _ FALSE] RETURNS [done: BOOL, conflict: CD.Object] = {
oldName: Rope.ROPE = CDDirectory.Name[object, design];
status: Status;
IF ~CompatibleOwner[design, object] THEN ERROR CD.Error[directoryInvariant];
status _ MyRemove[design, oldName, object].status;
IF status=failed THEN RETURN [FALSE, CDDirectory.Fetch[design, newName]];
IF SymTab.Insert[design.cdDirectory1, newName, object] THEN {
[] _ RefTab.Store[design.cdDirectory2, object, newName];
DirectoryOp[object, design, newName, (IF status = done THEN rename ELSE include)];
RETURN [TRUE, NIL]
};
conflict _ CDDirectory.Fetch[design, newName];
IF fiddle THEN {
newName  _ IncludeFiddled[design, object, newName];
DirectoryOp[object, design, newName, (IF status = done THEN rename ELSE include)];
RETURN [TRUE, conflict]
}
ELSE { --NOT fiddle
IF conflict#NIL THEN {
IF conflict=object THEN RETURN [TRUE, NIL];
IF fiddleFirst THEN conflict _ Fiddle[design, newName]
ELSE IF removeFirst THEN conflict _ Remove[design, newName]
};
IF SymTab.Insert[design.cdDirectory1, newName, object] THEN {
[] _ RefTab.Store[design.cdDirectory2, object, newName];
DirectoryOp[object, design, newName, (IF status = done THEN rename ELSE include)];
RETURN [TRUE, conflict]
};
IF status=done THEN {
[]  _ IncludeFiddled[design, object, oldName];
RETURN [done: FALSE, conflict: conflict]
};
ERROR CD.Error[programming, "rename removed an object"]
}
};

Enumerate: PUBLIC PROC [design: CD.Design, action: EachEntryAction] RETURNS [quit: BOOL] = {
EachPairAction: SymTab.EachPairAction ~ {
quit _ action[name: NARROW[key], ob: NARROW[val, CD.Object]]
};
quit _ SymTab.Pairs[design.cdDirectory1, EachPairAction]
};

DirSize: PUBLIC PROC [design: CD.Design] RETURNS [INT] = {
RETURN [SymTab.GetSize[design.cdDirectory1]]
};

InstallDirectoryProcs: PUBLIC PROC [type: CD.ObjectClass, dp: CDDirectory.DirectoryProcs] RETURNS [REF CDDirectory.DirectoryProcs] = {
dpr: REF CDDirectory.DirectoryProcs ~ NEW[CDDirectory.DirectoryProcs_dp];
IF type.directoryProcs#NIL OR type.composed THEN 
ERROR CD.Error[ec: doubleRegistration, explanation: "type already composed"];
type.directoryProcs _ dpr;
type.composed _ TRUE;
IF dpr.enumerateChildObjects=NIL THEN 
dpr.enumerateChildObjects _ DefaultEnumerateChildObjects;
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.directoryOp=NIL THEN dpr.directoryOp _ DefaultDirectoryOp;
RETURN [dpr]
};

DefaultAnother: CDDirectory.AnotherProc = {
new _ NEW[CD.ObjectRep_me^]; --this would not be ok for most object classes
new.properties _ CDProperties.DCopyProps[me.properties];
childAccessible _ (IF into#NIL AND into=fromOrNil THEN ~me.class.xDesign ELSE FALSE);
};

DefaultExpand: CDDirectory.ExpandProc = { 
new _ Expand1ByDraw[me, LeaveNextLevel];
topAccessible _ TRUE;
childAccessible _ (into=fromOrNil OR into#NIL);
};

DefaultReplaceDirectChilds: CDDirectory.ReplaceDChildsProc = {
ERROR CD.Error[missingRegistration, "Don't default this procedure"];
};

DefaultEnumerateChildObjects: CDDirectory.EnumerateChildObjectsProc = {
--
IF me.class.composed AND ~me.class.xDesign THEN {
exp: CD.Object;
exp _ Expand1ByDraw[me, LeaveNextLevel, NIL];
quit _ CDDirectory.EnumerateChildObjects[exp, proc, data];
RETURN
};
--
--
IF me.class.composed AND ~me.class.xDesign THEN {
xPr: CD.DrawRef = CD.CreateDrawRef[[
drawRect: CDDefaultProcs.IgnoreRect,
drawChild: EnumerateByDrawing,
drawOutLine: CDDefaultProcs.IgnoreRect,
selections: FALSE,
symbolics: FALSE,
devicePrivate: NEW[EnumRec_[data, proc]]
]];
CD.DrawOb[xPr, me ! QuitEnumerating => GOTO quit];
}; 
RETURN [FALSE];
EXITS quit => RETURN [TRUE]
};

EnumRec: TYPE = RECORD [data: REF, proc: CDDirectory.EachObjectProc];

QuitEnumerating: ERROR = CODE;

EnumerateByDrawing: CD.DrawProc = {
IF ob.class.composed THEN {
er: REF EnumRec _ NARROW[pr.devicePrivate];
IF er.proc[ob, er.data].quit THEN ERROR QuitEnumerating;
}
};


DefaultDirectoryOp: PROC [me: CD.Object, design: CD.Design, name: Rope.ROPE, function: CDDirectory.DirectoryFunction] = {
};


Name: PUBLIC PROC [object: CD.Object, design: CD.Design] RETURNS [Rope.ROPE] = {
WITH RefTab.Fetch[design.cdDirectory2, object].val SELECT FROM
r: Rope.ROPE => RETURN [r]
ENDCASE => RETURN [NIL];
};
EnumerateDesign: PUBLIC PROC [design: CD.Design, proc: CDDirectory.EachObjectProc, data: REF_NIL, dir: BOOL_TRUE, top: BOOL_TRUE, recurse: BOOL_TRUE, dummy: BOOL_FALSE, visited: RefTab.Ref_NIL] RETURNS [quit: BOOL_FALSE] = {
Handle: PROC [ob: CD.Object] RETURNS [quit: BOOL_FALSE] = INLINE {
IF RefTab.Insert[visited, ob, $x] THEN {
IF recurse THEN quit _ CDDirectory.EnumerateChildObjects[ob, CheckNRecurse];
IF ~quit THEN quit _ proc[ob, data];
}
};
CheckNRecurse: CDDirectory.EachObjectProc = {
IF me.class.composed THEN RETURN [Handle[me]];
};
EachDirEntry: SymTab.EachPairAction = {
ob: CD.Object _ NARROW[val, CD.Object];
IF ob.class.composed THEN RETURN [Handle[ob]];
};
IF visited=NIL THEN visited _ RefTab.Create[MAX[CDDirectory.DirSize[design], 28]+17];
IF dir THEN 
quit _ SymTab.Pairs[design.cdDirectory1, EachDirEntry];
IF top THEN
FOR l: LIST OF CD.PushRec _ design.actual, l.rest WHILE (l#NIL AND ~quit) DO
IF l.first.mightReplace#NIL THEN quit _ CheckNRecurse[l.first.mightReplace.ob];
IF ~quit THEN
quit _ IF dummy 
THEN CheckNRecurse[l.first.dummyCell.ob]
ELSE CDDirectory.EnumerateChildObjects[l.first.dummyCell.ob, CheckNRecurse]
ENDLOOP;
};

EnumerateObject: PUBLIC PROC [ob: CD.Object, proc: CDDirectory.EachObjectProc, data: REF_NIL, recurse: BOOL_TRUE, visited: RefTab.Ref_NIL] RETURNS [quit: BOOL_FALSE] = {
Handle: PROC [ob: CD.Object] RETURNS [quit: BOOL_FALSE] = INLINE {
IF RefTab.Insert[visited, ob, $x] THEN {
IF recurse THEN quit _ CDDirectory.EnumerateChildObjects[ob, CheckNRecurse];
IF ~quit THEN quit _ proc[ob, data];
}
};
CheckNRecurse: CDDirectory.EachObjectProc = {
IF me.class.composed THEN RETURN [Handle[me]];
};
IF visited=NIL THEN visited _ RefTab.Create[];
IF ob.class.composed THEN RETURN [Handle[ob]];
};

Another1: PUBLIC PROC [me: CD.Object, fromOrNil: CD.Design_NIL, into: CD.Design_NIL, friendly: BOOL_FALSE] RETURNS [new: CD.Object, childAccessible: BOOL] = {
IF ~me.class.composed THEN RETURN [me, TRUE]
ELSE { 
another: CDDirectory.AnotherProc _ CDDirectory.ObToDirectoryProcs[me].another;
IF another=NIL THEN ERROR CD.Error[missingRegistration];
[new, childAccessible] _ another[me, fromOrNil, into, friendly];
IF childAccessible THEN SetOwner[into, new];
};
};

Expand1: PUBLIC PROC [me: CD.Object, fromOrNil: CD.Design_NIL, into: CD.Design_NIL, friendly: BOOL_FALSE] RETURNS [new: CD.Object, topAccessible: BOOL, childAccessible: BOOL] = {
IF ~me.class.composed THEN RETURN [NIL, FALSE, FALSE] 
ELSE { 
expand: CDDirectory.ExpandProc = CDDirectory.ObToDirectoryProcs[me].expand;
IF expand=NIL THEN ERROR CD.Error[missingRegistration]; 
[new, topAccessible, childAccessible] _ expand[me, fromOrNil, into, friendly];
IF topAccessible AND childAccessible THEN SetOwner[into, new];
};
};

AnotherRecursed: PUBLIC PROC [me: CD.Object, into: CD.Design_NIL, fromOrNil: CD.Design_NIL, cx: RefTab.Ref_NIL, getFromCache: CDDirectory.GetFromCacheProc_NIL, putInCache: CDDirectory.PutInCacheProc_NIL, data: REF_NIL] RETURNS [new: CD.Object_NIL] = {
ca: BOOL _ TRUE;
IF cx=NIL THEN cx _ RefTab.Create[]
ELSE
WITH RefTab.Fetch[cx, me].val SELECT FROM
ob: CD.Object => RETURN [ob]; 
ENDCASE => NULL;
IF getFromCache#NIL THEN {
new _ getFromCache[me, data]; 
IF new#NIL THEN {[] _ RefTab.Store[cx, me, new]; RETURN};
};
[new, ca] _ Another1[me, fromOrNil, into, TRUE];
IF new#NIL AND ~ca THEN {
IF ~FixChildren[new, into, fromOrNil, cx, getFromCache, putInCache, data].ok THEN RETURN [NIL] 
};
IF new#NIL THEN {
[] _ RefTab.Store[cx, me, new];
IF putInCache#NIL THEN putInCache[me, new, data];
}
};

ExpandRecursed: PUBLIC PROC [me: CD.Object, into: CD.Design_NIL, fromOrNil: CD.Design_NIL, cx: RefTab.Ref_NIL, getFromCache: CDDirectory.GetFromCacheProc_NIL, putInCache: CDDirectory.PutInCacheProc_NIL, data: REF_NIL] RETURNS [new: CD.Object] = {
ta, ca: BOOL;
[new, ta, ca] _ Expand1[me, fromOrNil, into, TRUE];
IF new#NIL THEN { 
IF cx=NIL THEN cx _ RefTab.Create[];
IF ~ta THEN { 
[new, ca] _ Another1[new, fromOrNil, into];
IF new=NIL THEN RETURN;
};
IF ~ca THEN {
IF ~FixChildren[new, into, fromOrNil, cx, getFromCache, putInCache, data].ok THEN RETURN [NIL] 
};
};
}; 

FixChildren: PUBLIC PROC [me: CD.Object, into: CD.Design, fromOrNil: CD.Design_NIL, cx: RefTab.Ref_NIL, getFromCache: CDDirectory.GetFromCacheProc_NIL, putInCache: CDDirectory.PutInCacheProc_NIL, data: REF_NIL] RETURNS [ok: BOOL_TRUE] = {
replaceList: CDDirectory.ReplaceList _ NIL;
localTab: RefTab.Ref _ RefTab.Create[]; 

PerChild: CDDirectory.EachObjectProc = {
IF ~me.immutable AND me.class.composed THEN { 
newChild: CD.Object _ NIL; 
IF ~RefTab.Insert[localTab, me, $handled] THEN RETURN; -- eliminate duplicates 
WITH RefTab.Fetch[cx, me].val SELECT FROM
cob: CD.Object => newChild _ cob;
ENDCASE => {
localOk, ca: BOOL _ TRUE;
IF IsOwner[into, me] THEN newChild _ me
ELSE IF getFromCache#NIL THEN newChild _ getFromCache[me, data];
IF newChild=NIL THEN {
[newChild, ca] _ Another1[me: me, fromOrNil: fromOrNil, into: into, friendly: TRUE];
IF newChild=NIL THEN {ok _ localOk _ FALSE; newChild _ me; ca _ FALSE}
ELSE IF ~ca AND newChild#me THEN {
IF newChild.immutable THEN ERROR CD.Error[classBehaviour];
IF ~FixChildren[me: newChild, into: into, fromOrNil: fromOrNil, cx: cx, getFromCache: getFromCache, putInCache: putInCache, data: data].ok THEN ok _ localOk _ FALSE 
};
IF localOk AND putInCache#NIL THEN putInCache[me, newChild, data]
};
IF localOk THEN [] _ RefTab.Insert[cx, me, newChild];
};
IF me#newChild AND newChild#NIL THEN
replaceList _ CONS[NEW[CDDirectory.ReplaceRec_[old: me, new: newChild]], replaceList];
}
};

IF cx=NIL THEN cx _ RefTab.Create[];
[] _ CDDirectory.EnumerateChildObjects[me: me, proc: PerChild, data: data];
IF replaceList#NIL THEN { 
IF me.immutable THEN ERROR CD.Error[classBehaviour, "immutable objects must not have inaccessible children"]; 
[] _ CDDirectory.ReplaceDirectChild[me: me, design: into, replace: replaceList, propagate: FALSE]; 
};
IF ok THEN {
SetOwner[into, me];
[] _ RefTab.Insert[cx, me, me];
}
};


ExpandRec: TYPE = RECORD [
cell: CD.Object,
cellPtr: CD.CellSpecific,
ep: CDDirectory.ExpandDecisionProc,
data: REF
];

drawAll: REF CD.ContextFilter = NEW[CD.ContextFilter_ALL[TRUE]];

Expand1ByDraw: PUBLIC PROC [ob: CD.Object, ep: CDDirectory.ExpandDecisionProc_NIL, data: REF_NIL] RETURNS [CD.Object] = {
cell: CD.Object = CDCells.CreateEmptyCell[];
expandRef: REF ExpandRec = NEW[ExpandRec_[
cell: cell, cellPtr: NARROW[cell.specific],
ep: ep, data: data
]];
expandPr: CD.DrawRef = CD.CreateDrawRef[[
design: NIL,
drawRect: ExpandByDrawBareRect,
drawChild: ExpandByDrawChild,
drawOutLine: CDDefaultProcs.IgnoreRect,
selections: FALSE,
devicePrivate: expandRef,
contextFilter: drawAll
]];
ob.class.drawMe[pr: expandPr, ob: ob];
CDCells.SetInterestRect[NIL, cell, CD.InterestRect[ob], doit];
RETURN [cell]
};

LeaveRectangles: PUBLIC CDDirectory.ExpandDecisionProc = {
IF ob.class.composed THEN RETURN [recurse];
IF ob.class.symbolic THEN RETURN [suppress];
IF ob.class=CDRects.bareRectClass THEN RETURN [leave];
RETURN [recurse];
};

LeaveNextLevel: PUBLIC CDDirectory.ExpandDecisionProc = {
RETURN [leave];
};

LeaveDontFlatten: PUBLIC CDDirectory.ExpandDecisionProc = {
IF ~ob.class.composed THEN RETURN [leave];
IF CDProperties.GetObjectProp[ob, $DontFlatten]#NIL THEN RETURN [leave];
IF CDProperties.GetListProp[readOnlyInstProps, $DontFlatten]#NIL THEN RETURN [leave];
RETURN [recurse];
};

ExpandByDrawBareRect: PROC [pr: CD.DrawRef, r: CD.Rect, l: CD.Layer] = {
expandRef: REF ExpandRec = NARROW[pr.devicePrivate];
inst: CD.Instance _ NEW[CD.InstanceRep_[
ob: CDRects.CreateBareRect[size: CDBasics.SizeOfRect[r], l: l], 
trans: [CDBasics.BaseOfRect[r], original]
]];
expandRef.cellPtr.contents _ CONS[inst, expandRef.cellPtr.contents];
}; 

ExpandByDrawChild: CD.DrawProc = {
expandRef: REF ExpandRec = NARROW[pr.devicePrivate];
SELECT expandRef.ep[ob, trans, readOnlyInstProps, expandRef.data] FROM
suppress => NULL;
leave => expandRef.cellPtr.contents _ CONS[
NEW[CD.InstanceRep_[ob: ob, trans: trans, properties: CDProperties.DCopyProps[readOnlyInstProps]]], 
expandRef.cellPtr.contents
];
recurse => ob.class.drawMe[pr, ob, trans, readOnlyInstProps];
ENDCASE => ERROR CD.Error[programming];
};



RepositionList: TYPE = LIST OF CD.Object;

changeEvent: CDEvents.EventRegistration ~ CDEvents.RegisterEventType[$AfterChange];

ReplaceObject: PUBLIC PROC [design: CD.Design, old: CD.Object, new: CD.Object, trans: CD.Transformation] = {
repRef: REF CDDirectory.ReplaceRec _ NEW[CDDirectory.ReplaceRec_[old: old, new: new, trans: trans]];
IF design=NIL THEN ERROR CD.Error[calling];
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.PutRope["** Tries to replace pushed in cell; does not work\n"];
ENDLOOP;
ReplaceAllChilds[design, repRef]
};

PropagateResize: PUBLIC PROC [design: CD.Design, ob: CD.Object] = {
repRef: REF CDDirectory.ReplaceRec _ NEW[CDDirectory.ReplaceRec_[old: ob, new: ob]];
IF ob.immutable THEN ERROR CD.Error[objectMutability]; 
[] _ CDEvents.ProcessEvent[
eventRegistration: resizeEvent, 
design: design, 
x: NEW[CDDirectory.ReplaceRec _ repRef^], --copy for safety
listenToDont: FALSE
];
IF design#NIL THEN ReplaceAllChilds[design, repRef]
};
ReplaceAllChilds: PROC [design: CD.Design, repRef: REF CDDirectory.ReplaceRec] = {
ENABLE UNWIND => {
CDValue.Store[design, repositioningListKey, NIL];
TerminalIO.PutRope["****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 ERROR CD.Error[programming, "impossible! call Christian"];
IF l.rest=NIL THEN {l.rest _ LIST[repRef]; EXIT}
ENDLOOP;
};
RETURN
};
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.Redraw[design];
};

ReplaceDirectChild: PUBLIC PROC [me: CD.Object, design: CD.Design, replace: CDDirectory.ReplaceList, propagate: BOOL_TRUE] RETURNS [changed: BOOL_FALSE] = {
IF me.class.composed AND replace#NIL THEN { 
IF me.immutable THEN ERROR CD.Error[objectMutability]; 
changed _ CDDirectory.ObToDirectoryProcs[me].replaceDirectChilds[me, design, replace];
IF changed AND propagate THEN PropagateChange[me, design];
}
};

DoReplaceAllChilds: PROC [design: CD.Design, repList: CDDirectory.ReplaceList] = {

ReplaceForOne: CDDirectory.EachObjectProc = {
IF ~me.immutable THEN [] _ ReplaceDirectChild[me: me, design: design, replace: repList];
};

[] _ CDDirectory.EnumerateDesign[design, ReplaceForOne];
FOR plist: LIST OF CD.PushRec _ design.actual, plist.rest WHILE plist#NIL DO
inst: CD.Instance _ plist.first.mightReplace;
SetOwner[design, plist.first.dummyCell.ob, TRUE]; --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 {
inst.trans _ CDBasics.ComposeTransform[itemInCell: inst.trans, cellInWorld: rep.trans];
}
ENDLOOP;
[] _ CDCellsBackdoor.ReplaceDirectChildForCell[plist.first.dummyCell.ob, design, repList];
ENDLOOP;
};

RemovePropsEvent: CDEvents.EventProc = {
ob: CD.Object = NARROW[x];
Rem: Properties.EachProp  = {
p: CDProperties.PropertyProcs ~ CDProperties.FetchProcs[key];
IF p#NIL AND p.autoRem THEN CDProperties.PutObjectProp[ob, key, NIL];
}; 
IF ob#NIL THEN [] _ Properties.Enumerate[ob.properties, Rem]
};

PropagateChange: PUBLIC PROC [ob: CD.Object, design: CD.Design] = {
IF ob.immutable THEN ERROR CD.Error[objectMutability];
[] _ CDEvents.ProcessEvent[changeEvent, design, ob];
};


CurrentKey: PUBLIC PROC [ob: CD.Object] RETURNS [key: REF] = {
RETURN [CDProperties.GetObjectProp[ob, modificationKeyProp]]
};

Match: PUBLIC PROC [ok: CDCacheBase.ObjectAndKey] RETURNS [BOOL] = {
RETURN [CDProperties.GetObjectProp[ok.ob, modificationKeyProp]=ok.key]
};

modificationKeyProp: PUBLIC REF = NEW[ATOM_$ModificationKey];
nextModification: CARD _ 0;

ObjectHasChanged: CDEvents.EventProc = {
WITH x SELECT FROM
ob: CD.Object => IF ob.class.composed THEN
CDProperties.PutObjectProp[ob, modificationKeyProp, NEW[CARD_(nextModification_nextModification+1)]];
ENDCASE => NULL;
};

resizeEventKey: ATOM = $resize;
resizeEvent: CDEvents.EventRegistration = CDEvents.RegisterEventType[resizeEventKey];
repositioningListKey: REF ATOM = NEW[ATOM_$RepositioningList];
ownerKey: ATOM = $OwnerDesign; --HACK XXX: property is also used by cdcellsimpl
[] _ CDProperties.RegisterProperty[ownerKey];
[] _ CDProperties.RegisterProperty[modificationKeyProp];
CDProperties.InstallProcs[prop: ownerKey, procs: CDProperties.PropertyProcsRec[exclusive: TRUE]];
CDProperties.InstallProcs[prop: modificationKeyProp, procs: CDProperties.PropertyProcsRec[exclusive: TRUE, internalWrite: CDProperties.DontPWrite, makeCopy: CDProperties.CopyVal]];
CDValue.RegisterKey[repositioningListKey];
CDEvents.RegisterEventProc[event: changeEvent, proc: RemovePropsEvent];
CDEvents.RegisterEventProc[event: changeEvent, proc: ObjectHasChanged];
END.

���‚��CDDirectoryImpl.mesa   (part of ChipNDale)
Copyright c 1983, 1984, 1985, 1986, 1987 by Xerox Corporation.  All rights reserved.
Created by Christian Jacobi, June 24, 1983 5:00 pm 
Last edited by: Christian Jacobi, April 10, 1987 6:38:49 pm PDT
Directory updates:
Always include name in SymTab first then include object in RefTab.
Remove in opposite order.

We dont SetOwner[NIL, object]; This makes interactive operations safer, 
at cost of inter-design copy; But inter-design copy is already difficult anyway. 
--ob must not be already included with any name
--always ! succeeds including object
--done: done on this call 
--ok: its not really done, but that name is at least not occupying a slot in the 
--     name-space anymore
--failed: place in name space is still occupied
--we tolerate include of an object twice in the same design

--crazy another proc which makes a copy of the object-definition
--Use drawproc to find children.
--Sorry this is not too fast; But not providing a default proc would bare the risk of some 
--people making classes with EnumerateChildObjectsProc's not returning any objects.
--The real implementation crashes when a nested procedure is passed in and assigned
--used by DefaultEnumerateChildObjects
--used by DefaultEnumerateChildObjects
--used by DefaultEnumerateChildObjects
-- -- -- -- -- -- -- -- -- -- --

--enumerates only the mutable children
--enumerates only the mutable children

-- -- -- -- -- -- -- -- -- -- --
--contains all elements of replaceList; one level only!
-- -- -- -- -- -- -- -- -- -- --
--all over in the design replace old by new
--may be delayed
--all over in the design tries to reposition ob;
--may be delayed

--catches recursive calls and transformes them into sequential calls...
--the list of what to do is found using CDValue on the design
-- we are not inside reposition process, start one
-- processes an CDEvent $AfterChange

--CDCacheBase
Ê ��˜�codešœ*™*Kšœ
ÏmœI™TKšœ3™3K™?K˜�—šÏk	˜	Kšžœ˜Kšœ˜Kšœ˜K˜Kšœ˜Kšœ˜K˜	K˜	K˜K˜
K˜K˜Kšžœ˜Kšœ˜Kšœ˜Kšœ˜Kšœ˜Kšœ˜Kšœ˜—K˜�šÏnœžœžœ˜Kšžœžœtžœ6˜¶Kšžœ˜ Kšžœžœ˜—Kšž˜K˜�™K™BK™—K˜�šŸœžœžœ
žœžœžœžœ˜RKš
œžœžœžœžœžœžœ˜?šžœžœ˜šžœ.ž˜8Kšœžœ˜
Kšžœ˜Kšžœžœžœ:˜M——Kšžœžœžœžœžœžœ;˜kKšœ0˜0K˜—K˜�šŸœžœ
žœžœ	žœžœ˜NKš
œžœžœžœžœžœžœ˜?šžœ.ž˜8Kšœžœžœ˜Kšžœžœžœ˜—K˜—K˜�šŸœžœ
žœžœ	žœžœ˜VKš
œžœžœžœžœžœžœ˜?šžœ.ž˜8Kšœžœžœ˜Kšžœžœžœ˜Kšžœžœžœ˜—K˜—K˜�Kšœžœžœ
žœžœ	žœžœžœ˜ZšŸœžœžœ
žœžœžœ
žœžœ˜[šžœ-žœž˜<Kšœžœžœ˜Kšžœžœžœ˜—Kšœ˜—K™�šŸœžœžœ
žœžœžœžœžœžœ˜qKšœ2˜2šžœžœžœ˜Kšœ+˜+Kšœžœ4™HKšœQ™QK˜—Kšœ˜—šŸœžœžœ
žœžœžœžœ˜TKšœ$˜$šžœžœžœ˜Kšœžœ$˜6Kšœ.˜.K˜—Kšœ˜—šŸœžœ
žœ
žœžœžœžœ˜iKšÏc/™/Kš $™$Kšœžœ˜
šž˜šžœ˜Kšžœ"˜&Kšžœ&˜*—šžœ.žœ˜6Kšœ1˜1Kšžœ˜K˜—Kšžœ˜—K˜—K˜�šœžœ˜"Kšœ™K™QK™K™/—K˜�šŸœžœ
žœžœžœžœžœ"žœžœ˜ŒKšœžœ%˜/Kš
žœžœžœžœžœ˜&šžœžœžœžœ˜3šžœ"žœ˜)KšžœžœA˜I—Kšžœ,žœ˜DKšžœ*žœ˜BKšžœ	žœžœ˜!K˜—Kšœ˜—š
Ÿœžœžœžœžœ.˜qšžœžœ˜KšœP˜PKšžœžœžœ!˜0Kšœ˜—Kšœ˜—K˜�šŸ
œžœžœ
žœžœ	žœžœ˜QKšœžœ$˜3Kšžœžœ˜K˜—K˜�šŸœžœžœ
žœžœžœ
žœžœžœžœžœ˜~Kš ;™;Kšœžœžœ˜Kšœžœ˜
Kšžœžœ˜-Kšžœžœžœžœ˜Sšžœ.žœžœ˜:Kšžœžœžœžœ˜0Kšžœžœ˜K˜—šžœ2žœ˜:Kšœ5˜5Kšœ+˜+Kšžœžœ˜
Kšœ˜—šžœžœ˜Kšœ-˜-Kšœ+˜+Kšžœžœ˜
K˜—Kšžœžœ˜Kšœ˜—K™�š
Ÿœžœ
žœžœžœ˜<Kšžœžœžœ
žœžœžœ˜VKšœ˜—K˜�š
Ÿ
œžœ
žœ	žœžœ˜>šžœ0žœž˜?Kšœžœžœžœ˜3Kšžœ=žœžœ˜Q—K˜—K˜�šŸ
œžœ
žœ
žœ	žœžœ˜MKšœ
žœ˜&Kšœžœ˜šžœž˜Kšœ˜šžœžœ˜Kšœž˜!K˜—Kšžœ˜—Kšœžœžœ
žœ˜:Kšžœ˜Kšœ˜—K˜�š Ÿœžœžœ
žœžœžœžœ
žœžœžœžœžœžœžœžœžœ˜ÍKšœžœ$˜6Kšœ˜Kšžœ"žœžœžœ˜LKšœ2˜2Kšžœžœžœžœ&˜Išžœ5žœ˜=Kšœ8˜8Kšœ&žœžœžœ˜RKšžœžœžœ˜Kšœ˜—Kšœ.˜.šžœžœ˜Kšœ3˜3Kšœ&žœžœžœ˜RKšžœžœ˜K˜—šžœ ˜šžœ
žœžœ˜Kš
žœžœžœžœžœ˜+Kšžœ
žœ#˜6Kšžœžœ
žœ#˜;K˜—šžœ5žœ˜=Kšœ8˜8Kšœ&žœžœžœ˜RKšžœžœ˜Kšœ˜—šžœ
žœ˜Kšœ.˜.Kšžœžœ˜(K˜—Kšžœžœ/˜7K˜—Kšœ˜—šŸ	œžœžœ
žœ"žœžœ˜\šÐbnœ˜)Kšœžœžœžœ	˜<Kšœ˜—Kšœ8˜8Kšœ˜K˜�—šŸœžœžœ
žœ	žœžœ˜:Kšžœ&˜,Kšœ˜—K˜�šŸœžœžœžœ.žœžœ ˜†Kšœžœžœ ˜Išžœžœžœžœ˜1KšžœžœE˜M—Kšœ˜Kšœžœ˜šžœžœžœ˜&Kšœ9˜9—Kšžœžœžœ6˜YKšžœ
žœžœ˜5Kšžœžœžœ˜2Kšžœžœžœ&˜AKšžœ˜Kšœ˜—K˜�š¡œ˜+Kšœ@™@Kšœžœžœ .˜KKšœ8˜8Kš
œžœžœžœžœžœžœ˜UKšœ˜—K˜�š¡
œ˜*Kšœ(˜(Kšœžœ˜Kšœ"žœžœ˜/Kšœ˜—K˜�š¡œ$˜>Kšžœžœ<˜DKšœ˜—K˜�šŸœ+˜GJš  ™ Jš Sœ™[Jš œQ™SJšœ˜šžœžœžœ˜1Jšœžœ˜Jšœ(žœ˜-Jšœ:˜:Jšž˜J˜—J˜JšœS™SJ˜šžœžœžœ˜1šœžœžœ˜$Kšœ$˜$Kšœ˜Kšœ'˜'Kšœžœ˜Kšœžœ˜Kšœžœ˜(Kšœ˜—Jšžœ%žœ˜2Jšœ˜—Jšžœžœ˜Jšžœ	žœžœ˜J˜—˜�šœ	žœžœžœ$˜EJš &™&—J˜�šŸœžœžœ˜Jš &™&—J˜�šŸœžœ
˜#Jš &™&šžœžœ˜Jšœžœžœ˜+Jšžœžœžœ˜8J˜—Jšœ˜——K˜�K˜�š
Ÿœžœžœžœžœ.˜yKšœ˜—K˜�Kšœ ™ K˜�šŸœžœžœ
žœžœ	žœžœ˜Pšžœ/žœž˜>Kšœžœžœ˜Kšžœžœžœ˜—K˜—K™�š"Ÿœžœ
žœ1žœžœžœžœžœžœžœžœ	žœžœžœžœžœžœ˜àKšœ&™&šŸœžœžœ	žœžœžœžœ˜Bšžœ žœ˜(Kšžœ	žœ=˜LKšžœžœ˜$K˜—K˜—šŸ
œ ˜-Kšžœžœžœ˜.K˜—šŸœ˜'Kšœžœ
žœžœ	˜'Kšžœžœžœ˜.Kšœ˜—Kšžœ	žœžœžœ&˜Ušžœžœ˜Kšœ7˜7—šžœž˜šžœžœžœžœ!žœžœžœž˜LKšžœžœžœ/˜Ošžœž˜
šœžœ˜Kšžœ$˜(KšžœG˜K——Kšžœ˜——K˜—K˜�šŸœžœžœ1žœžœžœžœžœžœžœžœ˜©Kšœ&™&šŸœžœžœ	žœžœžœžœ˜Bšžœ žœ˜(Kšžœ	žœ=˜LKšžœžœ˜$K˜—K˜—šŸ
œ ˜-Kšžœžœžœ˜.K˜—Kšžœ	žœžœ˜.Kšžœžœžœ˜.K˜—K™�Kšœ ™ K˜�šŸœžœžœžœžœžœžœžœžœžœžœžœžœ˜žKšžœžœžœžœ˜,šžœ˜KšœN˜NKš
žœ	žœžœžœžœ˜8Kšœ@˜@Kšžœžœ˜,K˜—Kšœ˜—K˜�šŸœžœžœžœžœžœžœžœžœžœžœžœžœžœ˜²Kšžœžœžœžœžœžœ˜6šžœ˜KšœK˜KKš
žœžœžœžœžœ˜8KšœN˜NKšžœžœžœ˜>K˜—Kšœ˜—K˜�š Ÿœžœžœžœžœžœ
žœžœžœ-žœ)žœžœžœžœžœžœ˜ûKšœžœžœ˜Kšžœžœžœ˜#šž˜šžœžœž˜)Kšœžœžœ˜Kšžœžœ˜——šžœžœžœ˜Kšœ˜Kšžœžœžœ"žœ˜9Kšœ˜—Kšœ*žœ˜0šžœžœžœžœ˜KšžœKžœžœžœ˜_K˜—šžœžœžœ˜Kšœ˜Kšžœžœžœ˜1K˜—Kšœ˜—K˜�šŸœžœžœžœžœžœ
žœžœžœ-žœ)žœžœžœžœžœ˜öKšœžœ˜
Kšœ-žœ˜3šžœžœžœ˜Kšžœžœžœ˜$šžœžœ˜Kšœ+˜+Kšžœžœžœžœ˜K˜—šžœžœ˜
KšžœKžœžœžœ˜_K˜—K˜—Kšœ˜—K˜�šŸœžœžœžœžœžœžœžœ-žœ)žœžœžœžœžœžœ˜îKšœ'žœ˜+šœ(˜(Kš 7™7—K˜�šŸœ ˜(šžœžœžœ˜.Kšœ
žœ
žœ˜Kšžœ(žœžœ ˜Ošžœžœž˜)Kšœžœ˜!šžœ˜Kšœ
žœžœ˜Kšžœžœ˜'Kšžœžœžœžœ#˜@šžœ
žœžœ˜KšœNžœ˜TKš
žœ
žœžœžœžœ˜Fšžœžœžœ
žœ˜"Kšžœžœžœžœ˜:Kšžœ‰žœžœ˜¥K˜—Kšžœ	žœžœžœ˜AK˜—Kšžœ	žœ&˜5K˜——šžœ
žœ
žœž˜$Kšœžœžœ@˜V—K˜—Kšœ˜—K˜�Kšžœžœžœ˜$KšœK˜Kšžœ
žœžœ˜KšžœžœžœžœQ˜nKšœ[žœ˜cK˜—šžœžœ˜Kšœ˜Kšœ˜K˜—Kšœ˜—K˜�K˜�šœžœžœ˜Kšœžœ˜Kšœ	žœ˜Kšœ#˜#Kšœž˜	Kšœ˜—K˜�Kš
œ	žœžœžœžœžœžœ˜@K˜�šŸ
œžœžœžœ,žœžœžœžœžœ˜yKšœžœ$˜,šœžœ
žœ˜*Kšœžœ˜+Kšœ˜Kšœ˜—šœ
žœžœ˜)Kšœžœ˜Kšœ˜Kšœ˜Kšœ'˜'Kšœžœ˜Kšœ˜Kšœ˜Kšœ˜—Kšœ&˜&Kšœžœžœ˜>Kšžœ˜
Kšœ˜—K˜�šŸœžœ#˜:Kšžœžœžœ˜+Kšžœžœžœ˜,Kšžœ žœžœ	˜6Kšžœ˜Kšœ˜—K˜�šŸœžœ#˜9Kšžœ	˜Kšœ˜—K˜�šŸœžœ#˜;Kšžœžœžœ	˜*Kšžœ.žœžœžœ	˜HKšžœ;žœžœžœ	˜UKšžœ˜Kšœ˜—K˜�š
Ÿœžœžœ
žœ
žœ˜HKšœžœ
žœ˜4šœžœžœžœ˜(Kšœ@˜@Kšœ)˜)Kšœ˜—Kšœžœ#˜DKšœ˜—K˜�šŸœ˜"Kšœžœ
žœ˜4šžœ<ž˜FKšœž˜šœ&žœ˜+Kšžœžœ^˜dKšœ˜Kšœ˜—Kšœ=˜=Kšžœžœžœ˜'—Kšœ˜—K˜�K˜�Kšœ ™ K˜�Kš	œžœžœžœžœ	˜*KšœS˜SK˜�šŸ
œžœžœ
žœžœžœžœ˜lKšœ+™+K™Kšœžœžœ<˜dKš
žœžœžœžœžœ˜+š
žœžœžœžœ%žœžœž˜Lšžœžœžœ!ž˜HKšœJ˜J—Kšžœ˜—Kšœ ˜ Kšœ˜—K˜�š
Ÿœžœžœ
žœ
žœ˜CKšœ0™0K™Kšœžœžœ,˜TKšžœžœžœžœ˜7šœ˜Kšœ ˜ Kšœ˜Kšœžœ$ ˜;Kšœž˜K˜—Kšžœžœžœ!˜3Kšœ˜K™�—šŸœžœ
žœžœ˜RKš G™GKš =™=šžœžœ˜Kšœ,žœ˜1KšœL˜LK˜—šœžœžœ˜*KšœN˜NKšœ˜—šžœžœžœ 1˜DKšžœžœžœžœ˜$šžœ˜šžœ+ž˜0Kšžœžœžœžœ2˜YKš
žœžœžœžœ
žœ˜0Kšžœ˜—K˜—Kšž˜K˜—Kšœ2™2Kšœžœžœ
˜0KšœF˜Fšžœžœž˜Kšœ(˜(Kšœžœ˜Kšœ$˜$Kšžœ˜—Kšœ,žœ˜1Kšœ˜Kšœ˜—K˜�š¡œžœžœžœžœ6žœžœžœžœžœ˜œšžœžœ	žœžœ˜,Kšžœžœžœžœ˜7KšœV˜VKšžœ	žœžœ˜:K˜—Kšœ˜—K˜�š¡œžœ
žœ.˜RK˜�šŸ
œ ˜-KšžœžœC˜XKšœ˜—K˜�Kšœ8˜8š
žœžœžœžœ%žœžœž˜LKšœžœ%˜-Kšœ+žœ ˜@šžœ6žœžœž˜KKšœžœ&˜.šžœžœžœžœ˜&KšœW˜WK˜—Kšžœ˜—KšœZ˜ZKšžœ˜—Kšœ˜—K˜�š¡œ˜(Kšœžœ
žœ˜š¡œ˜Kšœ=˜=Kš
žœžœžœžœ%žœ˜EKšœ˜—Kšžœžœžœ.˜<Kšœ˜—K˜�š
Ÿœžœžœžœžœ˜CKšœ$™$Kšžœžœžœžœ˜6Kšœ4˜4Kšœ˜—K˜�K™�KšÐbl
™
K˜�šŸ
œžœžœžœ	žœžœ˜>Kšžœ6˜<K˜—K˜�š
Ÿœžœžœ žœžœ˜DKšžœ@˜FK˜—K˜�Kš	œžœžœžœžœ˜=Kšœžœ˜K˜�š¡œ˜(šžœžœž˜šœžœžœž˜*Kšœ4žœžœ)˜e—Kšžœžœ˜—Kšœ˜—K˜�Kšœžœ˜KšœU˜UKš	œžœžœžœžœ˜>Kšœ
žœ 0˜OKšœ-˜-Kšœ8˜8KšœZžœ˜aKšœežœK˜´Kšœ*˜*KšœG˜GKšœG˜GKšžœ˜K˜�—�…—����Z��€´��