<> <> <> <> DIRECTORY CD, CDCallSpecific, CDDirectory, CDDirectoryExtras, CDEvents, CDBasics, CDOrient, CDOps, CDProperties, CDValue, CDX, IO, Rope, SymTab, TerminalIO; CDDirectoryImpl: CEDAR MONITOR IMPORTS CD, CDDirectory, CDDirectoryExtras, CDEvents, CDBasics, CDOps, CDOrient, CDProperties, CDValue, CDX, IO, Rope, SymTab, TerminalIO EXPORTS CDDirectory SHARES CD = BEGIN <<--all object which contain other objects are supposed to be in the directory;>> <<--which is necessary for enumeration and for repositioning>> EachEntryAction: TYPE = PROC [name: Rope.ROPE, ob: CD.ObPtr] RETURNS [quit: BOOL]; Fetch: PUBLIC PROC [design: CD.Design, name: Rope.ROPE] RETURNS [found: BOOL, object: CD.ObPtr_NIL] = <<--search for object in directory>> BEGIN x: SymTab.Val; [found, x] _ SymTab.Fetch[design.cellDirectory, name]; IF found THEN object _ NARROW[x, CD.ObPtr]; END; <<>> Remove: PUBLIC PROC [design: CD.Design, name: Rope.ROPE, expectObject: CD.ObPtr_NIL] RETURNS [done: BOOL_FALSE] = <<--if expectObject#NIL removes name only, iff named object=expectObject>> <<--if removed objects are still used, they are neither enumerated correctly anymore,>> <<--nor repositioned if internal objects change>> BEGIN object: CD.ObPtr; found: BOOL; [found, object] _ Fetch[design, name]; IF found THEN { IF expectObject=NIL OR object=expectObject THEN { IF CDProperties.GetPropFromObject[from: object, prop: ownerKey]#design THEN ERROR CD.Error[callingError, "Removed object not in design"]; done _ SymTab.Delete[design.cellDirectory, name]; IF done THEN CDProperties.PutPropOnObject[onto: object, prop: ownerKey, val: NIL]; } } END; SetName: PROC[me: CD.ObPtr, r: Rope.ROPE] ~ INLINE { IF me.p.inDirectory THEN CDDirectory.ObToDirectoryProcs[me].setName[me, r] }; Include: PUBLIC PROC [design: CD.Design, object: CD.ObPtr, alternateName: Rope.ROPE_NIL, fiddleName: BOOL_TRUE] RETURNS [done: BOOL] = <<--it is an ERROR to include an object into several design's>> BEGIN name: Rope.ROPE _ CDDirectory.Name[object]; IF CDProperties.GetPropFromObject[from: object, prop: ownerKey]#NIL THEN ERROR CD.Error[callingError, "Included object already in a design"]; IF alternateName#NIL THEN name _ alternateName; IF name=NIL THEN name _ "-noname-"; DO IF SymTab.Insert[design.cellDirectory, name, object] THEN { SetName[object, name]; CDProperties.PutPropOnObject[onto: object, prop: ownerKey, val: design]; done _ TRUE; RETURN }; IF object = Fetch[design, name].object THEN { TerminalIO.WriteRope["object included twice in directory; debugging chipndale might be appropriate\n"]; }; IF NOT fiddleName THEN { done _ FALSE; RETURN }; name _ Rope.Concat[name, IO.PutFR[format: "@%g", v1: IO.int[LOOPHOLE[object, INT]/4 MOD 991]]] ENDLOOP; END; Rename: PUBLIC PROC [design: CD.Design, object: CD.ObPtr, newName: Rope.ROPE _ NIL] RETURNS [done: BOOL _ FALSE] = BEGIN oldName: Rope.ROPE ~ CDDirectory.Name[object]; removed: BOOL ~ Remove[design, oldName, object]; IF removed THEN { back: BOOL _ Include[design, object, newName, FALSE]; IF back THEN RETURN [done _ TRUE]; back _ Include[design, object, oldName, TRUE]; IF NOT back THEN ERROR CD.Error[programmingError, "rename removed an object"] } END; Enumerate: PUBLIC PROC [design: CD.Design, action: EachEntryAction] RETURNS [quit: BOOL] = <<--enumerates objects currently in directory in unspecified order>> <<--objects inserted/deleted during enumeration may or may not be seen>> <<--applies action to each object until action returns TRUE or no more objects>> <<--returns quit: TRUE if some action returns TRUE>> BEGIN EachPairAction: SymTab.EachPairAction ~ { quit _ action[name: key, ob: NARROW[val, CD.ObPtr]] }; quit _ SymTab.Pairs[design.cellDirectory, EachPairAction] END; InstallDirectoryProcs: PUBLIC PROC [type: REF CD.ObjectProcs] RETURNS [REF CDDirectory.DirectoryProcs] = BEGIN dp: REF CDDirectory.DirectoryProcs ~ NEW[CDDirectory.DirectoryProcs]; IF type.directoryProcs#NIL OR type.inDirectory THEN ERROR CD.Error[ec: doubleRegistration, explanation: "object type includes already directory"]; type.directoryProcs _ dp; type.inDirectory _ TRUE; dp.adjustItself _ DefaultAdjustItself; dp.repositionElements _ DefaultRepositionElements; dp.computeBounds _ DefaultComputeBounds; dp.enumerateChildObjects _ DefaultEnumerate; dp.replaceDirectChilds _ DefaultReplaceDirectChilds; dp.another _ DefaultAnother; dp.key _ DefaultKey; dp.name _ DefaultName; dp.setName _ DefaultSetName; dp.setKey _ DefaultSetKey; RETURN [dp] END; DefaultAdjustItself: CDDirectory.AdjustItselfProc -- PROC [objToReposition: CD.ObPtr, newBound: CD.DesignRect] -- = BEGIN ERROR END; DefaultAnother: CDDirectory.AnotherProc = <<--crazy another proc which makes a copy of the object-definition>> BEGIN newOb: CD.ObPtr = NEW[CD.ObjectDefinition_me^]; newOb.properties _ CDProperties.CopyProps[me.properties]; [] _ Include[to, newOb]; RETURN [newOb] END; DefaultReplaceDirectChilds: CDDirectory.ReplaceDirectChildProc -- PROC [me: CD.ObPtr, old: CD.ObPtr, new: CD.ObPtr, off: CD.DesignPosition] RETURNS [found: BOOL_FALSE] -- = BEGIN ERROR END; DefaultRepositionElements: CDDirectory.RepositionElementsProc -- PROC [me: CD.ObPtr, objToReposition: CD.ObPtr, oldSize: CD.DesignPosition, newBound: CD.DesignRect, design: CD.Design] -- = BEGIN ERROR END; DefaultComputeBounds: PROC [ob: CD.ObPtr] RETURNS [CD.DesignRect] = <<--returns bounds in coordinate system of ob itself>> BEGIN RETURN [CDBasics.RectAt[[0,0], ob.size]] END; DefaultEnumerate: PROC [me: CD.ObPtr, p: CDDirectory.EnumerateObjectsProc, x: REF] = BEGIN END; DefaultSetName: PROC [me: CD.ObPtr, r: Rope.ROPE] = BEGIN CDProperties.PutPropOnObject[onto: me, prop: nameKey, val: r] END; DefaultSetKey: PROC [me: CD.ObPtr, r: Rope.ROPE] = BEGIN END; DefaultName: PROC [me: CD.ObPtr] RETURNS [Rope.ROPE] = BEGIN WITH CDProperties.GetPropFromObject[from: me, prop: nameKey] SELECT FROM r: Rope.ROPE => RETURN [r]; ENDCASE => RETURN [" no name"] END; DefaultKey: PROC [me: CD.ObPtr] RETURNS [Rope.ROPE] = BEGIN RETURN [NIL] END; -- -- -- -- -- -- -- -- -- -- -- -- ComputedBounds: PROC [ob: CD.ObPtr] RETURNS [CD.DesignRect] = INLINE <<--returns bounds in coordinate system of ob itself >> BEGIN RETURN [ IF ob.p.inDirectory THEN CDDirectory.ObToDirectoryProcs[ob].computeBounds[ob] ELSE DefaultComputeBounds[ob] ] END; <<>> RepositionList: TYPE = LIST OF CD.ObPtr; RepositionAnObject: PUBLIC PROC [design: CD.Design, objToReposition: CD.ObPtr] = <<--objToReposition.size must be old, not yet repositioned size;>> <<--(the actual reposition process may bepostboned until an started --reposition is finished; the started reposition should not be interferred --with objToReposition changing size.)>> <<--the size will be recomputed and corrected before return>> BEGIN ERROR; <<--XXX--TerminalIO.WriteRope["enter RepositionAnObject\n"];>> <> <> <> <> <> <> <> <> <> <> <> <> <> <<};>> <<-- we are not inside reposition process, start one>> <> <> <> <> <> <> <> <<};>> <<--XXX--TerminalIO.WriteRope["leave RepositionAnObject\n"];>> END; RepositionObjectOnDesign: PROC [design: CD.Design, objToReposition: CD.ObPtr] = <<--this procedure called from RepositionAnObject only>> <<--objToReposition must have old, uncorrected size>> BEGIN <> <> <<>> <> <<--newBound is expected to be in coordinate system of objToReposition itself>> <> <> <> <<--XXX--TerminalIO.WriteRope["adjust size of "];>> <<--XXX--TerminalIO.WriteRope[CDDirectory.Name[objToReposition]];>> <<--XXX--TerminalIO.WriteRope["\n"];>> <> <> <> <> <> <<};>> <> <<>> <> <<--[key: Key, val: Val] RETURNS [quit: BOOLEAN] -- =>> <<--uses global "parameters": oldSize, newBound, objToReposition, design>> <> <> <> <> <> <<--XXX--TerminalIO.WriteRope["call repositionElements for "];>> <<--XXX--TerminalIO.WriteRope[CDDirectory.Name[ob]];>> <<--XXX--TerminalIO.WriteRope["\n"];>> <> <<}>> <> <<>> <> <<--relative globals used: oldSize, newBound, objToReposition, design>> <> <<--reposition all of the actual design>> <> <> <> <> <<--reposition all cells>> <<--which may cause a Reposition of the some other cells recursively>> <<--the recursion stops iff the data structures do not contain recursive cells>> <> <> <<>> <> <<--repositions all applications which call objToReposition>> <<--oldSize: size of the original rePositionList.first >> <<--objToReposition object needing reposition>> <<--newBound: bound of new objToReposition in coords of old rePositionList.first>> <<--(oldSize, newBound used by dynamic inner proc)>> <<--objToReposition.size is NOT used>> <> <> <<--IF w.first.ob=objToReposition THEN-- RepositionApplication[w.first];>> <> <> <<>> <> <<--repositions an application if it calls objToReposition>> <<--oldSize: size of the original objToReposition >> <<--objToReposition object needing reposition>> <<--newBound: bound of new objToReposition in coords of old objToReposition>> <> <> <> <> <> <> <> <<}>> <> <<>> <<-- RepositionObjectOnDesign>> <<--XXX--TerminalIO.WriteRope["enter RepositionObjectOnDesign "];>> <<--XXX--TerminalIO.WriteRope[CDDirectory.Name[objToReposition]];>> <<--XXX--TerminalIO.WriteRope["\n"];>> <> <> <> <<};>> <<--XXX--TerminalIO.WriteRope["leave RepositionObjectOnDesign\n"];>> END; DangerousGetChangeEvent: PROC [] RETURNS [CDEvents.EventRegistration] = <<--XXXXX remove this silly procedure as fast as possible>> BEGIN x: REF = CDValue.Fetch[key: $CDxPrivateAfterChange]; IF x#NIL THEN TRUSTED {RETURN [LOOPHOLE[x]]} ELSE { changeEvent: CDEvents.EventRegistration ~ CDEvents.RegisterEventType[$AfterChange]; CDValue.Store[key: $CDxPrivateAfterChange, value: changeEvent]; RETURN [changeEvent] } END; changeEvent: CDEvents.EventRegistration ~ DangerousGetChangeEvent[]; ReplaceObject: PUBLIC PROC [design: CD.Design, old: CD.ObPtr, new: CD.ObPtr, off: CD.DesignPosition] = BEGIN CDDirectoryExtras.ReplaceObject[design, old, new, off] END; <> <> <> <> <> <<>> <> <> <> <> <<--oldy XXX>> <> <> <<[] _ CDEvents.ProcessEvent[changeEvent, design, ob];>> <<}>> <<}>> <> <<>> <<--oldy XXX>> <> <<[] _ CDDirectory.Enumerate[design, ReplaceForOne];>> <> <<-- HACK XXX XXX>> <> <<[] _ ReplaceForOne[name: NIL, ob: list.first.dummyCell.ob];>> <> <<--oldy XXX>> <> <> <> <> <> <<>> repositioningListKey: ATOM ~ $RepositioningList; ownerKey: ATOM ~ $Owner; --HACK XXX: property is also used by cdcellsimpl nameKey: REF ATOM ~ NEW[ATOM _$Name]; -- make it non accessible, non write on file [] _ CDProperties.RegisterProperty[ownerKey]; CDProperties.InstallProcs[prop: ownerKey, new: CDProperties.PropertyProcsRec[exclusive: TRUE]]; CDProperties.InstallProcs[prop: nameKey, new: CDProperties.PropertyProcsRec[exclusive: TRUE]]; CDValue.EnregisterKey[repositioningListKey]; END.