
<<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 11, 1986 1:18:07 pm PST>>

    DIRECTORY
        CD, 
        CDCells, 
        CDCleanUp,
        CDDirectory,
        CDExtras,
        CDMenus,
        CDProperties,
        CDSequencer,
        TerminalIO;

    CDCleanUpImpl: CEDAR PROGRAM 
        IMPORTS CDDirectory, CDCells, CDExtras, CDMenus, CDProperties, 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, key: REF_NIL] =
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 _ CDDirectory.ExpandHard[ob, NIL, NIL];
own: REF _ CDProperties.GetPropFromObject[ob, $OwnerDesign];
IF new=NIL THEN EXIT; 
CDProperties.AppendProps[looser: new.properties, winner: ob.properties, putOnto: new];
ob^ _ new^; --real dirty--
CDProperties.PutPropOnObject[ob, $OwnerDesign, own];
ENDLOOP;
};

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

EnumeratePossibleRoots[design, DoIt, NEW[INT]];
IF key=NIL THEN CDExtras.RemoveProperties[design, realKey];
END;
    <<>>
PreTag: PROC [design: CD.Design, 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.GetPropFromObject[me, key]#x THEN { 
CDProperties.PutProp[me, key, x];
    IF CDProperties.GetPropFromObject[me, $OwnerDesign]=NIL THEN {
        [] _ CDDirectory.Include[design, me];
        }
    ELSE IF CDDirectory.Fetch[design, CDDirectory.Name[me]].object#me THEN {
        new: CD.Object _ CDDirectory.Another[me, NIL, design];
        IF new=NIL THEN new _ CDDirectory.ExpandHard[me, NIL, design];
    CDProperties.PutProp[me, tag, new];
        IF new#NIL THEN me _ new 
        ELSE TerminalIO.WriteF["**** %g is fishy\n", [rope[CDDirectory.Name[me]]]];
        };
CDDirectory.EnumerateChildObjects[me, DoIt, x];
};
};

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.GetPropFromObject[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.GetPropFromObject[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, key: REF_NIL] =
        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.GetPropFromObject[me, realKey]#x THEN { 
                CDProperties.PutProp[me, realKey, x];
                ReplaceTaggedOneLevel[design, me, replaceBy];
                CDDirectory.EnumerateChildObjects[me, DoChilds, x];
                };
            }; --DoChilds

        EachEntry: CDDirectory.EachEntryAction = {
            WITH CDProperties.GetPropFromObject[ob, replaceBy] SELECT FROM
                new: CD.Object => {
                    removed: BOOL _ CDDirectory.Remove[design, name, ob];
                    IF ~removed THEN DoChilds[ob, myVal];
                    [] _ CDDirectory.Include[design, new];
                    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.GetPropFromObject[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 CDExtras.RemoveProperties[design, realKey];
        END; --ReplaceTagged
        <<>>
CleanUp: PUBLIC PROC [design: CD.Design] =
BEGIN
myKey: REF ~ NEW[INT];
replaceBy: REF ~ NEW[INT]; 
    design.actual.first.deletedList _ NIL; --so deleted unclean objects can not be undeleted
ReplaceFunnys[design, myKey];
PreTag[design, replaceBy, myKey];
ReplaceTagged[design, replaceBy, myKey];
CDExtras.RemoveProperties[design, myKey];
CDExtras.RemoveProperties[design, replaceBy];
END;

    CleanupCommand: PROC [comm: CDSequencer.Command] =
        BEGIN
        n: INT;
        TerminalIO.WriteRope["cleanup directory\n"];
        n _ comm.design.cellDirectory.size;
        CleanUp[comm.design];
        IF n = comm.design.cellDirectory.size 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[comm.design.cellDirectory.size]]];
        END;

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