<> <> <> <> 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_cnt+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]; }; <> <<--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>> <> <<>> <> <> <<--real dirty, but it never happens because internalWrite is never NIL, except... >> <> <<[new, ta, ca] _ CDDirectory.Expand1[ob]; --we ignore modes; class is fishy>> <> <> <> <> <<};>> <> <> <> <> <> <> <<};>> <<>> <> <<--uses globals: realKey>> <> <> <> <<[] _ CDDirectory.EnumerateChildObjects[me, DoIt, data];>> <<};>> <<};>> <<>> <> <> <> <<};>> <<>> 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];>> <> 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.