<> <> <> <> <<>> DIRECTORY RefTab USING [Ref], Rope USING [ROPE], CD USING [Design, Object, ObjectClass, PropList, Transformation]; CDDirectory: CEDAR DEFINITIONS = BEGIN <> <> <> <<>> <> <> <> <> <<>> <> <> <> <> <<=> 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_FALSE]; 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.