DIRECTORY CD, CDCacheBase, CDCells, CDCellsBackdoor, CDDefaultProcs, CDDirectory, CDEvents, CDBasics, CDOps, CDProperties, CDRects, CDValue, IO, Properties, Random, RefTab, Rope, SymTab, TerminalIO; CDDirectoryImpl: CEDAR MONITOR IMPORTS CD, CDDirectory, CDCells, CDCellsBackdoor, CDDefaultProcs, CDEvents, CDBasics, CDOps, CDProperties, CDRects, CDValue, IO, Properties, Random, RefTab, Rope, SymTab, TerminalIO EXPORTS CDDirectory, CDCacheBase SHARES CD, CDRects = BEGIN SetOwner: PUBLIC PROC [design: CD.Design, object: CD.Object, check: BOOL_TRUE] = { x: REF _ (IF design=NIL THEN NIL ELSE design.cdDirectoryPriv2); IF check THEN SELECT CDProperties.GetObjectProp[object, ownerKey] FROM x => RETURN; NIL => {}; ENDCASE => ERROR CD.Error[directoryInvariant, "object in different design"]; IF object.immutable AND design#NIL THEN ERROR CD.Error[calling, "don't set ownership of immutable object"]; CDProperties.PutObjectProp[object, ownerKey, x]; }; IsOwner: PUBLIC PROC [design: CD.Design, object: CD.Object] RETURNS [BOOL] = { x: REF ~ (IF design=NIL THEN NIL ELSE design.cdDirectoryPriv2); SELECT CDProperties.GetObjectProp[object, ownerKey] FROM x => RETURN [TRUE]; ENDCASE => RETURN [FALSE]; }; CompatibleOwner: PUBLIC PROC [design: CD.Design, object: CD.Object] RETURNS [BOOL] = { x: REF ~ (IF design=NIL THEN NIL ELSE design.cdDirectoryPriv2); SELECT CDProperties.GetObjectProp[object, ownerKey] FROM x => RETURN [TRUE]; NIL => RETURN [TRUE]; ENDCASE => RETURN [FALSE]; }; EachEntryAction: TYPE = PROC [name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL_FALSE]; Fetch: PUBLIC PROC [design: CD.Design, name: Rope.ROPE] RETURNS [object: CD.Object_NIL] = { WITH SymTab.Fetch[design.cdDirectory1, name].val SELECT FROM ob: CD.Object => RETURN [ob] ENDCASE => RETURN [NIL]; }; Remove: PUBLIC PROC [design: CD.Design, name: Rope.ROPE, expectObject: CD.Object_NIL] RETURNS [ob: CD.Object] = { ob _ MyRemove[design, name, expectObject].removed; IF ob#NIL THEN { [] _ DirectoryOp[ob, design, name, remove]; }; }; Fiddle: PUBLIC PROC [design: CD.Design, name: Rope.ROPE] RETURNS [ob: CD.Object] = { ob _ MyRemove[design, name].removed; IF ob#NIL THEN { newName: Rope.ROPE _ IncludeFiddled[design, ob, name]; [] _ DirectoryOp[ob, design, newName, rename]; }; }; IncludeFiddled: PROC [design: CD.Design, ob: CD.Object, name: Rope.ROPE] RETURNS [newName: Rope.ROPE] = { try: INT _ 0; DO IF (try _ try+1) < 3 THEN {name _ FiddleName[name, design]} ELSE {try _ 0; name _ FiddleGlobal[name]}; IF SymTab.Insert[design.cdDirectory1, name, ob] THEN { [] _ RefTab.Store[design.cdDirectory2, ob, name]; RETURN [name]; } ENDLOOP; }; Status: TYPE = {done, ok, failed}; MyRemove: PROC [design: CD.Design, name: Rope.ROPE, expectObject: CD.Object_NIL] RETURNS [status: Status_failed, removed: CD.Object_NIL] = { object: CD.Object _ Fetch[design, name].object; IF object=NIL THEN RETURN [ok, NIL]; IF (object=expectObject OR expectObject=NIL) THEN { IF ~CompatibleOwner[design, object] THEN ERROR CD.Error[directoryInvariant, "Removed object in different design"]; IF RefTab.Delete[design.cdDirectory2, object] THEN removed _ object; IF SymTab.Delete[design.cdDirectory1, name] THEN removed _ object; IF removed#NIL THEN status _ done }; }; DirectoryOp: PROC[me: CD.Object, design: CD.Design, name: Rope.ROPE, function: CDDirectory.DirectoryFunction] = { IF me.class.composed THEN { dop: CDDirectory.DirectoryProc = CDDirectory.ObToDirectoryProcs[me].directoryOp; IF dop#NIL THEN dop[me, design, name, function]; } }; IsIncluded: PUBLIC PROC [design: CD.Design, object: CD.Object] RETURNS [BOOL] = { name: Rope.ROPE _ CDDirectory.Name[object, design]; RETURN [name#NIL] }; Include: PUBLIC PROC [design: CD.Design, object: CD.Object, name: Rope.ROPE, fiddle: BOOL_TRUE] RETURNS [done: BOOL_FALSE] = { oldName: Rope.ROPE _ NIL; try: INT _ 0; IF Rope.IsEmpty[name] THEN name _ "-noname-"; IF ~object.immutable AND object.class.composed THEN SetOwner[design, object, TRUE]; IF (oldName _ CDDirectory.Name[object, design])#NIL THEN { IF Rope.Equal[oldName, name] THEN RETURN [TRUE]; RETURN [FALSE]; }; IF SymTab.Insert[design.cdDirectory1, name, object] THEN { [] _ RefTab.Store[design.cdDirectory2, object, name]; DirectoryOp[object, design, name, include]; RETURN [TRUE] }; IF fiddle THEN { name _ IncludeFiddled[design, object, name]; DirectoryOp[object, design, name, include]; RETURN [TRUE] }; RETURN [FALSE] }; FiddleGlobal: PROC [name: Rope.ROPE] RETURNS [Rope.ROPE] = { RETURN [IO.PutFR["%g@%g@0", IO.rope[name], IO.int[Random.ChooseInt[max: LAST[NAT]]]]]; }; NextFiddleKey: PROC [design: CD.Design] RETURNS [key: INT] = { WITH CDProperties.GetDesignProp[design, $FiddleKey] SELECT FROM i: REF INT => {key _ i^; i^ _ i^ MOD 1000000B + 1}; ENDCASE => {key _ 0; CDProperties.PutDesignProp[design, $FiddleKey, NEW[INT_1]]}; }; FiddleName: PROC [name: Rope.ROPE, design: CD.Design] RETURNS [Rope.ROPE] = { modifier: INT _ NextFiddleKey[design]; leng: INT _ name.Length[]; WHILE leng>0 DO leng _ leng-1; IF name.Fetch[leng]='@ THEN { name _ name.Substr[0, leng]; EXIT } ENDLOOP; name _ IO.PutFR["%g@%g", IO.rope[name], IO.int[modifier]]; RETURN [name]; }; Rename: PUBLIC PROC [design: CD.Design, object: CD.Object, newName: Rope.ROPE _ NIL, fiddle: BOOL _ TRUE, fiddleFirst: BOOL _ FALSE, removeFirst: BOOL _ FALSE] RETURNS [done: BOOL, conflict: CD.Object] = { oldName: Rope.ROPE = CDDirectory.Name[object, design]; status: Status; IF ~CompatibleOwner[design, object] THEN ERROR CD.Error[directoryInvariant]; status _ MyRemove[design, oldName, object].status; IF status=failed THEN RETURN [FALSE, CDDirectory.Fetch[design, newName]]; IF SymTab.Insert[design.cdDirectory1, newName, object] THEN { [] _ RefTab.Store[design.cdDirectory2, object, newName]; DirectoryOp[object, design, newName, (IF status = done THEN rename ELSE include)]; RETURN [TRUE, NIL] }; conflict _ CDDirectory.Fetch[design, newName]; IF fiddle THEN { newName _ IncludeFiddled[design, object, newName]; DirectoryOp[object, design, newName, (IF status = done THEN rename ELSE include)]; RETURN [TRUE, conflict] } ELSE { --NOT fiddle IF conflict#NIL THEN { IF conflict=object THEN RETURN [TRUE, NIL]; IF fiddleFirst THEN conflict _ Fiddle[design, newName] ELSE IF removeFirst THEN conflict _ Remove[design, newName] }; IF SymTab.Insert[design.cdDirectory1, newName, object] THEN { [] _ RefTab.Store[design.cdDirectory2, object, newName]; DirectoryOp[object, design, newName, (IF status = done THEN rename ELSE include)]; RETURN [TRUE, conflict] }; IF status=done THEN { [] _ IncludeFiddled[design, object, oldName]; RETURN [done: FALSE, conflict: conflict] }; ERROR CD.Error[programming, "rename removed an object"] } }; Enumerate: PUBLIC PROC [design: CD.Design, action: EachEntryAction] RETURNS [quit: BOOL] = { EachPairAction: SymTab.EachPairAction ~ { quit _ action[name: NARROW[key], ob: NARROW[val, CD.Object]] }; quit _ SymTab.Pairs[design.cdDirectory1, EachPairAction] }; DirSize: PUBLIC PROC [design: CD.Design] RETURNS [INT] = { RETURN [SymTab.GetSize[design.cdDirectory1]] }; InstallDirectoryProcs: PUBLIC PROC [type: CD.ObjectClass, dp: CDDirectory.DirectoryProcs] RETURNS [REF CDDirectory.DirectoryProcs] = { dpr: REF CDDirectory.DirectoryProcs ~ NEW[CDDirectory.DirectoryProcs_dp]; IF type.directoryProcs#NIL OR type.composed THEN ERROR CD.Error[ec: doubleRegistration, explanation: "type already composed"]; type.directoryProcs _ dpr; type.composed _ TRUE; IF dpr.enumerateChildObjects=NIL THEN dpr.enumerateChildObjects _ DefaultEnumerateChildObjects; IF dpr.replaceDirectChilds=NIL THEN dpr.replaceDirectChilds _ DefaultReplaceDirectChilds; IF dpr.another=NIL THEN dpr.another _ DefaultAnother; IF dpr.expand=NIL THEN dpr.expand _ DefaultExpand; IF dpr.directoryOp=NIL THEN dpr.directoryOp _ DefaultDirectoryOp; RETURN [dpr] }; DefaultAnother: CDDirectory.AnotherProc = { new _ NEW[CD.ObjectRep_me^]; --this would not be ok for most object classes new.properties _ CDProperties.DCopyProps[me.properties]; childAccessible _ (IF into#NIL AND into=fromOrNil THEN ~me.class.xDesign ELSE FALSE); }; DefaultExpand: CDDirectory.ExpandProc = { new _ Expand1ByDraw[me, LeaveNextLevel]; topAccessible _ TRUE; childAccessible _ (into=fromOrNil OR into#NIL); }; DefaultReplaceDirectChilds: CDDirectory.ReplaceDChildsProc = { ERROR CD.Error[missingRegistration, "Don't default this procedure"]; }; DefaultEnumerateChildObjects: CDDirectory.EnumerateChildObjectsProc = { -- IF me.class.composed AND ~me.class.xDesign THEN { exp: CD.Object; exp _ Expand1ByDraw[me, LeaveNextLevel, NIL]; quit _ CDDirectory.EnumerateChildObjects[exp, proc, data]; RETURN }; -- -- IF me.class.composed AND ~me.class.xDesign THEN { xPr: CD.DrawRef = CD.CreateDrawRef[[ drawRect: CDDefaultProcs.IgnoreRect, drawChild: EnumerateByDrawing, drawOutLine: CDDefaultProcs.IgnoreRect, selections: FALSE, symbolics: FALSE, devicePrivate: NEW[EnumRec_[data, proc]] ]]; CD.DrawOb[xPr, me ! QuitEnumerating => GOTO quit]; }; RETURN [FALSE]; EXITS quit => RETURN [TRUE] }; EnumRec: TYPE = RECORD [data: REF, proc: CDDirectory.EachObjectProc]; QuitEnumerating: ERROR = CODE; EnumerateByDrawing: CD.DrawProc = { IF ob.class.composed THEN { er: REF EnumRec _ NARROW[pr.devicePrivate]; IF er.proc[ob, er.data].quit THEN ERROR QuitEnumerating; } }; DefaultDirectoryOp: PROC [me: CD.Object, design: CD.Design, name: Rope.ROPE, function: CDDirectory.DirectoryFunction] = { }; Name: PUBLIC PROC [object: CD.Object, design: CD.Design] RETURNS [Rope.ROPE] = { WITH RefTab.Fetch[design.cdDirectory2, object].val SELECT FROM r: Rope.ROPE => RETURN [r] ENDCASE => RETURN [NIL]; }; EnumerateDesign: PUBLIC PROC [design: CD.Design, proc: CDDirectory.EachObjectProc, data: REF_NIL, dir: BOOL_TRUE, top: BOOL_TRUE, recurse: BOOL_TRUE, dummy: BOOL_FALSE, visited: RefTab.Ref_NIL] RETURNS [quit: BOOL_FALSE] = { Handle: PROC [ob: CD.Object] RETURNS [quit: BOOL_FALSE] = INLINE { IF RefTab.Insert[visited, ob, $x] THEN { IF recurse THEN quit _ CDDirectory.EnumerateChildObjects[ob, CheckNRecurse]; IF ~quit THEN quit _ proc[ob, data]; } }; CheckNRecurse: CDDirectory.EachObjectProc = { IF me.class.composed THEN RETURN [Handle[me]]; }; EachDirEntry: SymTab.EachPairAction = { ob: CD.Object _ NARROW[val, CD.Object]; IF ob.class.composed THEN RETURN [Handle[ob]]; }; IF visited=NIL THEN visited _ RefTab.Create[MAX[CDDirectory.DirSize[design], 28]+17]; IF dir THEN quit _ SymTab.Pairs[design.cdDirectory1, EachDirEntry]; IF top THEN FOR l: LIST OF CD.PushRec _ design.actual, l.rest WHILE (l#NIL AND ~quit) DO IF l.first.mightReplace#NIL THEN quit _ CheckNRecurse[l.first.mightReplace.ob]; IF ~quit THEN quit _ IF dummy THEN CheckNRecurse[l.first.dummyCell.ob] ELSE CDDirectory.EnumerateChildObjects[l.first.dummyCell.ob, CheckNRecurse] ENDLOOP; }; EnumerateObject: PUBLIC PROC [ob: CD.Object, proc: CDDirectory.EachObjectProc, data: REF_NIL, recurse: BOOL_TRUE, visited: RefTab.Ref_NIL] RETURNS [quit: BOOL_FALSE] = { Handle: PROC [ob: CD.Object] RETURNS [quit: BOOL_FALSE] = INLINE { IF RefTab.Insert[visited, ob, $x] THEN { IF recurse THEN quit _ CDDirectory.EnumerateChildObjects[ob, CheckNRecurse]; IF ~quit THEN quit _ proc[ob, data]; } }; CheckNRecurse: CDDirectory.EachObjectProc = { IF me.class.composed THEN RETURN [Handle[me]]; }; IF visited=NIL THEN visited _ RefTab.Create[]; IF ob.class.composed THEN RETURN [Handle[ob]]; }; Another1: PUBLIC PROC [me: CD.Object, fromOrNil: CD.Design_NIL, into: CD.Design_NIL, friendly: BOOL_FALSE] RETURNS [new: CD.Object, childAccessible: BOOL] = { IF ~me.class.composed THEN RETURN [me, TRUE] ELSE { another: CDDirectory.AnotherProc _ CDDirectory.ObToDirectoryProcs[me].another; IF another=NIL THEN ERROR CD.Error[missingRegistration]; [new, childAccessible] _ another[me, fromOrNil, into, friendly]; IF childAccessible THEN SetOwner[into, new]; }; }; Expand1: PUBLIC PROC [me: CD.Object, fromOrNil: CD.Design_NIL, into: CD.Design_NIL, friendly: BOOL_FALSE] RETURNS [new: CD.Object, topAccessible: BOOL, childAccessible: BOOL] = { IF ~me.class.composed THEN RETURN [NIL, FALSE, FALSE] ELSE { expand: CDDirectory.ExpandProc = CDDirectory.ObToDirectoryProcs[me].expand; IF expand=NIL THEN ERROR CD.Error[missingRegistration]; [new, topAccessible, childAccessible] _ expand[me, fromOrNil, into, friendly]; IF topAccessible AND childAccessible THEN SetOwner[into, new]; }; }; AnotherRecursed: PUBLIC PROC [me: CD.Object, into: CD.Design_NIL, fromOrNil: CD.Design_NIL, cx: RefTab.Ref_NIL, getFromCache: CDDirectory.GetFromCacheProc_NIL, putInCache: CDDirectory.PutInCacheProc_NIL, data: REF_NIL] RETURNS [new: CD.Object_NIL] = { ca: BOOL _ TRUE; IF cx=NIL THEN cx _ RefTab.Create[] ELSE WITH RefTab.Fetch[cx, me].val SELECT FROM ob: CD.Object => RETURN [ob]; ENDCASE => NULL; IF getFromCache#NIL THEN { new _ getFromCache[me, data]; IF new#NIL THEN {[] _ RefTab.Store[cx, me, new]; RETURN}; }; [new, ca] _ Another1[me, fromOrNil, into, TRUE]; IF new#NIL AND ~ca THEN { IF ~FixChildren[new, into, fromOrNil, cx, getFromCache, putInCache, data].ok THEN RETURN [NIL] }; IF new#NIL THEN { [] _ RefTab.Store[cx, me, new]; IF putInCache#NIL THEN putInCache[me, new, data]; } }; ExpandRecursed: PUBLIC PROC [me: CD.Object, into: CD.Design_NIL, fromOrNil: CD.Design_NIL, cx: RefTab.Ref_NIL, getFromCache: CDDirectory.GetFromCacheProc_NIL, putInCache: CDDirectory.PutInCacheProc_NIL, data: REF_NIL] RETURNS [new: CD.Object] = { ta, ca: BOOL; [new, ta, ca] _ Expand1[me, fromOrNil, into, TRUE]; IF new#NIL THEN { IF cx=NIL THEN cx _ RefTab.Create[]; IF ~ta THEN { [new, ca] _ Another1[new, fromOrNil, into]; IF new=NIL THEN RETURN; }; IF ~ca THEN { IF ~FixChildren[new, into, fromOrNil, cx, getFromCache, putInCache, data].ok THEN RETURN [NIL] }; }; }; FixChildren: PUBLIC PROC [me: CD.Object, into: CD.Design, fromOrNil: CD.Design_NIL, cx: RefTab.Ref_NIL, getFromCache: CDDirectory.GetFromCacheProc_NIL, putInCache: CDDirectory.PutInCacheProc_NIL, data: REF_NIL] RETURNS [ok: BOOL_TRUE] = { replaceList: CDDirectory.ReplaceList _ NIL; localTab: RefTab.Ref _ RefTab.Create[]; PerChild: CDDirectory.EachObjectProc = { IF ~me.immutable AND me.class.composed THEN { newChild: CD.Object _ NIL; IF ~RefTab.Insert[localTab, me, $handled] THEN RETURN; -- eliminate duplicates WITH RefTab.Fetch[cx, me].val SELECT FROM cob: CD.Object => newChild _ cob; ENDCASE => { localOk, ca: BOOL _ TRUE; IF IsOwner[into, me] THEN newChild _ me ELSE IF getFromCache#NIL THEN newChild _ getFromCache[me, data]; IF newChild=NIL THEN { [newChild, ca] _ Another1[me: me, fromOrNil: fromOrNil, into: into, friendly: TRUE]; IF newChild=NIL THEN {ok _ localOk _ FALSE; newChild _ me; ca _ FALSE} ELSE IF ~ca AND newChild#me THEN { IF newChild.immutable THEN ERROR CD.Error[classBehaviour]; IF ~FixChildren[me: newChild, into: into, fromOrNil: fromOrNil, cx: cx, getFromCache: getFromCache, putInCache: putInCache, data: data].ok THEN ok _ localOk _ FALSE }; IF localOk AND putInCache#NIL THEN putInCache[me, newChild, data] }; IF localOk THEN [] _ RefTab.Insert[cx, me, newChild]; }; IF me#newChild AND newChild#NIL THEN replaceList _ CONS[NEW[CDDirectory.ReplaceRec_[old: me, new: newChild]], replaceList]; } }; IF cx=NIL THEN cx _ RefTab.Create[]; [] _ CDDirectory.EnumerateChildObjects[me: me, proc: PerChild, data: data]; IF replaceList#NIL THEN { IF me.immutable THEN ERROR CD.Error[classBehaviour, "immutable objects must not have inaccessible children"]; [] _ CDDirectory.ReplaceDirectChild[me: me, design: into, replace: replaceList, propagate: FALSE]; }; IF ok THEN { SetOwner[into, me]; [] _ RefTab.Insert[cx, me, me]; } }; ExpandRec: TYPE = RECORD [ cell: CD.Object, cellPtr: CD.CellSpecific, ep: CDDirectory.ExpandDecisionProc, data: REF ]; drawAll: REF CD.ContextFilter = NEW[CD.ContextFilter_ALL[TRUE]]; Expand1ByDraw: PUBLIC PROC [ob: CD.Object, ep: CDDirectory.ExpandDecisionProc_NIL, data: REF_NIL] RETURNS [CD.Object] = { cell: CD.Object = CDCells.CreateEmptyCell[]; expandRef: REF ExpandRec = NEW[ExpandRec_[ cell: cell, cellPtr: NARROW[cell.specific], ep: ep, data: data ]]; expandPr: CD.DrawRef = CD.CreateDrawRef[[ design: NIL, drawRect: ExpandByDrawBareRect, drawChild: ExpandByDrawChild, drawOutLine: CDDefaultProcs.IgnoreRect, selections: FALSE, devicePrivate: expandRef, contextFilter: drawAll ]]; ob.class.drawMe[pr: expandPr, ob: ob]; CDCells.SetInterestRect[NIL, cell, CD.InterestRect[ob], doit]; RETURN [cell] }; LeaveRectangles: PUBLIC CDDirectory.ExpandDecisionProc = { IF ob.class.composed THEN RETURN [recurse]; IF ob.class.symbolic THEN RETURN [suppress]; IF ob.class=CDRects.bareRectClass THEN RETURN [leave]; RETURN [recurse]; }; LeaveNextLevel: PUBLIC CDDirectory.ExpandDecisionProc = { RETURN [leave]; }; LeaveDontFlatten: PUBLIC CDDirectory.ExpandDecisionProc = { IF ~ob.class.composed THEN RETURN [leave]; IF CDProperties.GetObjectProp[ob, $DontFlatten]#NIL THEN RETURN [leave]; IF CDProperties.GetListProp[readOnlyInstProps, $DontFlatten]#NIL THEN RETURN [leave]; RETURN [recurse]; }; ExpandByDrawBareRect: PROC [pr: CD.DrawRef, r: CD.Rect, l: CD.Layer] = { expandRef: REF ExpandRec = NARROW[pr.devicePrivate]; inst: CD.Instance _ NEW[CD.InstanceRep_[ ob: CDRects.CreateBareRect[size: CDBasics.SizeOfRect[r], l: l], trans: [CDBasics.BaseOfRect[r], original] ]]; expandRef.cellPtr.contents _ CONS[inst, expandRef.cellPtr.contents]; }; ExpandByDrawChild: CD.DrawProc = { expandRef: REF ExpandRec = NARROW[pr.devicePrivate]; SELECT expandRef.ep[ob, trans, readOnlyInstProps, expandRef.data] FROM suppress => NULL; leave => expandRef.cellPtr.contents _ CONS[ NEW[CD.InstanceRep_[ob: ob, trans: trans, properties: CDProperties.DCopyProps[readOnlyInstProps]]], expandRef.cellPtr.contents ]; recurse => ob.class.drawMe[pr, ob, trans, readOnlyInstProps]; ENDCASE => ERROR CD.Error[programming]; }; RepositionList: TYPE = LIST OF CD.Object; changeEvent: CDEvents.EventRegistration ~ CDEvents.RegisterEventType[$AfterChange]; ReplaceObject: PUBLIC PROC [design: CD.Design, old: CD.Object, new: CD.Object, trans: CD.Transformation] = { repRef: REF CDDirectory.ReplaceRec _ NEW[CDDirectory.ReplaceRec_[old: old, new: new, trans: trans]]; IF design=NIL THEN ERROR CD.Error[calling]; FOR plist: LIST OF CD.PushRec _ design.actual, plist.rest WHILE plist#NIL DO IF plist.first.mightReplace#NIL AND plist.first.mightReplace.ob=old THEN TerminalIO.PutRope["** Tries to replace pushed in cell; does not work\n"]; ENDLOOP; ReplaceAllChilds[design, repRef] }; PropagateResize: PUBLIC PROC [design: CD.Design, ob: CD.Object] = { repRef: REF CDDirectory.ReplaceRec _ NEW[CDDirectory.ReplaceRec_[old: ob, new: ob]]; IF ob.immutable THEN ERROR CD.Error[objectMutability]; [] _ CDEvents.ProcessEvent[ eventRegistration: resizeEvent, design: design, x: NEW[CDDirectory.ReplaceRec _ repRef^], --copy for safety listenToDont: FALSE ]; IF design#NIL THEN ReplaceAllChilds[design, repRef] }; ReplaceAllChilds: PROC [design: CD.Design, repRef: REF CDDirectory.ReplaceRec] = { ENABLE UNWIND => { CDValue.Store[design, repositioningListKey, NIL]; TerminalIO.PutRope["****repositioning or replace failed [maybe, partly]\n"]; }; ref: REF CDDirectory.ReplaceList _ NARROW[ CDValue.Fetch[boundTo: design, key: repositioningListKey, propagation: design] ]; IF ref#NIL THEN { -- we are inside replace process, remember object IF ref^=NIL THEN ref^ _ LIST[repRef] ELSE { FOR l: CDDirectory.ReplaceList _ ref^, l.rest DO IF l.first.old=repRef.old THEN ERROR CD.Error[programming, "impossible! call Christian"]; IF l.rest=NIL THEN {l.rest _ LIST[repRef]; EXIT} ENDLOOP; }; RETURN }; ref _ NEW[CDDirectory.ReplaceList_LIST[repRef]]; CDValue.Store[boundTo: design, key: repositioningListKey, value: ref]; WHILE ref^#NIL DO repList: CDDirectory.ReplaceList _ ref^; ref^ _ NIL; DoReplaceAllChilds[design, repList]; ENDLOOP; CDValue.Store[design, repositioningListKey, NIL]; CDOps.Redraw[design]; }; ReplaceDirectChild: PUBLIC PROC [me: CD.Object, design: CD.Design, replace: CDDirectory.ReplaceList, propagate: BOOL_TRUE] RETURNS [changed: BOOL_FALSE] = { IF me.class.composed AND replace#NIL THEN { IF me.immutable THEN ERROR CD.Error[objectMutability]; changed _ CDDirectory.ObToDirectoryProcs[me].replaceDirectChilds[me, design, replace]; IF changed AND propagate THEN PropagateChange[me, design]; } }; DoReplaceAllChilds: PROC [design: CD.Design, repList: CDDirectory.ReplaceList] = { ReplaceForOne: CDDirectory.EachObjectProc = { IF ~me.immutable THEN [] _ ReplaceDirectChild[me: me, design: design, replace: repList]; }; [] _ CDDirectory.EnumerateDesign[design, ReplaceForOne]; FOR plist: LIST OF CD.PushRec _ design.actual, plist.rest WHILE plist#NIL DO inst: CD.Instance _ plist.first.mightReplace; SetOwner[design, plist.first.dummyCell.ob, TRUE]; --HACK XXX XXX FOR rlist: CDDirectory.ReplaceList _ repList, rlist.rest WHILE rlist#NIL DO rep: REF CDDirectory.ReplaceRec = rlist.first; IF inst#NIL AND inst.ob=rep.old THEN { inst.trans _ CDBasics.ComposeTransform[itemInCell: inst.trans, cellInWorld: rep.trans]; } ENDLOOP; [] _ CDCellsBackdoor.ReplaceDirectChildForCell[plist.first.dummyCell.ob, design, repList]; ENDLOOP; }; RemovePropsEvent: CDEvents.EventProc = { ob: CD.Object = NARROW[x]; Rem: Properties.EachProp = { p: CDProperties.PropertyProcs ~ CDProperties.FetchProcs[key]; IF p#NIL AND p.autoRem THEN CDProperties.PutObjectProp[ob, key, NIL]; }; IF ob#NIL THEN [] _ Properties.Enumerate[ob.properties, Rem] }; PropagateChange: PUBLIC PROC [ob: CD.Object, design: CD.Design] = { IF ob.immutable THEN ERROR CD.Error[objectMutability]; [] _ CDEvents.ProcessEvent[changeEvent, design, ob]; }; CurrentKey: PUBLIC PROC [ob: CD.Object] RETURNS [key: REF] = { RETURN [CDProperties.GetObjectProp[ob, modificationKeyProp]] }; Match: PUBLIC PROC [ok: CDCacheBase.ObjectAndKey] RETURNS [BOOL] = { RETURN [CDProperties.GetObjectProp[ok.ob, modificationKeyProp]=ok.key] }; modificationKeyProp: PUBLIC REF = NEW[ATOM_$ModificationKey]; nextModification: CARD _ 0; ObjectHasChanged: CDEvents.EventProc = { WITH x SELECT FROM ob: CD.Object => IF ob.class.composed THEN CDProperties.PutObjectProp[ob, modificationKeyProp, NEW[CARD_(nextModification_nextModification+1)]]; ENDCASE => NULL; }; resizeEventKey: ATOM = $resize; resizeEvent: CDEvents.EventRegistration = CDEvents.RegisterEventType[resizeEventKey]; repositioningListKey: REF ATOM = NEW[ATOM_$RepositioningList]; ownerKey: ATOM = $OwnerDesign; --HACK XXX: property is also used by cdcellsimpl [] _ CDProperties.RegisterProperty[ownerKey]; [] _ CDProperties.RegisterProperty[modificationKeyProp]; CDProperties.InstallProcs[prop: ownerKey, procs: CDProperties.PropertyProcsRec[exclusive: TRUE]]; CDProperties.InstallProcs[prop: modificationKeyProp, procs: CDProperties.PropertyProcsRec[exclusive: TRUE, internalWrite: CDProperties.DontPWrite, makeCopy: CDProperties.CopyVal]]; CDValue.RegisterKey[repositioningListKey]; CDEvents.RegisterEventProc[event: changeEvent, proc: RemovePropsEvent]; CDEvents.RegisterEventProc[event: changeEvent, proc: ObjectHasChanged]; END. ‚CDDirectoryImpl.mesa (part of ChipNDale) Copyright c 1983, 1984, 1985, 1986, 1987 by Xerox Corporation. All rights reserved. Created by Christian Jacobi, June 24, 1983 5:00 pm Last edited by: Christian Jacobi, April 10, 1987 6:38:49 pm PDT Directory updates: Always include name in SymTab first then include object in RefTab. Remove in opposite order. We dont SetOwner[NIL, object]; This makes interactive operations safer, at cost of inter-design copy; But inter-design copy is already difficult anyway. --ob must not be already included with any name --always ! succeeds including object --done: done on this call --ok: its not really done, but that name is at least not occupying a slot in the -- name-space anymore --failed: place in name space is still occupied --we tolerate include of an object twice in the same design --crazy another proc which makes a copy of the object-definition --Use drawproc to find children. --Sorry this is not too fast; But not providing a default proc would bare the risk of some --people making classes with EnumerateChildObjectsProc's not returning any objects. --The real implementation crashes when a nested procedure is passed in and assigned --used by DefaultEnumerateChildObjects --used by DefaultEnumerateChildObjects --used by DefaultEnumerateChildObjects -- -- -- -- -- -- -- -- -- -- -- --enumerates only the mutable children --enumerates only the mutable children -- -- -- -- -- -- -- -- -- -- -- --contains all elements of replaceList; one level only! -- -- -- -- -- -- -- -- -- -- -- --all over in the design replace old by new --may be delayed --all over in the design tries to reposition ob; --may be delayed --catches recursive calls and transformes them into sequential calls... --the list of what to do is found using CDValue on the design -- we are not inside reposition process, start one -- processes an CDEvent $AfterChange --CDCacheBase Κ ˜codešœ*™*Kšœ ΟmœI™TKšœ3™3K™?K˜—šΟk ˜ Kšžœ˜Kšœ ˜ Kšœ˜K˜Kšœ˜Kšœ ˜ K˜ K˜ K˜K˜ K˜K˜Kšžœ˜Kšœ ˜ Kšœ˜Kšœ˜Kšœ˜Kšœ˜Kšœ ˜ —K˜šΟnœžœžœ˜Kšžœžœtžœ6˜ΆKšžœ˜ Kšžœžœ ˜—Kšž˜K˜™K™BK™—K˜šŸœžœžœ žœžœžœžœ˜RKš œžœžœžœžœžœžœ˜?šžœžœ˜šžœ.ž˜8Kšœžœ˜ Kšžœ˜ Kšžœžœžœ:˜M——Kš žœžœžœžœžœžœ;˜kKšœ0˜0K˜—K˜š Ÿœž œ žœžœ žœžœ˜NKš œžœžœžœžœžœžœ˜?šžœ.ž˜8Kšœžœžœ˜Kšžœžœžœ˜—K˜—K˜š Ÿœž œ žœžœ žœžœ˜VKš œžœžœžœžœžœžœ˜?šžœ.ž˜8Kšœžœžœ˜Kšžœžœžœ˜Kšžœžœžœ˜—K˜—K˜Kšœžœžœ žœžœ žœžœžœ˜ZšŸœžœžœ žœžœžœ žœžœ˜[šžœ-žœž˜šžœ0žœž˜?Kšœžœžœžœ˜3Kšžœ=žœžœ˜Q—K˜—K˜š Ÿ œžœ žœ žœ žœžœ˜MKšœ žœ˜&Kšœžœ˜šžœž˜Kšœ˜šžœžœ˜Kšœž˜!K˜—Kšžœ˜—Kšœžœžœ žœ˜:Kšžœ˜Kšœ˜—K˜š Ÿœžœžœ žœžœžœžœ žœžœžœžœžœžœžœžœ žœ ˜ΝKšœžœ$˜6Kšœ˜Kšžœ"žœžœžœ˜LKšœ2˜2Kšžœžœžœžœ&˜Išžœ5žœ˜=Kšœ8˜8Kšœ&žœžœžœ ˜RKšžœžœžœ˜Kšœ˜—Kšœ.˜.šžœžœ˜Kšœ3˜3Kšœ&žœžœžœ ˜RKšžœžœ ˜K˜—šžœ  ˜šžœ žœžœ˜Kš žœžœžœžœžœ˜+Kšžœ žœ#˜6Kšžœžœ žœ#˜;K˜—šžœ5žœ˜=Kšœ8˜8Kšœ&žœžœžœ ˜RKšžœžœ ˜Kšœ˜—šžœ žœ˜Kšœ.˜.Kšžœžœ˜(K˜—Kšžœžœ/˜7K˜—Kšœ˜—š Ÿ œžœžœ žœ"žœžœ˜\šΠbnœ˜)Kšœžœ žœžœ ˜Kšžœžœ<˜DKšœ˜—K˜šŸœ+˜GJš  ™ Jš Sœ™[Jš œQ™SJšœ˜šžœžœžœ˜1Jšœžœ˜Jšœ(žœ˜-Jšœ:˜:Jšž˜J˜—J˜JšœS™SJ˜šžœžœžœ˜1šœžœ žœ˜$Kšœ$˜$Kšœ˜Kšœ'˜'Kšœ žœ˜Kšœ žœ˜Kšœžœ˜(Kšœ˜—Jšžœ%žœ˜2Jšœ˜—Jšžœžœ˜Jšžœ žœžœ˜J˜—˜šœ žœžœžœ$˜EJš &™&—J˜šŸœžœžœ˜Jš &™&—J˜šŸœžœ ˜#Jš &™&šžœžœ˜Jšœžœ žœ˜+Jšžœžœžœ˜8J˜—Jšœ˜——K˜K˜š Ÿœžœžœžœžœ.˜yKšœ˜—K˜Kšœ ™ K˜šŸœžœžœ žœžœ žœžœ˜Pšžœ/žœž˜>Kšœžœžœ˜Kšžœžœžœ˜—K˜—K™š"Ÿœž œ žœ1žœžœžœžœžœžœ žœžœ žœžœžœžœžœžœ˜ΰKšœ&™&šŸœžœžœ žœžœžœžœ˜Bšžœ žœ˜(Kšžœ žœ=˜LKšžœžœ˜$K˜—K˜—šŸ œ ˜-Kšžœžœžœ˜.K˜—šŸ œ˜'Kšœžœ žœžœ ˜'Kšžœžœžœ˜.Kšœ˜—Kšžœ žœžœžœ&˜Ušžœžœ˜ Kšœ7˜7—šžœž˜ šžœžœžœžœ!žœžœžœž˜LKšžœžœžœ/˜Ošžœž˜ šœžœ˜Kšžœ$˜(KšžœG˜K——Kšžœ˜——K˜—K˜šŸœž œžœ1žœžœ žœžœžœžœžœžœ˜©Kšœ&™&šŸœžœžœ žœžœžœžœ˜Bšžœ žœ˜(Kšžœ žœ=˜LKšžœžœ˜$K˜—K˜—šŸ œ ˜-Kšžœžœžœ˜.K˜—Kšžœ žœžœ˜.Kšžœžœžœ˜.K˜—K™Kšœ ™ K˜šŸœžœžœžœžœžœžœžœ žœžœžœžœžœ˜žKšžœžœžœžœ˜,šžœ˜KšœN˜NKš žœ žœžœžœžœ˜8Kšœ@˜@Kšžœžœ˜,K˜—Kšœ˜—K˜šŸœžœžœžœžœžœžœžœ žœžœžœžœžœžœ˜²Kš žœžœžœžœžœžœ˜6šžœ˜KšœK˜KKš žœžœžœžœžœ˜8KšœN˜NKšžœžœžœ˜>K˜—Kšœ˜—K˜š Ÿœžœžœžœžœžœ žœžœžœ-žœ)žœžœžœžœžœžœ˜ϋKšœžœžœ˜Kšžœžœžœ˜#šž˜šžœžœž˜)Kšœžœ žœ˜Kšžœžœ˜——šžœžœžœ˜Kšœ˜Kšžœžœžœ"žœ˜9Kšœ˜—Kšœ*žœ˜0šžœžœžœžœ˜KšžœKžœžœžœ˜_K˜—šžœžœžœ˜Kšœ˜Kšžœ žœžœ˜1K˜—Kšœ˜—K˜šŸœžœžœžœžœžœ žœžœžœ-žœ)žœžœžœžœžœ ˜φKšœžœ˜ Kšœ-žœ˜3šžœžœžœ˜Kšžœžœžœ˜$šžœžœ˜Kšœ+˜+Kšžœžœžœžœ˜K˜—šžœžœ˜ KšžœKžœžœžœ˜_K˜—K˜—Kšœ˜—K˜šŸ œžœžœžœžœžœžœžœ-žœ)žœžœžœžœžœžœ˜ξKšœ'žœ˜+šœ(˜(Kš 7™7—K˜šŸœ ˜(šžœžœžœ˜.Kšœ žœ žœ˜Kšžœ(žœžœ ˜Ošžœžœž˜)Kšœžœ˜!šžœ˜ Kšœ žœžœ˜Kšžœžœ˜'Kšžœžœžœžœ#˜@šžœ žœžœ˜KšœNžœ˜TKš žœ žœžœžœžœ˜Fšžœžœžœ žœ˜"Kšžœžœžœžœ˜:Kšžœ‰žœžœ˜₯K˜—Kšžœ žœ žœžœ˜AK˜—Kšžœ žœ&˜5K˜——šžœ žœ žœž˜$Kšœžœžœ@˜V—K˜—Kšœ˜—K˜Kšžœžœžœ˜$KšœK˜Kšžœ žœžœ˜KšžœžœžœžœQ˜nKšœ[žœ˜cK˜—šžœžœ˜ Kšœ˜Kšœ˜K˜—Kšœ˜—K˜K˜šœ žœžœ˜Kšœžœ˜Kšœ žœ˜Kšœ#˜#Kšœž˜ Kšœ˜—K˜Kš œ žœžœžœžœžœžœ˜@K˜šŸ œžœžœžœ,žœžœžœžœžœ ˜yKšœžœ$˜,šœ žœ žœ ˜*Kšœžœ˜+Kšœ˜Kšœ˜—šœ žœ žœ˜)Kšœžœ˜ Kšœ˜Kšœ˜Kšœ'˜'Kšœ žœ˜Kšœ˜Kšœ˜Kšœ˜—Kšœ&˜&Kšœžœžœ˜>Kšžœ˜ Kšœ˜—K˜šŸœžœ#˜:Kšžœžœžœ ˜+Kšžœžœžœ ˜,Kšžœ žœžœ ˜6Kšžœ ˜Kšœ˜—K˜šŸœžœ#˜9Kšžœ ˜Kšœ˜—K˜šŸœžœ#˜;Kšžœžœžœ ˜*Kšžœ.žœžœžœ ˜HKšžœ;žœžœžœ ˜UKšžœ ˜Kšœ˜—K˜š Ÿœžœžœ žœ žœ ˜HKšœ žœ žœ˜4šœžœ žœžœ˜(Kšœ@˜@Kšœ)˜)Kšœ˜—Kšœžœ#˜DKšœ˜—K˜šŸœ˜"Kšœ žœ žœ˜4šžœ<ž˜FKšœ ž˜šœ&žœ˜+Kšžœžœ^˜dKšœ˜Kšœ˜—Kšœ=˜=Kšžœžœžœ˜'—Kšœ˜—K˜K˜Kšœ ™ K˜Kš œžœžœžœžœ ˜*KšœS˜SK˜šŸ œžœžœ žœžœžœžœ˜lKšœ+™+K™Kšœžœžœ<˜dKš žœžœžœžœžœ˜+š žœžœžœžœ%žœžœž˜Lšžœžœžœ!ž˜HKšœJ˜J—Kšžœ˜—Kšœ ˜ Kšœ˜—K˜š Ÿœžœžœ žœ žœ ˜CKšœ0™0K™Kšœžœžœ,˜TKšžœžœžœžœ˜7šœ˜Kšœ ˜ Kšœ˜Kšœžœ$ ˜;Kšœž˜K˜—Kšžœžœžœ!˜3Kšœ˜K™—šŸœžœ žœžœ˜RKš G™GKš =™=šžœžœ˜Kšœ,žœ˜1KšœL˜LK˜—šœžœžœ˜*KšœN˜NKšœ˜—šžœžœžœ 1˜DKšžœžœžœžœ˜$šžœ˜šžœ+ž˜0Kšžœžœžœžœ2˜YKš žœžœžœ žœ žœ˜0Kšžœ˜—K˜—Kšž˜K˜—Kšœ2™2Kšœžœžœ ˜0KšœF˜Fšžœžœž˜Kšœ(˜(Kšœžœ˜ Kšœ$˜$Kšžœ˜—Kšœ,žœ˜1Kšœ˜Kšœ˜—K˜š‘œžœžœžœžœ6žœžœžœ žœžœ˜œšžœžœ žœžœ˜,Kšžœžœžœžœ˜7KšœV˜VKšžœ žœ žœ˜:K˜—Kšœ˜—K˜š‘œžœ žœ.˜RK˜šŸ œ ˜-KšžœžœC˜XKšœ˜—K˜Kšœ8˜8š žœžœžœžœ%žœžœž˜LKšœžœ%˜-Kšœ+žœ ˜@šžœ6žœžœž˜KKšœžœ&˜.šžœžœžœžœ˜&KšœW˜WK˜—Kšžœ˜—KšœZ˜ZKšžœ˜—Kšœ˜—K˜š‘œ˜(Kšœžœ žœ˜š‘œ˜Kšœ=˜=Kš žœžœžœ žœ%žœ˜EKšœ˜—Kšžœžœžœ.˜Kšžœ6˜Kšœ žœ 0˜OKšœ-˜-Kšœ8˜8KšœZžœ˜aKšœežœK˜΄Kšœ*˜*KšœG˜GKšœG˜GKšžœ˜K˜—…—Z€΄