CDDirectoryOpsImpl.mesa (part of ChipNDale)
Copyright © 1985 by Xerox Corporation. All rights reserved.
by Christian Jacobi, June 3, 1985 7:06:54 pm PDT
last edited by Christian Jacobi, March 14, 1986 6:30:55 pm PST
DIRECTORY
Ascii,
CD,
CDDirectory,
CDDirectoryOps,
CDMarks,
CDSimpleOps,
TerminalIO,
Rope;
CDDirectoryOpsImpl: CEDAR PROGRAM
IMPORTS Ascii, CDDirectory, CDMarks, CDSimpleOps, Rope, TerminalIO
EXPORTS CDDirectoryOps =
BEGIN
MarkUnMarkedFromTop: PROC [design: CD.Design, mark: CDMarks.MarkRange] =
BEGIN
FOR l: LIST OF CD.PushRec ← design.actual, l.rest WHILE l#NIL DO
IF l.first.mightReplace#NIL THEN {
CDMarks.MarkUnMarkedInclusiveChildren[design, l.first.mightReplace.ob, mark];
};
CDMarks.MarkUnMarkedInclusiveChildren[design, l.first.dummyCell.ob, mark];
ENDLOOP;
END;
RemoveIfUnused: PUBLIC PROC [design: CD.Design, ob: CD.Object] RETURNS [done: BOOL ← FALSE, msg: Rope.ROPE ← NIL] =
BEGIN
usedBy: Rope.ROPE←NIL;
name: Rope.ROPE;
toDeleteOb: CD.Object;
found: BOOL;
DoitWithMark: PROC [mark: CDMarks.MarkRange] =
BEGIN
EachEntryCheck: CDDirectory.EachEntryAction
-- PROC [name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL�LSE]-- =
BEGIN
IF ob.marked#mark AND ob#toDeleteOb THEN {
--an occurence of cellOb should not be marked
CDMarks.MarkUnMarkedInclusiveChildren[design, ob, mark];
IF toDeleteOb.marked=mark THEN {
usedBy ← name;
quit ← TRUE
}
};
END;
MarkUnMarkedFromTop[design, mark];
IF toDeleteOb.marked=mark THEN {
usedBy ← "top level";
found ← TRUE
}
ELSE
found ← CDDirectory.Enumerate[design, EachEntryCheck].quit;
END;
name ← CDDirectory.Name[ob];
[found, toDeleteOb] ← CDDirectory.Fetch[design, name];
IF ~found THEN RETURN [done ← FALSE, msg ← "object was not in directory"];
IF toDeleteOb#ob THEN RETURN [done ← FALSE, msg ← "naming problem"];
-- mark all entries (excluding toDeleteOb), and all their children
-- test then if toDeleteOb is marked; if it is, it is a child and used
CDMarks.DoWithMark[design, DoitWithMark];
IF found THEN
RETURN [done ← FALSE, msg ← Rope.Cat["is used by ", usedBy, " (and maybe others)"]];
CDSimpleOps.FlushDeletedCache[design];
IF ~CDDirectory.Remove[design, name, toDeleteOb] THEN
RETURN [done ← FALSE, msg ← "error in delete routine"];
RETURN [done ← TRUE, msg ← NIL];
END;
CompletelyDestroy: PROC [design: CD.Design, list: LIST OF CD.Object] =
BEGIN
tem: LIST OF CD.Object;
IF list#NIL THEN {
CDSimpleOps.FlushDeletedCache[design];
WHILE list#NIL DO
IF list.first.class.inDirectory THEN
list.first^ ← CD.ObjectRep[class: NIL]; this used to kill caching modules
list.first^.properties ← NIL;
list.first ← NIL;
tem ← list;
list ← list.rest;
tem.rest ← NIL;
ENDLOOP
}
END;
PruneDirectory: PUBLIC PROC [design: CD.Design, autoOnly: BOOL ← FALSE, askFirst: BOOL←FALSE] =
BEGIN
Doit: PROC [mark: CDMarks.MarkRange] =
BEGIN
RemoveIfNotMarked: PROC [name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL←FALSE] =
BEGIN
IF ob.marked#mark THEN {
d: BOOL ← CDDirectory.Remove[design: design, name: name, expectObject: ob];
IF d THEN removed ← CONS[ob, removed];
}
END;
ListNotMarked: PROC [name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL←FALSE] =
BEGIN
IF ob.marked#mark THEN {
TerminalIO.WriteRope[" - "]; TerminalIO.WriteRope[name]; TerminalIO.WriteLn[];
cnt ← cnt + 1
}
END;
AlsoMarkNamedObjects: PROC[name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL←FALSE] =
BEGIN
IF ob.marked#mark THEN {
ch: CHAR = IF Rope.Length[name]<=0 THEN 'A ELSE Rope.Fetch[name];
IF Ascii.Letter[ch] OR Ascii.Digit[ch] THEN {
CDMarks.MarkUnMarkedInclusiveChildren[design, ob, mark];
}
};
END;
removed: LIST OF CD.Object ← NIL;
cnt: NAT ← 0;
MarkUnMarkedFromTop[design, mark];
IF autoOnly THEN {
[] ← CDDirectory.Enumerate[design: design, action: AlsoMarkNamedObjects];
};
IF askFirst THEN {
TerminalIO.WriteRope[" List of objects not used:\n"];
[] ← CDDirectory.Enumerate[design: design, action: ListNotMarked];
TerminalIO.WriteRope[" "];
TerminalIO.WriteInt[cnt];
TerminalIO.WriteRope[" objects not used in design\n"];
};
IF cnt>0 THEN {
IF askFirst AND ~TerminalIO.Confirm[label: "delete listed objects", choice: " yes"] THEN {
removed ← NIL;
TerminalIO.WriteRope[" not done\n"];
RETURN
};
[] ← CDDirectory.Enumerate[design: design, action: RemoveIfNotMarked];
CompletelyDestroy[design, removed];
IF askFirst THEN TerminalIO.WriteRope[" deleted\n"];
};
removed ← NIL;
END;
CDSimpleOps.FlushDeletedCache[design];
CDMarks.DoWithMark[design, Doit ! CDMarks.MarkOccupied => GOTO requestProblem];
EXITS
requestProblem => TerminalIO.WriteRope["**Mark problem\n"];
END;
RenameNRemove: PUBLIC PROC [design: CD.Design, ob: CD.Object, name: Rope.ROPE] =
BEGIN
ob1: CD.Object;
IF ~ob.class.inDirectory THEN ERROR;
ob1 ← CDDirectory.Fetch[design, name].object;
IF ob1#NIL THEN {
IF ob1=ob THEN RETURN;
[] ← CDDirectory.Rename[design: design, object: ob1, newName: Rope.Cat[name, "@old"], fiddleName: TRUE];
};
[] ← CDDirectory.Rename[design: design, object: ob, newName: name, fiddleName: TRUE];
IF ob1#NIL THEN {
[] ← RemoveIfUnused[design: design, ob: ob1]
};
END;
END.