CDDirectoryOpsImpl.mesa (part of ChipNDale)
Copyright © 1985 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, June 3, 1985 7:06:54 pm PDT
Last edited by: Christian Jacobi, September 18, 1986 2:17:09 pm PDT
DIRECTORY
Ascii,
CD,
CDDirectory,
CDDirectoryOps,
CDMarks,
CDSequencer USING [MarkChanged],
CDSimpleOps,
TerminalIO,
Rope;
CDDirectoryOpsImpl: CEDAR PROGRAM
IMPORTS Ascii, CDDirectory, CDMarks, CDSequencer, CDSimpleOps, Rope, TerminalIO
EXPORTS CDDirectoryOps =
BEGIN
MarkUnMarkedFromTop: PROC [design: CD.Design, mark: CDMarks.MarkRange] = {
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;
};
RemoveIfUnused: PUBLIC PROC [design: CD.Design, ob: CD.Object] RETURNS [done: BOOL ← FALSE, msg: Rope.ROPE ← NIL] = {
usedBy: Rope.ROPE←NIL;
name: Rope.ROPE;
toDeleteOb: CD.Object;
found: BOOL;
DoitWithMark: PROC [mark: CDMarks.MarkRange] = {
EachEntryCheck: CDDirectory.EachEntryAction = {
-- PROC [name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL�LSE]
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
}
};
};
MarkUnMarkedFromTop[design, mark];
IF toDeleteOb.marked=mark THEN {
usedBy ← "top level";
found ← TRUE
}
ELSE
found ← CDDirectory.Enumerate[design, EachEntryCheck].quit;
};
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];
};
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] = {
Doit: PROC [mark: CDMarks.MarkRange] = {
RemoveIfNotMarked: PROC [name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL←FALSE] = {
IF ob.marked#mark THEN {
d: BOOL ← CDDirectory.Remove[design: design, name: name, expectObject: ob];
IF d THEN removed ← CONS[ob, removed];
}
};
ListNotMarked: PROC [name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL←FALSE] = {
IF ob.marked#mark THEN {
TerminalIO.PutF1[" - %g\n", [rope[name]]];
cnt ← cnt + 1
}
};
AlsoMarkNamedObjects: PROC[name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL←FALSE] = {
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];
}
};
};
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.PutRope[" List of objects not used:\n"];
[] ← CDDirectory.Enumerate[design: design, action: ListNotMarked];
TerminalIO.PutF1[" %g objects not used in design\n", [integer[cnt]]];
};
IF cnt>0 THEN {
IF askFirst AND ~TerminalIO.Confirm["delete listed objects"] THEN {
removed ← NIL;
TerminalIO.PutRope[" not done\n"];
RETURN
};
CDSequencer.MarkChanged[design];
[] ← CDDirectory.Enumerate[design: design, action: RemoveIfNotMarked];
CompletelyDestroy[design, removed];
IF askFirst THEN TerminalIO.PutRope[" deleted\n"];
};
removed ← NIL;
};
CDSimpleOps.FlushDeletedCache[design];
CDMarks.DoWithMark[design, Doit ! CDMarks.MarkOccupied => GOTO requestProblem];
EXITS
requestProblem => TerminalIO.PutRope["**Mark problem\n"];
};
RenameNRemove: PUBLIC PROC [design: CD.Design, ob: CD.Object, name: Rope.ROPE] = {
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.