CDDirectoryImpl.mesa (part of Chipndale)
Copyright © 1983, 1984 by Xerox Corporation. All rights reserved.
by Christian Jacobi June 24, 1983 5:00 pm
last edited Christian Jacobi November 19, 1984 7:47:28 pm PST
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�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.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�LSE] -- =
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"];
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: repositioningListKey, 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: repositioningListKey, value: ref];
WHILE ref^#NIL DO
RepositionObjectOnDesign[design, ref^.first];
ref^ ← ref^.rest
ENDLOOP;
CDValue.Store[boundTo: design, key: repositioningListKey, value: NIL];
};
--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
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.inDirectory THEN {
old, new: CD.DesignPosition;
--XXX--TerminalIO.WriteRope["adjust size of "];
--XXX--TerminalIO.WriteRope[CDDirectory.Name[objToReposition]];
--XXX--TerminalIO.WriteRope["\n"];
objToReposition.size ← CDBasics.SizeOfRect[newBound];
CDDirectory.ObToDirectoryProcs[objToReposition].adjustItself[objToReposition, newBound];
old ← CDX.ClientOrigin[objToReposition];
new ← CDBasics.SubPoints[old, CDBasics.BaseOfRect[newBound]];
CDX.CallNotification[design, objToReposition, old, new];
};
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.inDirectory THEN {
--XXX--TerminalIO.WriteRope["call repositionElements for "];
--XXX--TerminalIO.WriteRope[CDDirectory.Name[ob]];
--XXX--TerminalIO.WriteRope["\n"];
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 {
aptr.location ← CDOrient.MapPosition[
itemInCell: newBound,
cellSize: oldSize,
cellInstOrient: aptr.orientation,
cellInstPos: aptr.location];
}
END;
-- RepositionObjectOnDesign
--XXX--TerminalIO.WriteRope["enter RepositionObjectOnDesign "];
--XXX--TerminalIO.WriteRope[CDDirectory.Name[objToReposition]];
--XXX--TerminalIO.WriteRope["\n"];
IF CDBasics.RectAt[[0, 0], oldSize] # newBound THEN {
AdjustItself[objToReposition, newBound];
IF design#NIL THEN RepositionAllOthers[];
};
--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;
ReplaceObject: PUBLIC PROC [design: CD.Design, old: CD.ObPtr, new: CD.ObPtr, off: CD.DesignPosition] =
BEGIN
b: BOOL←FALSE;
reposition: BOOL;
repositionList: LIST OF CD.ObPtr←NIL;
ReplaceForOne: CDDirectory.EachEntryAction --PROC [name: Rope.ROPE, ob: CD.ObPtr] RETURNS [quit: BOOL�LSE]-- =
BEGIN
IF ob#old AND ob#new THEN {
found: BOOL ← CDDirectory.ReplaceDirectChilds[me: ob, old: old, new: new, off: off];
--oldy XXX
IF found THEN {
IF reposition THEN repositionList ← CONS[ob, repositionList];
[] ← CDEvents.ProcessEvent[changeEvent, design, ob];
}
}
END;
--oldy XXX
reposition ← (off#[0, 0]) OR (old.size#new.size) OR (old.p.insideRect[old]#new.p.insideRect[new]);
[] ← CDDirectory.Enumerate[design, ReplaceForOne];
FOR list: LIST OF CD.PushRec ← design.actual, list.rest WHILE list#NIL DO
-- HACK XXX XXX
CDProperties.PutPropOnObject[list.first.dummyCell.ob, $Owner, design];
[] ← ReplaceForOne[name: NIL, ob: list.first.dummyCell.ob];
ENDLOOP;
--oldy XXX
FOR list: LIST OF CD.ObPtr ← repositionList, list.rest WHILE list#NIL DO
CDDirectory.RepositionAnObject[design, list.first]
ENDLOOP;
CDOps.DelayedRedraw[design];
END;
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.