CDDirectory.mesa (a ChipNDale module)
Copyright © 1983, 1985 by Xerox Corporation. All rights reserved.
by Christian Jacobi, 23-Aug-83
last edited Christian Jacobi, June 3, 1985 2:45:09 pm PDT
DIRECTORY
Rope USING [ROPE],
CD USING [Design, Object, Position, ObjectClass];
CDDirectory: CEDAR DEFINITIONS =
BEGIN
-- directory layer
-- 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.Object];
-- search for object in directory
Remove:
PROC [design:
CD.Design, name: Rope.
ROPE, expectObject:
CD.Object←
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.Object,
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.
-- this includes object into design's directory; it does not make an instance.
Rename:
PROC [design:
CD.Design, object:
CD.Object,
newName: Rope.ROPE ← NIL, fiddleName: BOOL←FALSE] 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.Object] RETURNS [quit: BOOL�LSE];
EnumerateChildObjects:
PROC[me:
CD.Object, p: EnumerateObjectsProc, x:
REF←NIL] =
INLINE {
IF me.class.inDirectory THEN ObToDirectoryProcs[me].enumerateChildObjects[me, p, x]
};
Name:
PROC[me:
CD.Object]
RETURNS [Rope.
ROPE] =
INLINE {
RETURN [IF me.class.inDirectory THEN ObToDirectoryProcs[me].name[me] ELSE NIL]
};
Another:
PROC [me:
CD.Object, from, to:
CD.Design]
RETURNS [
CD.Object]
;
--CAUTION: goes only one Layer deep; caller MUST go down the hierachy and
--replace children if from#to; name might change due to conflicts
Expand:
PROC [me:
CD.Object, from, to:
CD.Design]
RETURNS [
CD.Object];
--May succeed or not, returns NIL if no success;
--returned object is of expand-simpler object class (half ordered); but
-- it will generate exactly the same mask.
--When "me" later changes, this has no influence on result;
--Each call delivers a new copy of result
--goes only one Layer deep; caller MUST go down the hierachy and
--replace children if from#to; name might change due to conflicts
ExpandHard:
PROC [me:
CD.Object, from, to:
CD.Design]
RETURNS [
CD.Object]
;
--calls Expand first, but if doesn't succeed and makes sense it calls ExpandByDraw
ExpandByDraw:
PROC [me:
CD.Object, from, to:
CD.Design]
RETURNS [
CD.Object];
--does not check environment dependency or inDirectory
-- implementation of compound objects
DirectoryProcs:
TYPE =
PRIVATE RECORD [
name: RopeProc,
enumerateChildObjects: EnumerateChildObjectsProc,
--at least once, but eventualy duplications; only its immediate childs or
--descendants as soon as it is included in directory,
replaceDirectChilds: ReplaceDChildsProc,
another: AnotherProc,
--may be defaulted:
--results in crazy another proc which makes a copy of the object-definition
expand: AnotherProc, --may be defaulted
setName: SetRopeProc, -- but name must be same as Include used
includeEtAll: IncludeEtAllProc
];
ObToDirectoryProcs:
PRIVATE PROC [ob:
CD.Object]
RETURNS [
REF DirectoryProcs] =
INLINE {
RETURN [NARROW[ob.class.directoryProcs, REF DirectoryProcs]]
};
InstallDirectoryProcs:
PRIVATE
PROC [type:
REF CD.ObjectClass]
RETURNS [
REF DirectoryProcs];
--and set type.inDirectory
--objects which are in the directory must not cause drawing with a context directly
EnumerateChildObjectsProc: TYPE = PROC [me: CD.Object, p: EnumerateObjectsProc, x: REF];
EnumerateObjectsProc: TYPE = PROC [me: CD.Object, x: REF];
RopeProc: TYPE = PROC [me: CD.Object] RETURNS [Rope.ROPE];
SetRopeProc: TYPE = PROC [me: CD.Object, r: Rope.ROPE];
IncludeEtAllProc: TYPE = PROC [me: CD.Object, design: CD.Design, name: Rope.ROPE];
ReplaceList: TYPE = LIST OF REF ReplaceRec;
ReplaceRec:
TYPE =
RECORD [
old: CD.Object,
oldSize: CD.Position, -- never changed
new: CD.Object,
newSize: CD.Position, -- will be computed once before calling client procedures
off: CD.Position
];
ReplaceDChildsProc:
TYPE =
PROC [
me: CD.Object,
design: CD.Design,
replace: ReplaceList
] RETURNS [changed: BOOL←FALSE];
AnotherProc: TYPE = PROC[me: CD.Object, from: CD.Design, to: CD.Design←NIL] RETURNS [CD.Object];
RepositionObject:
PROC [design:
CD.Design,
ob: CD.Object,
oldSize: CD.Position,
baseOff: CD.Position←[0, 0]
];
--CHANGES THE OBJECT !
--all over in the design tries to reposition ob;
--may be delayed;
--does notify Event $reposition; x of type ReplaceRec
ReplaceObject:
PROC [design:
CD.Design,
old: CD.Object,
new: CD.Object,
off: CD.Position←[0, 0]
];
--all over in the design replace old by new
--may be delayed
DoReplaceDirectChild: ReplaceDChildsProc;
PropagateChange:
PROC [ob:
CD.Object, design:
CD.Design];
-- processes an CDEvent $AfterChange
END.