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.