CDDirectory.mesa (a ChipNDale module)
Copyright © 1983, 1985 by Xerox Corporation. All rights reserved.
by Christian Jacobi, 23-Aug-83
last edited Christian Jacobi, September 19, 1985 2:55:15 am PDT
DIRECTORY
Rope USING [ROPE],
CD USING [Design, Object, Position, ObjectClass];
CDDirectory: CEDAR DEFINITIONS =
BEGIN
directory: designs have a directory of named objects. The directory actually contains all object which are built using other objects. This is necessary for enumeration and for repositioning. Calls handling the same design must be sequential, otherwise the design can be clobbered.
-- basic procedures
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];
--class procedures
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];
--Repositioning and exchanging objects
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.