CDDirectory.mesa (a ChipNDale module)
Copyright © 1983, 1986, 1987 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, 23-Aug-83
Last edited by: Christian Jacobi, April 10, 1987 5:54:26 pm PDT
DIRECTORY
RefTab USING [Ref],
Rope USING [ROPE],
CD USING [Design, Object, ObjectClass, PropList, Transformation];
CDDirectory: CEDAR DEFINITIONS =
BEGIN
More class procedures for classes of composed objects.
These functions are necessary for enumeration and resizeing of objects.
Calls handling the same design must be serialized by client (CDSequencer).
Directory: designs have a directory of named objects.
All objects in the directory of a design are accessible.
An object must not be included in a designs directory more than once.
NIL is not used as name of an object.
Mutable objects must not be accessible from different designs.
Accessible children of accessible objects are accessible too.
Only accessible children might be mutable.
This invariant can NOT completely be checked by ChipNDale; it has to trust its clients.
=> Objects which have mutable descendants are mutable!
-- Basic directory procedures
Fetch:
PROC [design:
CD.Design, name: Rope.
ROPE]
RETURNS [object:
CD.Object];
-- Returns named object in directory or NIL if not found
IsIncluded:
PROC [design:
CD.Design, object:
CD.Object]
RETURNS [
BOOL];
-- Checks whether object is included into directory.
Include:
PROC [design:
CD.Design, object:
CD.Object, name: Rope.
ROPE, fiddle:
BOOL←
TRUE]
RETURNS [done:
BOOL];
-- Includes object into directory of design. (Does not make an instance).
-- fiddle: on conflicts try to fiddle name of object
-- done: object included in directory by this call
-- Even if it fiddles the name, the first character of the name is not changed.
-- This makes object accessible.
Remove:
PROC [design:
CD.Design, name: Rope.
ROPE, expectObject:
CD.Object←
NIL]
RETURNS [ob:
CD.Object];
-- Removes name from directory of design by removing object.
-- If expectObject#NIL: removes or fiddles object only if named object really is expectObject.
-- Object may or may not remain accessible.
-- Returns removed object or NIL if no object removed.
Fiddle:
PROC [design:
CD.Design, name: Rope.
ROPE]
RETURNS [ob:
CD.Object];
-- Removes name from directory of design by fiddling name of object
-- Returns fiddled object or NIL if no object fiddled.
Rename:
PROC [design:
CD.Design, object:
CD.Object, newName: Rope.
ROPE, fiddle:
BOOL ←
TRUE, fiddleFirst:
BOOL ←
FALSE, removeFirst:
BOOL ←
FALSE]
RETURNS [done:
BOOL, conflict:
CD.Object];
-- Renames object in the directory of design.
-- fiddle: on conflicts try to fiddle newName
-- fiddleFirst: on conflicts try first to rename conflicting object [only if fiddle=FALSE]
-- removeFirst: on conflicts try first to remove conflicting object [only if fiddle=FALSE]
-- done: object renamed.
-- conflict: conflicting, removed or fiddled object.
Enumerate:
PROC [design:
CD.Design, action: EachEntryAction]
RETURNS [quit:
BOOL];
-- Enumerates objects currently in directory in unspecified order.
-- Objects Included/Removed/Renamed during enumeration may, may not, or may
-- twice 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];
DirSize:
PROC [design:
CD.Design]
RETURNS [
INT];
-- Returns number of objects in the directory
Name:
PROC [object:
CD.Object, design: CD.Design]
RETURNS [Rope.
ROPE];
-- Returns name of object.
-- NIL for objects not in directory of design.
--Ownership procedures; not for clients
IsOwner:
PRIVATE PROC [design:
CD.Design, object:
CD.Object]
RETURNS [
BOOL];
-- Checks whether object is included in design.
-- Client programs must not rely on this procedure; except for self checks.
CompatibleOwner:
PRIVATE PROC [design:
CD.Design, object:
CD.Object]
RETURNS [
BOOL];
-- Checks whether object is included in different design.
-- Not to be called by clients, because ChipNDale's internal invariants may change.
SetOwner:
PRIVATE
PROC [design:
CD.Design, object:
CD.Object, check:
BOOL←
TRUE];
-- Sets flag for IsOwner checks.
-- Not to be called by clients, because ChipNDale's internal invariants may change.
--Class procedures
--Dealing with hierarchy
EnumerateChildObjects:
PROC [me:
CD.Object, proc: EachObjectProc, data:
REF←
NIL]
RETURNS [quit:
BOOL←
FALSE] =
INLINE {
--Enumerates accessible direct children.
-- Unspecified order;
-- Object may be enumerated more than ones.
-- May or may not enumerate objects of non composed classes.
-- [This is how the class declares accessibility to ChipNDale]
IF me.class.composed
THEN
quit ← ObToDirectoryProcs[me].enumerateChildObjects[me, proc, data]
};
EnumerateDesign:
PROC [design:
CD.Design, proc: EachObjectProc, data:
REF←
NIL, dir:
BOOL←
TRUE, top:
BOOL←
TRUE, recurse:
BOOL←
TRUE, dummy:
BOOL←
FALSE, visited: RefTab.Ref←
NIL]
RETURNS [quit:
BOOL←
FALSE];
-- Enumerates accessible composed objects in unspecified order; except if recurse, then
-- topologically sorted. Objects of non composed classes may, may not, or may
-- partly be enumerated.
-- Applies proc to each non composed object until proc returns TRUE or no more objects.
-- Returns quit: TRUE if some proc returns TRUE.
-- Objects Included/Removed/Renamed during enumeration (and their children!)
-- may, may not, or may twice be seen.
-- data: user data handled to proc.
-- dir: enumerates the directory.
-- top: enumerates the top level objects.
-- recurse: enumerates children (transitive) of enumerated objects.
-- dummy: enumerates dummy cells, active only if top=TRUE.
-- visited: read-write cache of already visited object. Normally use NIL!
EnumerateObject:
PROC [ob:
CD.Object, proc: EachObjectProc, data:
REF←
NIL, recurse:
BOOL←
TRUE, visited: RefTab.Ref←
NIL]
RETURNS [quit:
BOOL←
FALSE];
-- Enumerates accessible composed children in unspecified order; except if recurse, then
-- topologically sorted. Objects of non composed classes may, may not, or may
-- partly be enumerated.
-- Applies proc to each non composed object until proc returns TRUE or no more objects.
-- Returns quit: TRUE if some proc returns TRUE.
-- data: user data handled to proc.
-- recurse: enumerates children (transitive) of enumerated objects.
-- visited: read-write cache of already visited object. Normally use NIL!
Another1:
PROC [me:
CD.Object, fromOrNil:
CD.Design←
NIL, into:
CD.Design←
NIL, friendly:
BOOL←
FALSE]
RETURNS [new:
CD.Object, childAccessible:
BOOL];
-- Building block to copy an object into an other design. Does not fail if into#NIL.
-- CAUTION: may go only one Layer deep;
-- see explanations for "AnotherProc" and "childAccessible".
-- Caller must do fixups on result and children objects according to accesssibility if
-- the returned object is made available to any other client.
Expand1:
PROC [me:
CD.Object, fromOrNil:
CD.Design←
NIL, into:
CD.Design←
NIL, friendly:
BOOL←
FALSE]
RETURNS [new:
CD.Object, topAccessible:
BOOL, childAccessible:
BOOL];
-- Get object of simpler structure.
-- Returned object is of expand-simpler object class (half ordered); but
-- it will generate exactly the same mask. NIL on failure.
-- CAUTION: see explanations for "ExpandProc" "topAccessible" and "childAccessible".
-- Caller must do fixups on result and children objects according to accesssibility if
-- the returned object is made available to any other client.
-- bbox must not change; only unfriendly classes change interestrect.
Expand1ByDraw:
PROC [ob:
CD.Object, ep: ExpandDecisionProc←
NIL, data:
REF←
NIL]
RETURNS [new:
CD.Object];
-- Expands an object by using its draw procedures.
-- Returns cell with "childAccessible" = ~ob.class.xDesign for all recursed objects
-- and "topAccessible" = TRUE.
-- Caller must do fixups on result and children objects according to accesssibility if
-- returned object is made available to any other client.
-- ep: is a decision procedure whether children should be expanded
-- data: is passed to ep
ExpandDecision: TYPE = {suppress, leave, recurse} ← leave;
ExpandDecisionProc: TYPE = PROC [ob: CD.Object, trans: CD.Transformation, readOnlyInstProps: CD.PropList, data: REF] RETURNS [decides: ExpandDecision ← leave];
LeaveNextLevel: ExpandDecisionProc;
-- Decision procedure to expand objects of composed classes just one level down.
LeaveRectangles: ExpandDecisionProc;
-- Decision procedure to expand object all the way down to bare rectangles;
-- Removes symbolic objects.
LeaveDontFlatten: ExpandDecisionProc;
-- Decision procedure to expand objects of composed classes: all objects of composed
-- classes not having a non NIL $DontFlatten property will be expanded.
-- Warning: may expand accros designs with objects of xDesign classes.
--Hierarchical inter design copy and expansion
-- The following parameters are common in all procedures and optional
-- cx: A RefTab for describing the state of handled subobjects
-- Use new cx for each [into, fromOrNil, "get the designs lock"] tupple !
-- The procedures might or might not use cx for the top level called objects.
-- getFromCache: If ~NIL, is called to try to get objects out of a client cache.
-- putInCache: If ~NIL, is called to notify client he might cache an object.
-- data: passed to either getFromCache or putInCache
GetFromCacheProc: TYPE = PROC [forOb: CD.Object, data: REF] RETURNS [cachedOb: CD.Object];
PutInCacheProc: TYPE = PROC [forOb, cacheOb: CD.Object, data: REF];
AnotherRecursed:
PROC [me:
CD.Object, into:
CD.Design←
NIL, fromOrNil:
CD.Design←
NIL, cx: RefTab.Ref←
NIL, getFromCache: GetFromCacheProc←
NIL, putInCache: PutInCacheProc←
NIL, data:
REF←
NIL]
RETURNS [new:
CD.Object];
-- Another1, and fix children recursively
-- Tries hard, but might fail
ExpandRecursed:
PROC [me:
CD.Object, into:
CD.Design←
NIL, fromOrNil:
CD.Design←
NIL, cx: RefTab.Ref←
NIL, getFromCache: GetFromCacheProc←
NIL, putInCache: PutInCacheProc←
NIL, data:
REF←
NIL]
RETURNS [new:
CD.Object];
-- Expand1, and fix children recursively
-- Tries hard, but might fail
FixChildren:
PROC [me:
CD.Object, into:
CD.Design, fromOrNil:
CD.Design←
NIL, cx: RefTab.Ref←
NIL, getFromCache: GetFromCacheProc←
NIL, putInCache: PutInCacheProc←
NIL, data:
REF←
NIL]
RETURNS [ok:
BOOL];
-- Replace un-accessible children by objects in the into design, complete down the hierarchy.
-- Does not propagate the change.
-- E.g. to use after an Another1 or Expand1.
-- Implementation of compound objects
DirectoryProcs:
TYPE =
PRIVATE
RECORD [
enumerateChildObjects: EnumerateChildObjectsProc ←
NIL,
-- Enumerates all accessible [composed] direct children [at least once], but NOT any
-- in-accessible children.
-- Default: uses class.xDesign and the DrawProc; slow
-- [a faster client implementation is essential for the overall speed; enumeration
-- is a frequent operation]
replaceDirectChilds: ReplaceDChildsProc ←
NIL,
-- Replace children and recompute bbox
-- Default: Don't default this. Only a fraction of the funcionality is necessary, but
-- that is essential for inter design copy and pruning to work correctly.
another: AnotherProc ←
NIL,
-- copy; inter design copy
-- Default: make a copy of the ObjectRep and shares the specific
expand: ExpandProc ←
NIL,
-- Recast...
-- Default: expand using ExpandByDraw
directoryOp: DirectoryProc ←
NIL
-- Notification of directory operations;
-- Not to be called directly by clients.
];
ObToDirectoryProcs:
PROC [ob:
CD.Object]
RETURNS [
REF DirectoryProcs] =
INLINE {
RETURN [NARROW[ob.class.directoryProcs, REF DirectoryProcs]]
};
InstallDirectoryProcs:
PRIVATE
PROC [type:
CD.ObjectClass, dp: DirectoryProcs]
RETURNS [
REF DirectoryProcs];
-- Installs the class procedures and set type.composed
-- Objects which are composed must not directly cause drawing in a context
--
-- Think twice before implementing object classes outside the ChipNDale implementation.
-- In general this is not a good idea and will introduce long living data and maintenance
-- problems.
EnumerateChildObjectsProc:
TYPE =
PROC [me:
CD.Object, proc: EachObjectProc, data:
REF]
RETURNS [quit:
BOOL←
FALSE];
-- Enumerates at least immediate descendants of composed classes
-- At least once, but eventualy duplications;
EachObjectProc:
TYPE =
PROC [me:
CD.Object, data:
REF←NIL]
RETURNS [quit:
BOOL←
FALSE];
DirectoryFunction: TYPE = {include, remove, rename};
DirectoryProc:
TYPE =
PROC [me:
CD.Object, design:
CD.Design, name: Rope.
ROPE, function: DirectoryFunction];
-- Class procedure to get notified of directory actions
-- The object class gets notified of actions, but it can not rely on
-- getting the include notification only once.
--Resizing and exchanging sub objects
ReplaceList: TYPE = LIST OF REF ReplaceRec;
ReplaceRec:
TYPE =
RECORD [
old: CD.Object,
new: CD.Object,
trans: CD.Transformation←[[0, 0], original]
];
ReplaceDChildsProc:
TYPE =
PROC [me:
CD.Object, design:
CD.Design, replace: ReplaceList]
RETURNS [changed:
BOOL←
FALSE];
-- Class procedure for request to exchange direct children and recomputation of bbox.
-- Must fail to actually replace children if me is immutable
-- May fail to actually replace children with the listed new objects [may compute
-- other new children], but must remove old children and must recompute bbox
-- when children match [with old object in ReplaceList]
-- [An explicite editing operation might fail, but the parts used for making inter -
-- design copy of objects, or a recomputation of the bbox, are not allowed to fail
-- on mutable objects]
-- Returns changed: whether me is changed.
-- [Class should not call PropagateChange directly, but may resize]
--Expansion and copy
ExpandProc:
TYPE =
PROC[me:
CD.Object, fromOrNil:
CD.Design←
NIL, into:
CD.Design←
NIL, friendly:
BOOL←
FALSE]
RETURNS [new:
CD.Object←
NIL, topAccessible:
BOOL←
FALSE, childAccessible:
BOOL←
FALSE];
-- Class procedure to simplify the structure
-- friendly: tries to come up with childAccessible=TRUE (even if more expensive)
-- fromOrNil not mandatory, but might speed up some implementations
-- topAccessible, childAccessible see below
AnotherProc:
TYPE =
PROC[me:
CD.Object, fromOrNil:
CD.Design←
NIL, into:
CD.Design←
NIL, friendly:
BOOL←
FALSE]
RETURNS [new:
CD.Object←
NIL, childAccessible:
BOOL←
FALSE];
-- Class procedure to make a copy of an object
-- copy does not need to be unique
-- (it could even be me if into allows [then topMode is included])
-- friendly: tries to come up with childAccessible=TRUE (even if more expensive)
-- fromOrNil not mandatory, but might speed up some implementations
-- childAccessible see below; top is always accessible.
-- topAccessible, childAccessible
-- An object with either top or children not accessible must NOT be changed nor included
-- into any design or directory by any program.
-- To fix an un-accessible top, use Another
-- To fix un-accessible children, use Another [recursively], or use FixChildren.
--Changes
PropagateResize:
PROC [design:
CD.Design, ob:
CD.Object];
-- All over in the design tries to re-size objects containing ob.
-- Delayed if called recursively or through ReplaceObject.
-- Also notifies Event $resize; x of type ReplaceRec
ReplaceObject:
PROC [design:
CD.Design, old:
CD.Object, new:
CD.Object, trans:
CD.Transformation←[[0, 0], original]];
-- Replace old by new in all instances of the design and its objects.
-- Does not change the directory.
-- Does not change sub objects of immutable objects.
-- Might also fail for children of objects in some funny object classes.
-- Delayed if called recursively or through PropagateResize.
ReplaceDirectChild:
PROC [me:
CD.Object, design:
CD.Design, replace: ReplaceList, propagate:
BOOL←
TRUE]
RETURNS [changed:
BOOL←
FALSE];
-- Checks me and its direct children; performs operations as required in replace.
-- May fail if me is immutable or its children are not accessible.
-- changed: whether me did replace a child.
-- propagate: If propagate, calls PropagateChange if me did replace a child.
-- Necessary resizing is done independent of propagate.
PropagateChange:
PROC [ob:
CD.Object, design:
CD.Design];
-- Process an CDEvent $AfterChange
END.