CDDirectory.mesa (a Chipndale module)
Copyright © 1983, 1984 by Xerox Corporation. All rights reserved.
by Christian Jacobi 23-Aug-83
last edited Christian Jacobi October 20, 1984 9:47:49 am PDT
DIRECTORY
Rope USING [ROPE],
CD USING [Design, ObPtr, DesignPosition, DesignRect, ObjectProcs];
CDDirectory: CEDAR DEFINITIONS =
BEGIN
-- directory level
-- all object which contain other objects are supposed to be in the directory;
-- which is necessary for enumeration and for repositioning
-- calls handling the same design must be sequential, otherwise the design can be clobbered
Fetch:
PROC [design:
CD.Design, name: Rope.
ROPE]
RETURNS [found:
BOOL, object:
CD.ObPtr];
-- search for object in directory
Remove:
PROC [design:
CD.Design, name: Rope.
ROPE, expectObject:
CD.ObPtr←
NIL]
RETURNS [done:
BOOL];
-- 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
Include:
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
-- even if it fiddles the name, it does not change the first character
Rename:
PROC [design:
CD.Design, object:
CD.ObPtr,
newName: Rope.ROPE ← NIL] RETURNS [done: BOOL];
Enumerate:
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
EachEntryAction: TYPE = PROC [name: Rope.ROPE, ob: CD.ObPtr] RETURNS [quit: BOOL�LSE];
EnumerateChildObjects:
PROC[me:
CD.ObPtr, p: EnumerateObjectsProc, x:
REF] ~
INLINE {
IF me.p.inDirectory THEN ObToDirectoryProcs[me].enumerateChildObjects[me, p, x]
};
ReplaceDirectChilds:
PROC[me:
CD.ObPtr, old:
CD.ObPtr, new:
CD.ObPtr, off:
CD.DesignPosition]
RETURNS [found:
BOOL←
FALSE] ~
INLINE {
IF me.p.inDirectory THEN found ← ObToDirectoryProcs[me].replaceDirectChilds[me, old, new, off]
};
Key:
PROC[me:
CD.ObPtr]
RETURNS [Rope.
ROPE] ~
INLINE {
RETURN [IF me.p.inDirectory THEN ObToDirectoryProcs[me].key[me] ELSE NIL]
};
Name:
PROC[me:
CD.ObPtr]
RETURNS [Rope.
ROPE] ~
INLINE {
RETURN [IF me.p.inDirectory THEN ObToDirectoryProcs[me].name[me] ELSE NIL]
};
Another:
PRIVATE
PROC [me:
CD.ObPtr, from, to:
CD.Design]
RETURNS [
CD.ObPtr] =
INLINE {
--CAUTION: goes only one level deep; caller MUST go down the hierachy and
--replace children if from#to; name might change due to conflicts
IF me.p.inDirectory THEN RETURN [ObToDirectoryProcs[me].another[me, from, to]]
ELSE RETURN [me]
};
-- implementation of other compound objects
DirectoryProcs:
TYPE =
PRIVATE RECORD [
enumerateChildObjects: EnumerateChildObjectsProc,
--at least once, but eventualy duplications; only its immediate childs
adjustItself: AdjustItselfProc,
repositionElements: RepositionElementsProc,
computeBounds: ComputeBoundsProc,
replaceDirectChilds: ReplaceDirectChildProc,
another: AnotherProc, -- may be defaulted: results in crazy another proc which makes a copy of the object-definition
key: RopeProc,
name: RopeProc,
setName: SetRopeProc, -- but name must be same as Include used
setKey: SetRopeProc -- but name must be same as Include used
];
ObToDirectoryProcs:
PRIVATE PROC [ob:
CD.ObPtr]
RETURNS [
REF DirectoryProcs] ~
INLINE {
RETURN [NARROW[ob.p.directoryProcs, REF DirectoryProcs]]
};
InstallDirectoryProcs: PRIVATE PROC [type: REF CD.ObjectProcs] RETURNS [REF DirectoryProcs];
AdjustItselfProc: TYPE = PROC [objToReposition: CD.ObPtr, newBound: CD.DesignRect];
RepositionElementsProc:
TYPE =
PROC [me:
CD.ObPtr,
objToReposition: CD.ObPtr,
oldSize: CD.DesignPosition, -- of objToReposition
newBound: CD.DesignRect, -- of objToReposition
design: CD.Design];
ComputeBoundsProc: TYPE = PROC [ob: CD.ObPtr] RETURNS [CD.DesignRect];
EnumerateChildObjectsProc: TYPE = PROC [me: CD.ObPtr, p: EnumerateObjectsProc, x: REF];
EnumerateObjectsProc: TYPE = PROC [me: CD.ObPtr, x: REF];
RopeProc: TYPE = PROC [me: CD.ObPtr] RETURNS [Rope.ROPE];
SetRopeProc: TYPE = PROC [me: CD.ObPtr, r: Rope.ROPE];
ReplaceDirectChildProc:
TYPE =
PROC [me:
CD.ObPtr, old:
CD.ObPtr, new:
CD.ObPtr, off: CD.DesignPosition]
RETURNS [found:
BOOL←
FALSE];
--found means object to replace was found (if found, replacement succeeds allways)
--it is the callers business to check for repositioning
AnotherProc: TYPE = PROC[me: CD.ObPtr, from, to: CD.Design] RETURNS [CD.ObPtr];
RepositionAnObject:
PROC [design:
CD.Design, objToReposition:
CD.ObPtr];
-- objToReposition.size must be old, not yet adjusted size;
-- (the actual reposition process may be postboned 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
ReplaceObject:
PROC [design:
CD.Design, old:
CD.ObPtr, new:
CD.ObPtr, off:
CD.DesignPosition←[0, 0]];
-- all over in the design replace old by new; slow, as to be expected
END.