CDDirectoryImpl.mesa (part of Chipndale)
by Christian Jacobi June 24, 1983 5:00 pm
last edited Christian Jacobi February 16, 1984 12:44 pm
DIRECTORY
CD,
CDCallSpecific,
CDDirectory,
CDInline,
CDOrient,
CDProperties,
CDValue,
IO,
Rope,
SymTab,
TerminalIO;
CDDirectoryImpl:
CEDAR
MONITOR
IMPORTS CD, CDDirectory, CDInline, CDOrient, CDProperties, CDValue, 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�LSE] =
--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.hasChildren 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.hasChildren
THEN
ERROR CD.Error[ec: doubleRegistration, explanation: "object type includes already directory"];
type.directoryProcs ← dp;
type.hasChildren ← TRUE;
dp.adjustItself ← DefaultAdjustItself;
dp.repositionElements ← DefaultRepositionElements;
dp.computeBounds ← DefaultComputeBounds;
dp.enumerateChildObjects ← DefaultEnumerate;
dp.key ← DefaultKey;
dp.name ← DefaultName;
dp.setName ← DefaultSetName;
dp.setKey ← DefaultSetName;
RETURN [dp]
END;
DefaultAdjustItself: CDDirectory.AdjustItselfProc
-- PROC [objToReposition: CD.ObPtr, newBound: CD.DesignRect] -- =
BEGIN
END;
DefaultRepositionElements: CDDirectory.RepositionElementsProc
-- PROC [me: CD.ObPtr, objToReposition: CD.ObPtr, oldSize: CD.DesignPosition, newBound: CD.DesignRect, design: CD.Design] -- =
BEGIN
END;
DefaultComputeBounds:
PROC [ob:
CD.ObPtr]
RETURNS [
CD.DesignRect] =
--returns bounds in coordinate system of ob itself
BEGIN
RETURN [CDInline.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
END;
DefaultName:
PROC [me:
CD.ObPtr]
RETURNS [Rope.
ROPE] =
BEGIN
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.hasChildren 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
IF CDProperties.GetPropFromObject[from: objToReposition, prop: ownerKey]#design
THEN
ERROR CD.Error[callingError, "object not in design"];
IF design=NIL THEN RepositionObjectOnDesign[NIL, objToReposition]
ELSE {
x: REF ← CDValue.Fetch[boundTo: design, key: $RepositioningList, propagation: design];
ref: REF RepositionList;
IF x#
NIL
THEN {
-- we are inside reposition process, remember object
ref ← NARROW[x];
FOR l: RepositionList ← ref^, l.rest
DO
IF l.first=objToReposition THEN EXIT;
IF l.rest=NIL THEN {l.rest ← LIST[objToReposition]; EXIT}
ENDLOOP;
RETURN
};
-- we are not inside reposition process, start one
ref ← NEW[RepositionList←LIST[objToReposition]];
CDValue.Store[boundTo: design, key: $RepositioningList, value: ref];
WHILE ref^#
NIL
DO
RepositionObjectOnDesign[design, ref^.first];
ref^ ← ref^.rest
ENDLOOP;
CDValue.Store[boundTo: design, key: $RepositioningList, value: NIL];
};
END;
RepositionObjectOnDesign:
PROC [design:
CD.Design, objToReposition:
CD.ObPtr] =
--this procedure called from RepositionAnObject only
--objToReposition must have old, uncorrected size
BEGIN
oldSize: CD.DesignPosition = objToReposition.size;
newBound: CD.DesignRect ← ComputedBounds[objToReposition];
AdjustItself:
PROC [objToReposition:
CD.ObPtr, newBound:
CD.DesignRect] =
INLINE
--newBound is expected to be in coordinate system of objToReposition itself
BEGIN
IF objToReposition.p.hasChildren
THEN {
objToReposition.size ← CDInline.SizeOfRect[newBound];
CDDirectory.ObToDirectoryProcs[objToReposition].adjustItself[objToReposition, newBound];
};
END;
EachEntryReposition: SymTab.EachPairAction
--[key: Key, val: Val] RETURNS [quit: BOOLEAN] -- =
--uses global "parameters": oldSize, newBound, objToReposition, design
BEGIN
ob: CD.ObPtr = NARROW[val];
quit ← FALSE;
IF ob#objToReposition
THEN
-- this one is already in progress!
IF ob.p.hasChildren
THEN
CDDirectory.ObToDirectoryProcs[ob].repositionElements[ob, objToReposition, oldSize, newBound, design]
END;
RepositionAllOthers:
PROC [] =
INLINE
--relative globals used: oldSize, newBound, objToReposition, design
BEGIN
--reposition all of the actual design
FOR l:
LIST
OF
CD.PushRec ← design.actual, l.rest
WHILE l#
NIL
DO
RepositionApplicationList[l.first.specific.contents];
RepositionApplication[l.first.mightReplace]
ENDLOOP;
--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
IF SymTab.Pairs[design.cellDirectory, EachEntryReposition] THEN ERROR;
END;
RepositionApplicationList:
PROC [list:
CD.ApplicationList] =
INLINE
--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
BEGIN
FOR w:
CD.ApplicationList ← list, w.rest
WHILE w#
NIL
DO
--IF w.first.ob=objToReposition THEN-- RepositionApplication[w.first];
ENDLOOP;
END;
RepositionApplication:
PROC [aptr:
CD.ApplicationPtr] =
--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
INLINE BEGIN
IF aptr#
NIL
AND aptr.ob=objToReposition
THEN
BEGIN
aptr.location ← CDOrient.MapPosition[
itemInCell: newBound,
cellSize: oldSize,
cellInstOrient: aptr.orientation,
cellInstPos: aptr.location];
END
END;
-- RepositionObjectOnDesign
IF CDInline.RectAt[[0, 0], oldSize] # newBound
THEN {
IF design#NIL THEN RepositionAllOthers[];
AdjustItself[objToReposition, newBound];
};
END;
ownerKey: ATOM ~ $Owner;
[] ← CDProperties.RegisterProperty[ownerKey];
END.