CDDirectoryImpl.mesa (part of ChipNDale)
Copyright © 1983, 1986 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, June 24, 1983 5:00 pm
Last edited by: Christian Jacobi, January 14, 1987 6:00:51 pm PST
DIRECTORY
CD,
CDCells,
CDCellsBackdoor,
CDDefaultProcs,
CDDirectory,
CDEvents,
CDBasics,
CDOps,
CDProperties,
CDRects,
CDValue,
HashTable,
IO,
PropertyLists,
Rope,
TerminalIO;
CDDirectoryImpl:
CEDAR
MONITOR
IMPORTS CD, CDDirectory, CDCells, CDCellsBackdoor, CDDefaultProcs, CDEvents, CDBasics, CDOps, CDProperties, CDRects, CDValue, HashTable, IO, PropertyLists, Rope, 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
SetOwner:
PROC [ob:
CD.Object, d:
CD.Design] = {
x: REF ~ (IF d=NIL THEN NIL ELSE d.cdDirectoryPriv2);
CDProperties.PutObjectProp[ob, ownerKey, x];
};
IsOwner:
PUBLIC PROC [design:
CD.Design, object:
CD.Object]
RETURNS [
BOOL] = {
x: REF ~ (IF design=NIL THEN NIL ELSE design.cdDirectoryPriv2);
RETURN [ CDProperties.GetObjectProp[object, ownerKey]=x ];
};
EachEntryAction: TYPE = PROC [name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL←FALSE];
Fetch:
PUBLIC
PROC [design:
CD.Design, name: Rope.
ROPE]
RETURNS [found:
BOOL, object:
CD.Object←
NIL] = {
--search for object in directory
x: HashTable.Value;
[found, x] ← HashTable.Fetch[NARROW[design.cdDirectoryPriv], name];
IF found THEN object ← NARROW[x, CD.Object];
};
Remove:
PUBLIC
PROC [design:
CD.Design, name: Rope.
ROPE, expectObject:
CD.Object←
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
object: CD.Object ← Fetch[design, name].object;
IF object#
NIL
AND (expectObject=
NIL
OR object=expectObject)
THEN {
IF ~IsOwner[design, object]
THEN
ERROR CD.Error[callingError, "Removed ob not in design"];
done ← HashTable.Delete[NARROW[design.cdDirectoryPriv], name];
IF done
THEN {
SetOwner[object, NIL];
[] ← DirectoryOp[object, design, name, remove];
};
};
};
DirectoryOp:
PROC[me:
CD.Object, design:
CD.Design, name: Rope.
ROPE, function: CDDirectory.DirectoryFunction]
RETURNS [proceed:
BOOL←
TRUE] = {
IF me.class.inDirectory
THEN {
dop: CDDirectory.DirectoryProc = CDDirectory.ObToDirectoryProcs[me].directoryOp;
IF dop#NIL THEN proceed ← dop[me, design, name, function];
}
};
Include:
PUBLIC
PROC [design:
CD.Design, object:
CD.Object, alternateName: Rope.
ROPE←
NIL, fiddleName:
BOOL←
TRUE]
RETURNS [done:
BOOL] = {
--it is an ERROR to include an object into several design's
--but it is ok to include an object twice in the same design
try: INT ← 0;
IF Rope.IsEmpty[alternateName]
THEN {
alternateName ← CDDirectory.Name[object];
IF Rope.IsEmpty[alternateName] THEN alternateName ← "-noname-";
};
IF ~IsOwner[
NIL, object]
THEN {
IF ~IsOwner[design, object]
THEN
ERROR CD.Error[callingError, "cant include object in two designs"]
ELSE {
--ignore whether name is right or wrong
IF ~fiddleName
AND ~Rope.Equal[alternateName, CDDirectory.Name[object]]
THEN
RETURN [done ← FALSE];
RETURN [done ← TRUE]
};
};
DO
IF ~HashTable.Fetch[
NARROW[design.cdDirectoryPriv], alternateName].found
THEN
IF HashTable.Insert[
NARROW[design.cdDirectoryPriv], alternateName, object]
THEN {
done ← DirectoryOp[object, design, alternateName, include];
IF done
THEN {
object.marked ← 0;
SetOwner[object, design]
}
ELSE [] ← HashTable.Delete[NARROW[design.cdDirectoryPriv], alternateName];
RETURN [done]
};
IF ~fiddleName THEN RETURN [done ← FALSE];
try ← try+1;
IF try<3 THEN alternateName ← FiddleName[alternateName, design]
ELSE {
try ← 0;
alternateName ← FiddleGlobal[alternateName];
}
ENDLOOP;
};
globalCount:
INT ←
LOOPHOLE[nameKey,
INT]
MOD 99999 / 8;
--some value which might differ next time ChipNDale is started
FiddleGlobal:
PROC [name: Rope.
ROPE]
RETURNS [Rope.
ROPE] = {
globalCount ← globalCount MOD 1000000B + 1;
RETURN [IO.PutFR["%g@%g@0", IO.rope[name], IO.int[globalCount]]];
};
FiddleName:
PROC [name: Rope.
ROPE, design:
CD.Design]
RETURNS [Rope.
ROPE] = {
modifier: INT ← CDValue.FetchInt[design, $CDxNextInt] MOD 10000000000B;
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]];
CDValue.StoreInt[design, $CDxNextInt, modifier+1];
RETURN [name];
};
Rename:
PUBLIC
PROC [design:
CD.Design, object:
CD.Object, newName: Rope.
ROPE ←
NIL, fiddleName:
BOOL←
FALSE]
RETURNS [done:
BOOL ←
FALSE] = {
oldName: Rope.ROPE = CDDirectory.Name[object];
removed: BOOL = Remove[design, oldName, object];
IF removed
THEN {
back: BOOL ← Include[design, object, newName, fiddleName];
IF back THEN RETURN [done ← TRUE];
back ← Include[design, object, oldName, TRUE];
IF NOT back THEN ERROR CD.Error[programmingError, "rename removed an object"]
}
};
Enumerate:
PUBLIC
PROC [design:
CD.Design, action: EachEntryAction]
RETURNS [quit:
BOOL] = {
EachPairAction: HashTable.EachPairAction ~ {
quit ← action[name: NARROW[key], ob: NARROW[value, CD.Object]]
};
quit ← HashTable.Pairs[NARROW[design.cdDirectoryPriv], EachPairAction]
};
DirSize:
PUBLIC
PROC [design:
CD.Design]
RETURNS [
INT] = {
RETURN [HashTable.GetSize[NARROW[design.cdDirectoryPriv]]]
};
InstallDirectoryProcs:
PUBLIC
PROC [type:
CD.ObjectClass, dp: CDDirectory.DirectoryProcs]
RETURNS [
REF CDDirectory.DirectoryProcs] = {
dpr: REF CDDirectory.DirectoryProcs ~ NEW[CDDirectory.DirectoryProcs𡤍p];
IF type.directoryProcs#
NIL
OR type.inDirectory
THEN
ERROR CD.Error[ec: doubleRegistration, explanation: "object type includes already directory"];
type.directoryProcs ← dpr;
type.inDirectory ← TRUE;
IF dpr.enumerateChildObjects=NIL THEN dpr.enumerateChildObjects ← DefaultEnumerate;
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.name=NIL THEN dpr.name ← DefaultName;
IF dpr.directoryOp=NIL THEN dpr.directoryOp ← DefaultDirectoryOp;
RETURN [dpr]
};
DefaultAnother: CDDirectory.AnotherProc = {
--crazy another proc which makes a copy of the object-definition
new ← NEW[CD.ObjectRep←me^];
new.properties ← CDProperties.DCopyProps[me.properties];
topMode ← ready;
childMode ← IF into#NIL AND into=fromOrNil THEN included ELSE immutable;
};
DefaultExpand: CDDirectory.ExpandProc = {
new ← ExpandByDraw[me: me, flatDir: FALSE, flatAll: FALSE];
topMode ← ready;
childMode←IF into#fromOrNil OR into=NIL THEN immutable ELSE included;
};
DefaultReplaceDirectChilds: CDDirectory.ReplaceDChildsProc = {
ERROR
};
DefaultEnumerate:
PROC [me:
CD.Object, p: CDDirectory.EnumerateObjectsProc, x:
REF] = {
};
DefaultDirectoryOp:
PROC [me:
CD.Object, design:
CD.Design, name: Rope.
ROPE, function: CDDirectory.DirectoryFunction]
RETURNS [proceed:
BOOL←
TRUE] = {
IF function#remove
THEN
CDProperties.PutObjectProp[onto: me, prop: nameKey, val: name]
};
DefaultName:
PROC [me:
CD.Object]
RETURNS [Rope.
ROPE] = {
WITH CDProperties.GetObjectProp[from: me, prop: nameKey]
SELECT
FROM
r: Rope.ROPE => RETURN [r];
ENDCASE => RETURN ["-no name"]
};
-- -- -- -- -- -- -- -- -- -- --
Another:
PUBLIC
PROC [me:
CD.Object, fromOrNil:
CD.Design←
NIL, into:
CD.Design←
NIL, friendly:
BOOL←
FALSE]
RETURNS [new:
CD.Object, topMode: CDDirectory.InclOrReady, childMode: CDDirectory.ImmOrIncl] = {
IF ~me.class.inDirectory THEN RETURN [me, included, included]
ELSE {
another: CDDirectory.AnotherProc ← CDDirectory.ObToDirectoryProcs[me].another;
IF another=NIL THEN ERROR;
[new, topMode, childMode] ← another[me, fromOrNil, into, friendly];
};
};
Expand:
PUBLIC
PROC [me:
CD.Object, fromOrNil:
CD.Design←
NIL, into:
CD.Design←
NIL, friendly:
BOOL←
FALSE]
RETURNS [new:
CD.Object, topMode: CDDirectory.DMode, childMode: CDDirectory.ImmOrIncl] = {
IF ~me.class.inDirectory THEN RETURN [NIL, included, included]
ELSE {
expand: CDDirectory.ExpandProc = CDDirectory.ObToDirectoryProcs[me].expand;
IF expand=NIL THEN ERROR;
[new, topMode, childMode] ← expand[me, fromOrNil, into, friendly];
};
};
FixChildren:
PUBLIC
PROC [me:
CD.Object, into:
CD.Design]
RETURNS [ok:
BOOL] = {
globTab: HashTable.Table ← HashTable.Create[];
ok ← ReplaceChildren1[me: me, into: into, globTab: globTab];
};
ReplaceChildren1:
PROC [me:
CD.Object, into:
CD.Design, globTab: HashTable.Table]
RETURNS [ok:
BOOL←
TRUE] = {
replaceList: CDDirectory.ReplaceList ← NIL;
localTab: HashTable.Table ← HashTable.Create[];
--contains all elements of replaceList; of one level only!
PerChild: CDDirectory.EnumerateObjectsProc = {
IF me.class.inDirectory
THEN {
newChild: CD.Object ← me; tm, cm: CDDirectory.DMode;
IF ~HashTable.Insert[localTab, me, $handled] THEN RETURN; -- eliminate duplicates
WITH HashTable.Fetch[globTab, me].value
SELECT
FROM
cob: CD.Object => newChild ← cob;
ENDCASE => {
IF IsOwner[into, me] THEN [] ← HashTable.Insert[globTab, me, me]
ELSE {
[newChild, tm, cm] ← Another[me: me, fromOrNil: NIL, into: into, friendly: TRUE];
IF newChild=NIL THEN {ok ← FALSE; newChild ← me; cm ← tm ← included};
[] ← HashTable.Insert[globTab, me, newChild];
IF cm=immutable
THEN {
IF ~ReplaceChildren1[newChild, into, globTab].ok THEN ok ← FALSE
};
IF tm=ready
THEN {
[] ← Include[into, newChild]
};
};
};
IF me#newChild
AND newChild#
NIL
THEN
replaceList ← CONS[NEW[CDDirectory.ReplaceRec←[old: me, new: newChild]], replaceList];
}
};
CDDirectory.EnumerateChildObjects[me: me, p: PerChild, x: NIL];
IF replaceList#
NIL
THEN
[] ← CDDirectory.ReplaceDirectChild[me: me, design: into, replace: replaceList];
};
AnotherComplete:
PUBLIC
PROC [me:
CD.Object, fromOrNil:
CD.Design←
NIL, into:
CD.Design←
NIL]
RETURNS [new:
CD.Object←
NIL] = {
tm, cm: CDDirectory.DMode;
[new, tm, cm] ← Another[me, fromOrNil, into, TRUE];
IF new#
NIL
THEN {
IF cm=immutable
THEN {
IF ~FixChildren[new, into].ok THEN RETURN [NIL]
};
IF tm=ready
THEN {
[] ← Include[into, new]
};
};
};
ExpandComplete:
PUBLIC
PROC [me:
CD.Object, fromOrNil:
CD.Design←
NIL, into:
CD.Design←
NIL]
RETURNS [new:
CD.Object] = {
tm, cm: CDDirectory.DMode;
[new, tm, cm] ← Expand[me, fromOrNil, into, TRUE];
IF new#
NIL
THEN {
IF tm=immutable
THEN {
fromOrNil ← NIL;
[new, tm, cm] ← Another[new, fromOrNil, into];
IF new=NIL THEN RETURN;
};
IF cm=immutable
THEN {
IF ~FixChildren[new, into].ok THEN RETURN [NIL]
};
IF tm=ready
THEN {
[] ← Include[into, new]
};
};
};
ExpandRec:
TYPE =
RECORD [
cell: CD.Object,
cellPtr: CD.CellSpecific,
flatDir: BOOL ← FALSE,
flatAll: BOOL ← FALSE
];
globalContextFilter: REF CD.ContextFilter = NEW[CD.ContextFilter←ALL[TRUE]];
ExpandByDraw:
PUBLIC
PROC [me:
CD.Object, flatDir, flatAll:
BOOL ←
FALSE]
RETURNS [new:
CD.Object←
NIL] = {
dummyInst: CD.Instance = NEW[CD.InstanceRep];
expandRef: REF ExpandRec = NEW[ExpandRec];
expandPr:
CD.DrawRef =
CD.CreateDrawRef[[
design: NIL,
drawRect: ExpandBareRect,
drawChild: ExpandChild,
drawOutLine: CDDefaultProcs.IgnoreOutLine,
selections: FALSE,
devicePrivate: expandRef,
contextFilter: globalContextFilter
]];
dummyInst^.ob ← me;
expandRef.cell ← CDCells.CreateEmptyCell[];
expandRef.cellPtr ← NARROW[expandRef.cell.specific];
expandRef.flatDir ← flatDir;
expandRef.flatAll ← flatAll;
me.class.drawMe[inst: dummyInst, trans: [], pr: expandPr];
IF ~CDCells.IsEmpty[expandRef.cell]
THEN {
name: Rope.ROPE ← CDDirectory.Name[me];
IF Rope.IsEmpty[name] THEN name ← CDOps.ObjectRope[me];
expandRef.cellPtr.name ← Rope.Concat["!", name];
new ← expandRef.cell;
CDCells.SetInterestRect[NIL, new, CD.InterestRect[me], doit];
};
};
ExpandBareRect:
PROC [r:
CD.Rect, l:
CD.Layer, pr:
CD.DrawRef] = {
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];
};
ExpandChild:
PROC [inst:
CD.Instance, trans: CD.Transformation, pr:
REF
CD.DrawInformation] = {
newInst: CD.Instance;
expandRef: REF ExpandRec = NARROW[pr.devicePrivate];
IF inst.ob.class.inDirectory
THEN {
IF expandRef.flatDir THEN {inst.ob.class.drawMe[inst, trans, pr]; RETURN}
}
ELSE {
IF expandRef.flatAll THEN {inst.ob.class.drawMe[inst, trans, pr]; RETURN};
};
newInst ← NEW[CD.InstanceRep←[ob: inst.ob, trans: trans, properties: CDProperties.DCopyProps[inst.properties]]];
expandRef.cellPtr.contents ← CONS[newInst, expandRef.cellPtr.contents];
};
-- -- -- -- -- -- -- -- -- -- --
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] = {
--all over in the design replace old by new
--may be delayed
repRef: REF CDDirectory.ReplaceRec ← NEW[CDDirectory.ReplaceRec←[old: old, new: new, trans: trans]];
IF design=NIL THEN ERROR;
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] = {
--all over in the design tries to reposition ob;
--may be delayed
repRef: REF CDDirectory.ReplaceRec ← NEW[CDDirectory.ReplaceRec←[old: ob, new: ob]];
[] ← CDEvents.ProcessEvent[
ev: 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] = {
--catches recursive calls and transformes them into sequential calls...
--the list of what to do is found using CDValue on the design
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
--impossible; call me to debug this
ERROR;
IF l.rest=NIL THEN {l.rest ← LIST[repRef]; EXIT}
ENDLOOP;
};
RETURN
};
-- we are not inside reposition process, start one
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]
RETURNS [changed:
BOOL←
FALSE] = {
IF me.class.inDirectory
THEN
changed ← CDDirectory.ObToDirectoryProcs[me].replaceDirectChilds[me, design, replace];
IF changed THEN PropagateChange[me, design];
};
DoReplaceAllChilds:
PUBLIC
PROC [design:
CD.Design, repList: CDDirectory.ReplaceList] = {
ReplaceForOne: CDDirectory.EachEntryAction = {
-- PROC [name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL�LSE] --
[] ← ReplaceDirectChild[me: ob, design: design, replace: repList];
};
[] ← CDDirectory.Enumerate[design, ReplaceForOne];
FOR plist:
LIST
OF
CD.PushRec ← design.actual, plist.rest
WHILE plist#
NIL
DO
inst: CD.Instance ← plist.first.mightReplace;
SetOwner[plist.first.dummyCell.ob, design]; --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: PropertyLists.EachProp = {
p: CDProperties.PropertyProcs ~ CDProperties.FetchProcs[key];
IF p#NIL AND p.autoRem THEN CDProperties.PutObjectProp[ob, key, NIL];
};
IF ob#NIL THEN [] ← PropertyLists.Enumerate[ob.properties, Rem]
};
PropagateChange:
PUBLIC
PROC [ob:
CD.Object, design:
CD.Design] = {
-- processes an CDEvent $AfterChange
[] ← CDEvents.ProcessEvent[changeEvent, design, ob];
};
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
nameKey: REF ATOM = NEW[ATOM ← $Name]; -- make it non accessible, non write on file
[] ← CDProperties.RegisterProperty[ownerKey];
CDProperties.InstallProcs[prop: ownerKey, procs: CDProperties.PropertyProcsRec[exclusive: TRUE]];
CDProperties.InstallProcs[prop: nameKey, procs: CDProperties.PropertyProcsRec[exclusive: TRUE]];
CDValue.RegisterKey[repositioningListKey];
CDEvents.RegisterEventProc[event: changeEvent, proc: RemovePropsEvent];
END.