
<<CDCleanUpImpl.mesa >>
    <<Copyright (C) 1986 by Xerox Corporation.  All rights reserved.>>
    <<by Ch. Jacobi, January 29, 1986 5:31:20 pm PST>>
    <<last edited Ch. Jacobi, March 25, 1986 1:15:26 pm PST>>

    DIRECTORY
        CD, 
        CDCells, 
        CDCleanUp,
        CDDirectory,
        CDMenus,
        CDProperties,
        CDSequencer,
        CDSimpleOps,
        CedarProcess,
        Process,
        Rope,
        TerminalIO;

    CDCleanUpImpl: CEDAR PROGRAM 
        IMPORTS CDDirectory, CDCells, CDMenus, CDSimpleOps, CDProperties, CedarProcess, Process, TerminalIO
        EXPORTS CDCleanUp
        SHARES CD, CDDirectory =
    BEGIN

    EnumeratePossibleRoots: PROC [design: CD.Design, proc: CDDirectory.EnumerateObjectsProc, x: REF_NIL, inclDir: BOOL_TRUE] =
        BEGIN
    EachEntry: CDDirectory.EachEntryAction = {proc[ob, x]};
    FOR pushed: LIST OF CD.PushRec _ design.actual, pushed.rest WHILE pushed#NIL DO
    FOR list: LIST OF CD.Instance _ pushed.first.specific.contents, list.rest WHILE list#NIL DO
    proc[list.first.ob, x]; 
    ENDLOOP;
    ENDLOOP;
    IF inclDir THEN [] _ CDDirectory.Enumerate[design, EachEntry];
        END;

ReplaceFunnys: PUBLIC PROC [design: CD.Design, rootOb: CD.Object, key: REF] =
BEGIN
realKey: REF ~ IF key=NIL THEN NEW[INT] ELSE key;

DirtyExpand: PROC [ob: CD.Object] = {
WHILE ob.class.internalWrite=NIL DO
<<--real dirty, but it never happens because internalWrite is never NIL, except... >>
new: CD.Object; tm, cm: CDDirectory.DMode; own: REF;
[new, tm, cm] _ CDDirectory.Expand[ob]; --we ignore modes; class is fishy
own _ CDProperties.GetObjectProp[ob, $OwnerDesign];
IF new=NIL THEN {
    TerminalIO.WriteF["**** %g is fishy\n", [rope[CDDirectory.Name[ob]]]];
EXIT; 
};
CDProperties.AppendProps[looser: new.properties, winner: ob.properties, putOnto: new];
ob^ _ new^; --real dirty--
CDProperties.PutObjectProp[ob, $OwnerDesign, own];
ENDLOOP;
};

DoIt: CDDirectory.EnumerateObjectsProc = {
<<--uses globals: realKey>>
IF me.class.inDirectory AND CDProperties.GetObjectProp[me, realKey]#x THEN { 
CDProperties.PutProp[me, realKey, x];
DirtyExpand[me];
CDDirectory.EnumerateChildObjects[me, DoIt, x];
};
};

IF rootOb#NIL THEN DoIt[rootOb, NEW[INT]]
ELSE EnumeratePossibleRoots[design, DoIt, NEW[INT]];
IF key=NIL THEN RemoveProperties[design, realKey];
END;
    <<>>
PreTag: PROC [design: CD.Design, rootOb: CD.Object, tag: REF, key: REF] =
    <<--figures out whether objects should be replaced because they are in different designs:>>
    <<--such objects will be taken or copied, included in the directory and put onto the tag property>>
    BEGIN

DoIt: CDDirectory.EnumerateObjectsProc = {
<<--uses globals: design, tag, key>>
IF me.class.inDirectory AND CDProperties.GetObjectProp[me, key]#x THEN { 
name: Rope.ROPE _ CDDirectory.Name[me];
CDProperties.PutProp[me, key, x];
    IF CDProperties.GetObjectProp[me, $OwnerDesign]=NIL THEN {
        [] _ CDDirectory.Include[design, me];
        }
    ELSE IF CDDirectory.Fetch[design, name].object#me THEN {
        new, temp: CD.Object; tm, cm: CDDirectory.DMode;
        temp _ me; 
        DO
            [new, tm, cm] _ CDDirectory.Another[temp, NIL, design, TRUE];
            IF tm=ready AND new#NIL THEN [] _ CDDirectory.Include[design, new, name];
            IF new#NIL THEN EXIT;
            [new, tm, cm] _ CDDirectory.Expand[temp, NIL, design, TRUE];
            IF tm=ready THEN [] _ CDDirectory.Include[design, new, name];
            IF tm#immutable OR new=NIL THEN EXIT;
            temp _ new;
            ENDLOOP;
        IF new#NIL THEN {
        CDProperties.PutProp[me, tag, new];
            me _ new; 
            }
        ELSE TerminalIO.WriteF["**** %g is fishy\n", [rope[CDDirectory.Name[me]]]];
        };
CDDirectory.EnumerateChildObjects[me, DoIt, x];
};
};

IF rootOb#NIL THEN DoIt[rootOb, NEW[INT]]
ELSE EnumeratePossibleRoots[design, DoIt, NEW[INT]];
    END;

    ReplaceTaggedOneLevel: PROC [design: CD.Design, ob: CD.Object, tag: REF] = {

        ForCells:  PROC [cell: CD.Object, tag: REF] = INLINE {
            FOR list: LIST OF CD.Instance _ NARROW[cell.specificRef, CD.CellPtr].contents, list.rest WHILE list#NIL DO
                WITH CDProperties.GetObjectProp[list.first.ob, tag] SELECT FROM
                    ob: CD.Object => list.first.ob _ ob;
                    ENDCASE => NULL;
                ENDLOOP;
            }; --ForCells

        ForNonCells: PROC [design: CD.Design, ob: CD.Object, tag: REF] = {
            replaces: CDDirectory.ReplaceList _ NIL;

            FindReplaces: CDDirectory.EnumerateObjectsProc = {
                WITH CDProperties.GetObjectProp[me, tag] SELECT FROM
                    new: CD.Object => {
                        replaces _ CONS[NEW[CDDirectory.ReplaceRec_[old: me, oldSize: me.size, new: new, newSize: new.size, off: [0, 0]]], replaces];
                        };
                    ENDCASE => NULL;
                }; --FindReplaces
        <<>>
            <<--ForNonCells>>
            CDDirectory.EnumerateChildObjects[ob, FindReplaces, NIL];
            IF replaces#NIL THEN 
                [] _ CDDirectory.ObToDirectoryProcs[ob].replaceDirectChilds[ob, design, replaces];
            }; --ForNonCells

        <<--ReplaceTaggedOneLevel>>
        IF CDCells.IsCell[ob] THEN ForCells[ob, tag] ELSE ForNonCells[design, ob, tag];
        }; --ReplaceTaggedOneLevel

    ReplaceTagged: PUBLIC PROC [design: CD.Design, replaceBy: REF, rename: BOOL_TRUE, key: REF] =
        BEGIN
        myVal: REF ~ NEW[INT];
    realKey: REF ~ IF key=NIL THEN NEW[INT] ELSE key;

        DoChilds: CDDirectory.EnumerateObjectsProc = {
            <<--globals: design, realKey>>
            <<--x: visit key >>
            IF me.class.inDirectory AND CDProperties.GetObjectProp[me, realKey]#x THEN { 
                CDProperties.PutProp[me, realKey, x];
                ReplaceTaggedOneLevel[design, me, replaceBy];
                CDDirectory.EnumerateChildObjects[me, DoChilds, x];
                };
            }; --DoChilds

        EachEntry: CDDirectory.EachEntryAction = {
            WITH CDProperties.GetObjectProp[ob, replaceBy] SELECT FROM
                new: CD.Object => {
                    removed: BOOL _ CDDirectory.Remove[design, name, ob];
                    IF ~removed THEN DoChilds[ob, myVal];
                    IF new.class.inDirectory THEN {
                        [] _ CDDirectory.Include[design, new];
                        IF rename THEN [] _ CDDirectory.Rename[design, new, name];
                        };
                    ob _ new;
                    };
                ENDCASE => NULL;
            DoChilds[ob, myVal]; 
            }; --EachEntry

    <<--ReplaceTagged>>
        FOR pushed: LIST OF CD.PushRec _ design.actual, pushed.rest WHILE pushed#NIL DO
            FOR list: LIST OF CD.Instance _ pushed.first.specific.contents, list.rest WHILE list#NIL DO
                WITH CDProperties.GetObjectProp[list.first.ob, replaceBy] SELECT FROM
                    ob: CD.Object => {
                        list.first.ob _ ob;
                        DoChilds[ob, myVal];
                        }
                    ENDCASE => NULL;
                ENDLOOP;
            ENDLOOP;
        [] _ CDDirectory.Enumerate[design, EachEntry];
    IF key=NIL THEN RemoveProperties[design, realKey];
        END; --ReplaceTagged
        <<>>
CleanUp: PUBLIC PROC [design: CD.Design, rootOb: CD.Object] =
BEGIN
myKey: REF ~ NEW[INT];
replaceBy: REF ~ NEW[INT]; 
    CDSimpleOps.FlushDeletedCache[design];
ReplaceFunnys[design, rootOb, myKey];
PreTag[design, rootOb, replaceBy, myKey];
ReplaceTagged[design, replaceBy, TRUE, myKey];
RemoveProperties[design, myKey];
RemoveProperties[design, replaceBy];
END;

    RemovePropertiesProcess: PROC [design: CD.Design, key: REF] =
        BEGIN
        RPEachChildren: CDDirectory.EnumerateObjectsProc = {
            CDProperties.PutObjectProp[onto: me, prop: x, val: NIL];
            Process.Yield[];
            };
        RPEachDirectoryEntry: CDDirectory.EachEntryAction = {
            CDProperties.PutObjectProp[onto: ob, prop: key, val: NIL];
            Process.Yield[];
            IF ob.class.inDirectory THEN 
                CDDirectory.EnumerateChildObjects[me: ob, p: RPEachChildren, x: key];
            };
        CedarProcess.SetPriority[CedarProcess.Priority[background]];
        [] _ CDDirectory.Enumerate[design: design, action: RPEachDirectoryEntry];
        END;

    RemoveProperties: PUBLIC PROC [design: CD.Design, key: REF] =
        BEGIN
        TRUSTED {Process.Detach[FORK RemovePropertiesProcess[design, key]]}
        END;

    CleanupCommand: PROC [comm: CDSequencer.Command] =
        BEGIN
        n: INT;
        TerminalIO.WriteRope["cleanup directory\n"];
        n _ CDDirectory.DirSize[comm.design];
        CleanUp[comm.design, NIL];
        IF n = CDDirectory.DirSize[comm.design] THEN 
            TerminalIO.WriteF["design was ok; has %g entries in directory\n", [integer[n]]]
        ELSE
            TerminalIO.WriteF["design was not ok; previously had %g; now has %g entries in directory\n", 
            [integer[n]], 
            [integer[CDDirectory.DirSize[comm.design]]]
            ];
        END;

    CDMenus.ImplementEntryCommand[$SpecialMenu, "check directory", CleanupCommand];
END.