
    <<CDDirectoryImpl.mesa   (part of ChipNDale)>>
        <<Copyright © 1983, 1986 by Xerox Corporation.  All rights reserved.>>
        <<Created by Christian Jacobi, June 24, 1983 5:00 pm >>
        <<Last edited by: Christian Jacobi, January 14, 1987 6:00:51 pm PST>>

    DIRECTORY
        CD, 
        CDCells,
        CDCellsBackdoor,
        CDDefaultProcs,
        CDDirectory,
        CDEvents,
        CDBasics,
        CDOps,
        CDProperties,
        CDRects,
        CDValue,
        HashTable,
        IO,
        PropertyLists,
        Rope,
        TerminalIO;

    CDDirectoryImpl: CEDAR MONITOR 
        IMPORTS CD, CDDirectory, CDCells, CDCellsBackdoor, CDDefaultProcs, CDEvents, CDBasics, CDOps, CDProperties, CDRects, CDValue, 
        HashTable, IO, PropertyLists, Rope, TerminalIO
        EXPORTS CDDirectory
        SHARES CD = 
    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.cdDirectoryPriv2);
        CDProperties.PutObjectProp[ob, ownerKey, x];
        };

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

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

    Fetch: PUBLIC PROC [design: CD.Design, name: Rope.ROPE] RETURNS [found: BOOL, object: CD.Object_NIL] = {
        <<--search for object in directory>>
        x: HashTable.Value;
        [found, x] _ HashTable.Fetch[NARROW[design.cdDirectoryPriv], name];
        IF found THEN object _ NARROW[x, CD.Object];
        };
    <<>>
    Remove: PUBLIC PROC [design: CD.Design, name: Rope.ROPE, expectObject: CD.Object_NIL] RETURNS [done: BOOL_FALSE] = {
        <<--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>>
        object: CD.Object _ Fetch[design, name].object;
        IF object#NIL AND (expectObject=NIL OR object=expectObject) THEN {
            IF ~IsOwner[design, object] THEN 
                ERROR CD.Error[callingError, "Removed ob not in design"];
            done _ HashTable.Delete[NARROW[design.cdDirectoryPriv], name];
            IF done THEN {
                SetOwner[object, NIL];
                [] _ DirectoryOp[object, design, name, remove];
                };
            };
        };

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

    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>>
        try: INT _ 0;
        IF Rope.IsEmpty[alternateName] THEN {
            alternateName _ CDDirectory.Name[object];
            IF Rope.IsEmpty[alternateName] THEN alternateName _ "-noname-";
            };
        IF ~IsOwner[NIL, object] THEN {
            IF ~IsOwner[design, object] 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.Fetch[NARROW[design.cdDirectoryPriv], alternateName].found THEN
                IF HashTable.Insert[NARROW[design.cdDirectoryPriv], alternateName, object] THEN {
                    done _ DirectoryOp[object, design, alternateName, include];
                    IF done THEN {
                        object.marked _ 0;
                        SetOwner[object, design]
                        }
                    ELSE [] _ HashTable.Delete[NARROW[design.cdDirectoryPriv], alternateName];
                    RETURN [done]
                    };
            IF ~fiddleName THEN RETURN [done _ FALSE];
            try _ try+1;
            IF try<3 THEN alternateName _ FiddleName[alternateName, design]
            ELSE {
                try _ 0;
                alternateName _ FiddleGlobal[alternateName];
                }
            ENDLOOP;
        };

    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] = {
        globalCount _ globalCount MOD 1000000B + 1;
        RETURN [IO.PutFR["%g@%g@0", IO.rope[name], IO.int[globalCount]]];
        };

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

    Rename: PUBLIC PROC [design: CD.Design, object: CD.Object, newName: Rope.ROPE _ NIL, fiddleName: BOOL_FALSE] RETURNS [done: BOOL _ 
    FALSE] = {
        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"]
            }
        };

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

    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] 
    = {
        dpr: REF CDDirectory.DirectoryProcs ~ NEW[CDDirectory.DirectoryProcs_dp];
        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.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^];
        new.properties _ CDProperties.DCopyProps[me.properties];
        topMode _ ready;
        childMode _ IF into#NIL AND into=fromOrNil THEN included ELSE immutable;
        };

    DefaultExpand: CDDirectory.ExpandProc = { 
        new _ ExpandByDraw[me: me, flatDir: FALSE, flatAll: FALSE];
        topMode _ ready;
        childMode_IF into#fromOrNil OR into=NIL THEN immutable ELSE included;
        };

    DefaultReplaceDirectChilds: CDDirectory.ReplaceDChildsProc = {
        ERROR
        };

    DefaultEnumerate: PROC [me: CD.Object, p: CDDirectory.EnumerateObjectsProc, x: REF] = {
        };

    DefaultDirectoryOp: PROC [me: CD.Object, design: CD.Design, name: Rope.ROPE, function: CDDirectory.DirectoryFunction] RETURNS 
    [proceed: BOOL_TRUE] = {
        IF function#remove THEN 
            CDProperties.PutObjectProp[onto: me, prop: nameKey, val: name]
        };

    DefaultName: PROC [me: CD.Object] RETURNS [Rope.ROPE] = {
        WITH CDProperties.GetObjectProp[from: me, prop: nameKey] SELECT FROM
            r: Rope.ROPE => RETURN [r];
            ENDCASE => RETURN ["-no name"] 
        };

    <<-- -- -- -- -- -- -- -- -- -- -->>

    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] = {
        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];
            };
        };

    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] = {
        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];
            };
        };

    FixChildren: PUBLIC PROC [me: CD.Object, into: CD.Design] RETURNS [ok: BOOL] = {
        globTab: HashTable.Table _ HashTable.Create[];
        ok _ ReplaceChildren1[me: me, into: into, globTab: globTab];
        };

    ReplaceChildren1: PROC [me: CD.Object, into: CD.Design, globTab: HashTable.Table] RETURNS [ok: BOOL_TRUE] = {
        replaceList: CDDirectory.ReplaceList _ NIL;
        localTab: HashTable.Table _ HashTable.Create[]; 
            --contains all elements of replaceList; of one level only!

        PerChild: CDDirectory.EnumerateObjectsProc = {
            IF me.class.inDirectory THEN { 
                newChild: CD.Object _ me; tm, cm: CDDirectory.DMode;
                IF ~HashTable.Insert[localTab, me, $handled] THEN RETURN; -- eliminate duplicates 
                WITH HashTable.Fetch[globTab, me].value SELECT FROM
                    cob: CD.Object => newChild _ cob;
                    ENDCASE => {
                        IF IsOwner[into, me] THEN [] _ HashTable.Insert[globTab, me, me]
                        ELSE {
                            [newChild, tm, cm] _ Another[me: me, fromOrNil: NIL, into: into, friendly: TRUE];
                            IF newChild=NIL THEN {ok _ FALSE; newChild _ me; cm _ tm _ included};
                            [] _ HashTable.Insert[globTab, me, newChild];
                            IF cm=immutable THEN {
                                IF ~ReplaceChildren1[newChild, into, globTab].ok THEN ok _ FALSE 
                                };
                            IF tm=ready THEN {
                                [] _ Include[into, newChild] 
                                };
                            };
                        };
                IF me#newChild AND newChild#NIL THEN
                    replaceList _ CONS[NEW[CDDirectory.ReplaceRec_[old: me, new: newChild]], replaceList];
                }
            };
        <<>>
        CDDirectory.EnumerateChildObjects[me: me, p: PerChild, x: NIL];
        IF replaceList#NIL THEN 
            [] _ CDDirectory.ReplaceDirectChild[me: me, design: into, replace: replaceList];
        };

    AnotherComplete: PUBLIC PROC [me: CD.Object, fromOrNil: CD.Design_NIL, into: CD.Design_NIL] RETURNS [new: CD.Object_NIL] = {
        tm, cm: CDDirectory.DMode;
        [new, tm, cm] _ Another[me, fromOrNil, into, TRUE];
        IF new#NIL THEN {
            IF cm=immutable THEN {
                IF ~FixChildren[new, into].ok THEN RETURN [NIL] 
                };
            IF tm=ready THEN {
                [] _ Include[into, new] 
                };
            };
        };

    ExpandComplete: PUBLIC PROC [me: CD.Object, fromOrNil: CD.Design_NIL, into: CD.Design_NIL] RETURNS [new: CD.Object] = {
        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 ~FixChildren[new, into].ok THEN RETURN [NIL] 
                };
            IF tm=ready THEN {
                [] _ Include[into, new] 
                };
            };
        }; 

    ExpandRec: TYPE = RECORD [
        cell: CD.Object,
        cellPtr: CD.CellSpecific,
        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] = {
        dummyInst: CD.Instance = NEW[CD.InstanceRep];
        expandRef: REF ExpandRec = NEW[ExpandRec];
        expandPr: CD.DrawRef = CD.CreateDrawRef[[
            design: NIL,
            drawRect: ExpandBareRect,
            drawChild: ExpandChild,
            drawOutLine: CDDefaultProcs.IgnoreOutLine,
            selections: FALSE,
            devicePrivate: expandRef,
            contextFilter: globalContextFilter
            ]];
        dummyInst^.ob _ me;  
        expandRef.cell _ CDCells.CreateEmptyCell[];
        expandRef.cellPtr _ NARROW[expandRef.cell.specific];
        expandRef.flatDir _ flatDir;
        expandRef.flatAll _ flatAll;
        me.class.drawMe[inst: dummyInst, trans: [], pr: expandPr];
        IF ~CDCells.IsEmpty[expandRef.cell] THEN {
            name: Rope.ROPE _ CDDirectory.Name[me];
            IF Rope.IsEmpty[name] THEN name _ CDOps.ObjectRope[me];
            expandRef.cellPtr.name _ Rope.Concat["!", name];
            new _ expandRef.cell;
            CDCells.SetInterestRect[NIL, new, CD.InterestRect[me], doit];
            };
        };

    ExpandBareRect: PROC [r: CD.Rect, l: CD.Layer, pr: CD.DrawRef] = {
        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];
        }; 

    ExpandChild: PROC [inst: CD.Instance, trans: CD.Transformation, pr: REF CD.DrawInformation] = {
        newInst: CD.Instance;
        expandRef: REF ExpandRec = NARROW[pr.devicePrivate];
        IF inst.ob.class.inDirectory THEN {
            IF expandRef.flatDir THEN {inst.ob.class.drawMe[inst, trans, pr]; RETURN}
            }
        ELSE {
            IF expandRef.flatAll THEN {inst.ob.class.drawMe[inst, trans, pr]; RETURN};
            };
        newInst _ NEW[CD.InstanceRep_[ob: inst.ob, trans: trans, properties: CDProperties.DCopyProps[inst.properties]]];
        expandRef.cellPtr.contents _ CONS[newInst, expandRef.cellPtr.contents];
        };


    <<-- -- -- -- -- -- -- -- -- -- -->>

    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;
        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]];
        [] _ CDEvents.ProcessEvent[
            ev: 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 
                        <<--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.Redraw[design];
        };

    ReplaceDirectChild: PUBLIC PROC [me: CD.Object, design: CD.Design, replace: CDDirectory.ReplaceList] RETURNS [changed: BOOL_FALSE] 
    = {
        IF me.class.inDirectory THEN 
            changed _ CDDirectory.ObToDirectoryProcs[me].replaceDirectChilds[me, design, replace];
        IF changed THEN PropagateChange[me, design];
        };

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

        ReplaceForOne: CDDirectory.EachEntryAction = {
            <<-- PROC [name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL_FALSE] -- >>
            [] _ ReplaceDirectChild[me: ob, design: design, replace: repList];
            };

        [] _ 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 {
                    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: 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]
        };

    PropagateChange: PUBLIC PROC [ob: CD.Object, design: CD.Design] = {
        <<-- processes an CDEvent $AfterChange>>
        [] _ CDEvents.ProcessEvent[changeEvent, design, ob];
        };

    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
    nameKey: REF ATOM = NEW[ATOM _ $Name]; -- make it non accessible, non write on file
    [] _ CDProperties.RegisterProperty[ownerKey];
    CDProperties.InstallProcs[prop: ownerKey, procs: CDProperties.PropertyProcsRec[exclusive: TRUE]];
    CDProperties.InstallProcs[prop: nameKey, procs: CDProperties.PropertyProcsRec[exclusive: TRUE]];
    CDValue.RegisterKey[repositioningListKey];
    CDEvents.RegisterEventProc[event: changeEvent, proc: RemovePropsEvent];
    END.