CDDirectory.mesa (a ChipNDale module)
Copyright © 1983, 1986 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, 23-Aug-83
Last edited by: Christian Jacobi, October 16, 1986 12:11:55 pm PDT
DIRECTORY
Rope USING [ROPE],
CD USING [Design, Object, ObjectClass, Transformation];
CDDirectory: CEDAR DEFINITIONS =
BEGIN
Directory: designs have a directory of named objects.
The directory contains all object which are built using other objects.
This is necessary for enumeration and resizeing of objects.
Calls handling the same design must be serialized by client (CDSequencer).
-- basic procedures
Fetch: PROC [design: CD.Design, name: Rope.ROPE] RETURNS [found: BOOL, object: CD.Object];
-- Search for named object in directory
Remove: PROC [design: CD.Design, name: Rope.ROPE, expectObject: CD.Object←NIL] RETURNS [done: BOOL];
-- Removes object from directory.
-- Object must not be used anymore in design.
-- If expectObject#NIL: removes object only if named object really is expectObject.
Include: PROC [design: CD.Design, object: CD.Object, alternateName: Rope.ROPENIL, fiddleName: BOOLTRUE] RETURNS [done: BOOL];
-- Includes object into directory of design. (Does not make an instance).
-- Objects must not be included into several design's.
-- Even if it fiddles the name, the first character of the name is not changed.
-- Must not be used for object classes with inDirectory field FALSE
Rename: PROC [design: CD.Design, object: CD.Object, newName: Rope.ROPE NIL, fiddleName: BOOLFALSE] RETURNS [done: BOOL];
-- Renames an object
-- Must not be used for object classes with inDirectory field FALSE
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 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];
DirSize: PROC [design: CD.Design] RETURNS [INT];
-- Returns number of objects in the directory
IsOwner: PRIVATE PROC [design: CD.Design, object: CD.Object] RETURNS [BOOL];
-- Checks whether object is included in directory of design.
-- Client programs should not rely on this procedure; except for self checks.
--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, fromOrNil: CD.Design←NIL, into: CD.Design←NIL, friendly: BOOLFALSE] RETURNS [new: CD.Object, topMode: InclOrReady, childMode: ImmOrIncl];
-- 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 "DMode".
-- Caller must do fixups on result and children objects according to mode.
-- Name may differ due to conflicts
Expand: PROC [me: CD.Object, fromOrNil: CD.Design←NIL, into: CD.Design←NIL, friendly: BOOLFALSE] RETURNS [new: CD.Object, topMode: DMode, childMode: ImmOrIncl];
-- Get object of simpler structure.
-- Returned object is of expand-simpler object class (half ordered); but
-- it will generate exactly the same mask. NIL if fails.
-- CAUTION: see explanations for "ExpandProc" and "DMode".
-- Caller must do fixups on result and children objects according to mode.
-- Nice classes do expand without changing bbox or interestrect.
ExpandByDraw: PROC [me: CD.Object, flatDir, flatAll: BOOLFALSE] RETURNS [new: CD.Object];
-- Expands an object by using its draw procedures.
-- Returns cell, corresponds "topMode" ready.
-- flatDir: flattens sub-objects in directory.
-- flatAll: flattens sub-objects ~in directory to bare rectangles.
FixChildren: PROC [me: CD.Object, into: CD.Design] RETURNS [ok: BOOL];
-- Replace children by objects in the into design, complete down the hierarchy.
-- E.g. to use after an expand.
AnotherComplete: PROC [me: CD.Object, fromOrNil: CD.Design←NIL, into: CD.Design←NIL] RETURNS [new: CD.Object];
-- Another, and fix children
-- Tries hard, but might fail
ExpandComplete: PROC [me: CD.Object, fromOrNil: CD.Design←NIL, into: CD.Design←NIL] RETURNS [new: CD.Object];
-- Expand, and fix children
-- Tries hard, but might fail
-- implementation of compound objects
DirectoryProcs: TYPE = PRIVATE RECORD [
name: RopeProc ← NIL,
enumerateChildObjects: EnumerateChildObjectsProc ← NIL,
replaceDirectChilds: ReplaceDChildsProc ← NIL,
another: AnotherProc ← NIL,
expand: ExpandProc ← NIL,
directoryOp: DirectoryProc ← NIL -- 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];
-- and set type.inDirectory
-- objects which are in the directory must not directly cause drawing in a context
EnumerateChildObjectsProc: TYPE = PROC [me: CD.Object, p: EnumerateObjectsProc, x: REF];
-- at least once, but eventualy duplications; only its immediate childs or
-- descendants as soon as they are included in directory, may or may not
-- ommit children objects not in the directory.
EnumerateObjectsProc: TYPE = PROC [me: CD.Object, x: REF];
RopeProc: TYPE = PROC [me: CD.Object] RETURNS [Rope.ROPE];
DirectoryFunction: TYPE = {include, remove, rename};
DirectoryProc: TYPE = PROC [me: CD.Object, design: CD.Design, name: Rope.ROPE, function: DirectoryFunction] RETURNS [proceed: BOOLTRUE];
-- the object class has the option to refuse DirectoryProc's, but should not refuse remove's.
-- the object class does not need to perform any tests
--Resizing and exchanging 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: BOOLFALSE];
-- may fail if me thinks it is immutable and its children are not in the directory
ExpandProc: TYPE = PROC[me: CD.Object, fromOrNil: CD.Design←NIL, into: CD.Design←NIL, friendly: BOOLFALSE] RETURNS [new: CD.Object←NIL, topMode: DMode←immutable, childMode: ImmOrIncl←immutable];
-- Basic procedure to simplify the structure
-- friendly: tries to come up with childMode=included (expensive)
-- fromOrNil not mandatory, but might speed up some implementations
AnotherProc: TYPE = PROC[me: CD.Object, fromOrNil: CD.Design←NIL, into: CD.Design←NIL, friendly: BOOLFALSE] RETURNS [new: CD.Object←NIL, topMode: InclOrReady, childMode: ImmOrIncl←immutable];
-- Basic 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 childMode=included (expensive)
-- fromOrNil not mandatory, but might speed up some implementations
DMode: TYPE = {immutable, included, ready};
ImmOrIncl: TYPE = DMode[immutable..included];
InclOrReady: TYPE = DMode[included..ready];
-- Since the class can not outguess the usage, it delivers whatever is simplest. The application
-- might have to do some fixes or go down the hierachy.
-- children children children
-- included in ready for immutable
-- directory inclusion
-- top level included in directory yes (3) never (1) never (1)
-- top level ready for inclusion yes never (2) yes
-- top level immutable yes (4) never (1) yes (4)
--
-- included in directory:
-- For Expand: into same design as source
-- For Another: only into the "into" design
-- ready for inclusion:
-- For Expand: into any design (allowing only a particular design is outruled)
-- For Another: if into#nil: restricted to the "into" design, if into=nil: any design
-- immutable: [probably cached]
-- An immutable object MUST NOT be changed NOR included into any design by the caller.
-- (But the class implementation itself is not restricted, except: it shall not cause
-- asynchrounous changes until the source designs synchronization lock is free. If the
-- caller wants to protect itself, it can make a copy of the "immutable" object before
-- releasing the source designs lock)
-- For propagating an immutable object into an further conversion use fromOrNil=NIL
-- 1 outruled by contradiction
-- 2 outruled by convention; too complex
-- 3 discouraged for expands, encuraged for anothers
-- 4 yes for expand procs, outruled by convention for anotherprocs
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, if the sub objects are not in the directory.
-- Delayed if called recursively or through PropagateResize.
ReplaceDirectChild: PROC [me: CD.Object, design: CD.Design, replace: ReplaceList] RETURNS [changed: BOOLFALSE];
-- Checks me and its direct children; performs operations as required in replace.
-- May fail if me thinks it is immutable and its children are not in the directory.
PropagateChange: PROC [ob: CD.Object, design: CD.Design];
-- Process an CDEvent $AfterChange
END.