
    <<CDDirectoryImpl.mesa   (part of ChipNDale)>>
        <<Copyright © 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
        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

    <<Directory updates:>>
        <<Always include name in SymTab first then include object in RefTab.>>
        <<Remove in opposite order.>>

    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];
            <<We dont SetOwner[NIL, object]; This makes interactive operations safer, >>
            <<at cost of inter-design copy; But inter-design copy is already difficult anyway. >>
            };
        };

    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] = {
        <<--ob must not be already included with any name>>
        <<--always ! succeeds including object>>
        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};
        <<--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>>

    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] = {
        <<--we tolerate include of an object twice in the same design>>
        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 = {
        <<--crazy another proc which makes a copy of the object-definition>>
        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 = {
<<--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.>>
--
IF me.class.composed AND ~me.class.xDesign THEN {
exp: CD.Object;
exp _ Expand1ByDraw[me, LeaveNextLevel, NIL];
quit _ CDDirectory.EnumerateChildObjects[exp, proc, data];
RETURN
};
--
<<--The real implementation crashes when a nested procedure is passed in and assigned>>
--
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];
    <<--used by DefaultEnumerateChildObjects>>

    QuitEnumerating: ERROR = CODE;
    <<--used by DefaultEnumerateChildObjects>>

    EnumerateByDrawing: CD.DrawProc = {
    <<--used by DefaultEnumerateChildObjects>>
    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] = {
        <<--enumerates only the mutable children>>
        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] = {
        <<--enumerates only the mutable children>>
        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[]; 
            <<--contains all elements of replaceList; one level only!>>

        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] = {
        <<--all over in the design replace old by new>>
        <<--may be delayed>>
        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] = {
        <<--all over in the design tries to reposition ob;>>
        <<--may be delayed>>
        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] = {
        <<--catches recursive calls and transformes them into sequential calls...>>
        <<--the list of what to do is found using CDValue on the design>>
        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
            };
        <<-- 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.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] = {
        <<-- processes an CDEvent $AfterChange>>
        IF ob.immutable THEN ERROR CD.Error[objectMutability];
        [] _ CDEvents.ProcessEvent[changeEvent, design, ob];
        };

    <<>>
    <<--CDCacheBase>>

    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.