CDDirectoryOpsImpl.mesa (part of ChipNDale)
Copyright © 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, June 3, 1985 7:06:54 pm PDT
Last edited by: Christian Jacobi, November 20, 1987 3:53:31 pm PST
DIRECTORY
Atom,
CD,
CDCells,
CDDefaultProcs,
CDDirectory,
CDDirectoryOps,
CDOps,
CDProperties,
CDSequencer,
CDValue,
CedarProcess,
List,
Process,
RefTab,
Rope,
RuntimeError USING [UNCAUGHT],
TerminalIO,
TextFind;
CDDirectoryOpsImpl:
CEDAR
MONITOR
IMPORTS Atom, CD, CDCells, CDDefaultProcs, CDDirectory, CDOps, CDProperties, CDSequencer, CDValue, CedarProcess, List, Process, RefTab, Rope, RuntimeError, TerminalIO, TextFind
EXPORTS CDDirectoryOps
SHARES CD, CDDirectory =
BEGIN
QuitOnData: CDDirectory.EachObjectProc = {
quit ← me=data
};
DontQuit: CDDirectory.EachObjectProc = {
quit ← FALSE
};
RemoveIfUnused:
PUBLIC
PROC [design:
CD.Design, ob:
CD.Object]
RETURNS [done:
BOOL ←
FALSE, msg: Rope.
ROPE ←
NIL] = {
EachDirObject: CDDirectory.EachObjectProc = {
quit ← CDDirectory.EnumerateObject[ob: me, proc: QuitOnData, data: data, recurse: TRUE, visited: seen];
};
found: BOOL;
seen: RefTab.Ref ← RefTab.Create[];
name: Rope.ROPE ← CDDirectory.Name[ob, design];
toDeleteOb: CD.Object ← CDDirectory.Fetch[design, name];
IF toDeleteOb=NIL THEN RETURN [done ← FALSE, msg ← "object was not in directory"];
IF toDeleteOb#ob THEN RETURN [done ← FALSE, msg ← "naming problem"];
IF ~CDDirectory.IsIncluded[design, ob]
THEN
RETURN [done ← FALSE, msg ← "object was not in directory"];
found ← CDDirectory.EnumerateDesign[design: design, proc: QuitOnData, visited: seen, data: toDeleteOb, dir: FALSE];
IF found
THEN
RETURN [done ← FALSE, msg ← "is used in design"];
found ← CDDirectory.EnumerateDesign[design: design, proc: EachDirObject, visited: seen, data: toDeleteOb, dir: TRUE, recurse: FALSE, dummy: FALSE];
IF found
THEN
RETURN [done ← FALSE, msg ← "is used by other object in directory of design"];
CDOps.FlushRemember[design];
[] ← CDDirectory.Remove[design, name, toDeleteOb];
RETURN [done ← TRUE, msg ← NIL];
};
CompletelyDestroy:
PROC [design:
CD.Design, list:
LIST
OF
CD.Object] = {
cnt: INT ← 0;
tem: LIST OF CD.Object;
IF list#
NIL
THEN {
CDOps.FlushRemember[design];
WHILE list#
NIL
DO
IF list.first.class.composed AND ~list.first.immutable THEN list.first^.properties ← NIL;
list.first ← NIL; tem ← list; list ← list.rest; tem.rest ← NIL;
IF (cnt𡤌nt+1)>1000 THEN RETURN; --protect zct table
ENDLOOP
}
};
PruneDirectory:
PUBLIC PROC [design:
CD.Design, askFirst:
BOOL←
FALSE, pattern: Rope.
ROPE ←
NIL] = {
RemoveUnusedObs:
PROC [name: Rope.
ROPE, ob:
CD.Object]
RETURNS [quit:
BOOL←
FALSE] = {
IF ~RefTab.Fetch[instanced, ob].found
THEN {
ob ← CDDirectory.Remove[design: design, name: name, expectObject: ob];
IF ob#NIL THEN removed ← CONS[ob, removed];
}
};
ListUnusedObs:
PROC [name: Rope.
ROPE, ob:
CD.Object]
RETURNS [quit:
BOOL←
FALSE] = {
IF ~RefTab.Fetch[instanced, ob].found
THEN {
TerminalIO.PutF1[" - %g\n", [rope[name]]];
cnt ← cnt + 1
}
};
VisitNamedObs:
PROC [name: Rope.
ROPE, ob:
CD.Object]
RETURNS [quit:
BOOL←
FALSE] = {
IF ~TextFind.SearchRope[finder: finder, rope: name].found
THEN {
[] ← CDDirectory.EnumerateObject[ob: ob, proc: DontQuit, visited: instanced];
[] ← RefTab.Insert[instanced, ob, $x];
}
};
finder: TextFind.Finder ← NIL;
instanced: RefTab.Ref ← RefTab.Create[];
removed: LIST OF CD.Object ← NIL;
cnt: NAT ← 0;
IF pattern#NIL THEN finder ← TextFind.CreateFromRope[pattern: pattern, ignoreCase: TRUE];
[] ← CDDirectory.EnumerateDesign[design: design, proc: DontQuit, visited: instanced, dir: FALSE];
IF finder#
NIL
THEN {
[] ← CDDirectory.Enumerate[design: design, action: VisitNamedObs];
};
IF askFirst
THEN {
TerminalIO.PutRope[" list of matching objects not used:\n"];
[] ← CDDirectory.Enumerate[design: design, action: ListUnusedObs];
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];
CDOps.FlushRemember[design];
[] ← CDDirectory.Enumerate[design: design, action: RemoveUnusedObs];
CompletelyDestroy[design, removed];
IF askFirst THEN TerminalIO.PutRope[" deleted\n"];
};
removed ← NIL;
};
RenameNRemove:
PUBLIC PROC [design:
CD.Design, ob:
CD.Object, name: Rope.
ROPE] = {
ob1: CD.Object;
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"], fiddle: TRUE];
};
[] ← CDDirectory.Rename[design: design, object: ob, newName: name, fiddle: TRUE];
IF ob1#NIL THEN [] ← RemoveIfUnused[design: design, ob: ob1];
};
ReplaceFunnys: PROC [design: CD.Design, rootOb: CD.Object, key: REF] = {
--Replaces all object with funny classes in place,
--hopes that this is allowed... but it does not know funny classes and their restrictions
--IF rootOb#NIL only rootOb and its descendants are handled
--Of course, there shouldn't be any funny classes...
--key: a property key which will be used freely... NIL is ok
realKey: REF ~ IF key=NIL THEN NEW[INT] ELSE key;
DirtyExpand: PROC [ob: CD.Object] = {
WHILE ob.class.internalWrite=NIL AND ~ob.immutable DO
--real dirty, but it never happens because internalWrite is never NIL, except...
new: CD.Object; ta, ca: BOOL; own: REF;
[new, ta, ca] ← CDDirectory.Expand1[ob]; --we ignore modes; class is fishy
own ← CDProperties.GetObjectProp[ob, $OwnerDesign];
IF new=NIL THEN {
TerminalIO.PutF["**** %g is fishy\n", [rope[CD.Describe[ob, NIL, design]]]];
EXIT;
};
CDProperties.AppendProps[looser: new.properties, winner: ob.properties, putOnto: new];
TerminalIO.PutF["* %g has been modified in all designs\n", [rope[CD.Describe[ob, NIL, design]]]];
ob^ ← new^; --real dirty--
CDProperties.PutObjectProp[ob, $OwnerDesign, own];
CDCells.SetSimplificationTreshhold[ob, 50];
ENDLOOP;
};
DoIt: CDDirectory.EachObjectProc = {
--uses globals: realKey
IF me.class.composed AND CDProperties.GetObjectProp[me, realKey]#data THEN {
CDProperties.PutProp[me, realKey, data];
DirtyExpand[me];
[] ← CDDirectory.EnumerateChildObjects[me, DoIt, data];
};
};
IF rootOb#NIL THEN [] ← DoIt[rootOb, NEW[INT]]
ELSE [] ← CDDirectory.EnumerateDesign[design, DoIt, NEW[INT]];
IF key=NIL THEN RemoveProperties[design, realKey];
};
PreTag:
PROC [design:
CD.Design, rootOb: CD.Object, tag:
REF, key:
REF] = {
--figures out whether objects have funny classes and should be replaced
--or whether objects should be replaced because they are in different designs:
--such objects will be taken, expanded or copied, included in the directory and put
--onto the tag property
DoIt: CDDirectory.EachObjectProc = {
--uses globals: design, tag, key
IF me.class.composed
AND CDProperties.GetObjectProp[me, key]#data
THEN {
useOb, new: CD.Object; ta, ca: BOOL;
UseNewAndTmToFinish:
PROC [includeIfNecessary:
BOOL]
RETURNS [failed:
BOOL ←
FALSE] = {
--uses new, tm, useOb, me and tag
IF new=
NIL
OR new.class.internalWrite=
NIL
THEN {
new ← CDDirectory.Expand1ByDraw[useOb, CDDirectory.LeaveNextLevel];
};
IF new#
NIL
THEN {
[new, ca] ← CDDirectory.Another1[me: new, into: design, friendly: TRUE];
IF new=
NIL
OR new.class.internalWrite=
NIL
THEN {
new ← CDDirectory.Expand1ByDraw[useOb, CDDirectory.LeaveNextLevel];
};
};
IF new=
NIL
THEN {
TerminalIO.PutF["**** %g is fishy\n", [rope[CD.Describe[me, NIL, design]]]];
RETURN [failed←TRUE]
};
--ca: childs are copied or included when going down the main recursion
useOb ← new;
CDProperties.PutProp[me, tag, useOb];
};
CDProperties.PutProp[me, key, data]; --don't visit me a second time
new ← useOb ← me;
--fix funny classes
IF useOb.class.internalWrite=
NIL
THEN {
--it never happens, except...
WHILE new#
NIL
AND new.class.internalWrite=
NIL
DO
[new, ta, ca] ← CDDirectory.Expand1[me: new, into: design, friendly: TRUE];
ENDLOOP;
IF UseNewAndTmToFinish[FALSE].failed THEN RETURN;
};
--fix funny designs
IF ~CDDirectory.CompatibleOwner[design, useOb]
THEN {
[new, ca] ← CDDirectory.Another[me: useOb, into: design, friendly: TRUE];
IF UseNewAndTmToFinish[TRUE].failed THEN RETURN;
ERROR; --on Friday February 13, 1987 Brian, Bertrand and Rick agreed that ChipNDale might call an error in this case
};
CDDirectory.SetOwner[design, useOb, FALSE];
--go down hierarchy
[] ← CDDirectory.EnumerateChildObjects[useOb, DoIt, data];
};
};
IF rootOb#NIL THEN [] ← DoIt[rootOb, NEW[INT]]
ELSE [] ← CDDirectory.EnumerateDesign[design, DoIt, NEW[INT]];
};
ReplaceTaggedOneLevel:
PROC [design:
CD.Design, ob:
CD.Object, tag:
REF] = {
ForCells:
PROC [cell:
CD.Object, tag:
REF] =
INLINE {
EachInst: CDCells.InstEnumerator = {
WITH CDProperties.GetObjectProp[inst.ob, tag]
SELECT
FROM
ob: CD.Object => inst.ob ← ob;
ENDCASE => NULL;
};
[] ← CDCells.EnumerateInstances[cell, EachInst];
}; --ForCells
ForNonCells:
PROC [design:
CD.Design, ob:
CD.Object, tag:
REF] =
INLINE
--gfi--{
replaces: CDDirectory.ReplaceList ← NIL;
FindReplaces: CDDirectory.EachObjectProc = {
WITH CDProperties.GetObjectProp[me, tag]
SELECT
FROM
new:
CD.Object => {
FOR l: CDDirectory.ReplaceList ← replaces, l.rest
WHILE l#
NIL
DO
IF l.first.old=me THEN RETURN;
ENDLOOP;
replaces ← CONS[NEW[CDDirectory.ReplaceRec ← [old: me, new: new]], replaces];
};
ENDCASE => NULL;
}; --FindReplaces
--ForNonCells
[] ← CDDirectory.EnumerateChildObjects[ob, FindReplaces, NIL];
IF replaces#
NIL
THEN
[] ← CDDirectory.ReplaceDirectChild[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] = {
myVal: REF ~ NEW[INT];
realKey: REF ~ IF key=NIL THEN NEW[INT] ELSE key;
DoChilds: CDDirectory.EachObjectProc = {
--globals: design, realKey
--data: visit key
IF me.class.composed
AND CDProperties.GetObjectProp[me, realKey]#data
THEN {
CDProperties.PutProp[me, realKey, data];
ReplaceTaggedOneLevel[design, me, replaceBy];
[] ← CDDirectory.EnumerateChildObjects[me, DoChilds, data];
};
}; --DoChilds
EachEntry: CDDirectory.EachObjectProc = {
WITH CDProperties.GetObjectProp[me, replaceBy]
SELECT
FROM
new:
CD.Object => {
name: Rope.ROPE ← CDDirectory.Name[me, design];
removed: CD.Object ← CDDirectory.Remove[design, name, me];
IF removed#
NIL
THEN {
[] ← DoChilds[me, myVal];
TerminalIO.PutRopes["** problem with replacing ", name, "\n"];
};
IF name#
NIL
THEN {
IF rename THEN [] ← CDDirectory.Rename[design: design, object: new, newName: name, fiddle: FALSE, removeFirst: TRUE];
};
me ← new;
};
ENDCASE => NULL;
[] ← DoChilds[me, myVal];
};
--ReplaceTagged
FOR pushed:
LIST
OF
CD.PushRec ← design.actual, pushed.rest
WHILE pushed#
NIL
DO
FOR list:
CD.InstanceList ← 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.EnumerateDesign[design, EachEntry];
IF key=NIL THEN RemoveProperties[design, realKey];
}; --ReplaceTagged
CleanUp:
PUBLIC PROC [design:
CD.Design, rootOb: CD.Object] = {
myKey: REF ATOM ~ NEW[ATOM←$UsedForCleanup];
replaceBy: REF ATOM ~ NEW[ATOM←$UsedForCleanup];
CDOps.FlushRemember[design];
PreTag[design, rootOb, replaceBy, myKey];
ReplaceTagged[design, replaceBy, TRUE, myKey];
RemoveProperties[design, myKey];
RemoveProperties[design, replaceBy];
myKey^ ← $MayBeRemoved;
replaceBy^ ← $MayBeRemoved;
};
--==== property removing =====
RemoveRecord:
TYPE =
RECORD [
--monitored; used to remember what properties to forget
running: BOOL ← FALSE, --a forget loop process is running right now
forgetNext: LIST OF REF ANY ← NIL, --use next time in forget loop
--the following fields only accessed in removeloop
forgetNow: LIST OF REF ANY ← NIL,
visited: RefTab.Ref ← NIL
];
DepositAndStart:
ENTRY
PROC [design:
CD.Design, rr:
REF RemoveRecord, key:
REF] = {
--deposit property key in forget queue; starts forget loop process if necessary
IF rr#
NIL
AND ~List.Memb[key, rr.forgetNext]
THEN {
rr.forgetNext ← CONS[key, rr.forgetNext];
IF ~rr.running
THEN {
rr.running ← TRUE;
TRUSTED {Process.Detach[FORK RemoveLoop[design, rr]]}
};
};
};
FetchAndStop:
ENTRY
PROC [rr:
REF RemoveRecord]
RETURNS [forgetNow:
LIST
OF
REF
ANY ←
NIL] = {
--fetch and remove property keys from the forget queue
--if queue is empty: mark forget loop process as NOT running
IF rr#
NIL
THEN {
forgetNow ← rr.forgetNext; rr.forgetNext ← NIL;
IF forgetNow=NIL THEN rr.running ← FALSE;
}
};
RemDrawChild:
CD.DrawProc = {
rr: REF RemoveRecord ← NARROW[pr.devicePrivate];
IF RefTab.Insert[rr.visited, ob, $x]
THEN {
FOR l:
LIST
OF
REF
ANY ← rr.forgetNow, l.rest
WHILE l#
NIL
DO
CDProperties.PutObjectProp[onto: ob, prop: l.first, val: NIL];
ENDLOOP;
IF ob.class.composed
THEN
ob.class.drawMe[pr, ob, trans, readOnlyInstProps];
};
Process.Yield[];
};
RemoveLoop:
PROC [design:
CD.Design, rr:
REF RemoveRecord] = {
--loops and forgets properties, as long as there are some to forget
xPr:
CD.DrawRef =
CD.CreateDrawRef[[
design: design,
drawRect: CDDefaultProcs.IgnoreRect,
drawChild: RemDrawChild,
drawOutLine: CDDefaultProcs.IgnoreRect,
selections: FALSE,
devicePrivate: rr
]];
RemoveInner:
PROC [] = {
RPEachOb: CDDirectory.EachObjectProc = {CD.DrawOb[xPr, me]};
[] ← CDDirectory.EnumerateDesign[design: design, proc: RPEachOb, dummy: TRUE, dir: TRUE, recurse: FALSE, top: TRUE];
};
CedarProcess.SetPriority[CedarProcess.Priority[background]];
DO
rr.forgetNow ← FetchAndStop[rr];
IF rr.forgetNow=NIL THEN EXIT;
rr.visited ← RefTab.Create[MAX[CDDirectory.DirSize[design], 50]+10];
RemoveInner[! RuntimeError.UNCAUGHT => CONTINUE];
ENDLOOP;
};
RemoveProperties:
PUBLIC
PROC [design:
CD.Design, key:
REF] = {
GetRemoveRecord:
PROC [d:
CD.Design]
RETURNS [rr:
REF RemoveRecord] = {
WITH CDValue.Fetch[d, $CDDirectoryOpsPrivate, design]
SELECT
FROM
r: REF RemoveRecord => RETURN [r];
ENDCASE => NULL;
[] ← CDValue.StoreConditional[d, $CDDirectoryOpsPrivate, NEW[RemoveRecord]];
rr ← GetRemoveRecord[d];
};
rr: REF RemoveRecord ~ GetRemoveRecord[design];
DepositAndStart[design, rr, key];
};
IncludeDescribedObjects:
PUBLIC PROC [design:
CD.Design, ob:
CD.Object, visited: RefTab.Ref←
NIL] = {
EachObject: CDDirectory.EachObjectProc = {
IF me.class.composed
THEN {
design: CD.Design = NARROW[data];
name: Rope.ROPE ← CDDirectory.Name[me, design];
IF name#NIL THEN RETURN;
WITH CDProperties.GetObjectProp[me, $Describe]
SELECT
FROM
n: Rope.ROPE => name ← n;
a: ATOM => name ← Atom.GetPName[a];
ENDCASE => RETURN;
[] ← CDDirectory.Include[design, me, name, TRUE];
}
};
[] ← CDDirectory.EnumerateObject[ob: ob, proc: EachObject, visited: visited, data: design, recurse: TRUE]
};
END.