<> <> <> <> DIRECTORY Rope USING [ROPE], CD USING [Design, Object, Position, ObjectClass]; CDDirectory: CEDAR DEFINITIONS = BEGIN <> <<>> <<-- 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_FALSE]; DirSize: PROC [design: CD.Design] RETURNS [INT]; <<--number of objects in the directory>> <<--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: BOOL_FALSE] RETURNS [new: CD.Object, topMode: InclOrReady, childMode: ImmOrIncl]; <<--Building block to copy an object into an other design. Does not fail if into#NIL; NIL if fails.>> <<--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: BOOL_FALSE] 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.>> ExpandByDraw: PROC [me: CD.Object, flatDir, flatAll: BOOL _ FALSE] 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.>> <<>> ReplaceChildren: PROC [me: CD.Object, into: CD.Design] RETURNS [ok: BOOL]; <<--replace children by objects in the into design, complete down the hierarchy>> 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, setName: SetRopeProc_NIL, -- call reserved to CDDirectoryImpl includeEtAll: IncludeEtAllProc_NIL -- call reserved to CDDirectoryImpl ]; 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 it is included in directory, >> 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]; ExpandProc: TYPE = PROC[me: CD.Object, fromOrNil: CD.Design_NIL, into: CD.Design_NIL, friendly: BOOL_FALSE] RETURNS [ new: CD.Object_NIL, topMode: DMode_ready, childMode: ImmOrIncl_immutable ]; <<--Basic building block 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: BOOL_FALSE] RETURNS [ new: CD.Object_NIL, topMode: InclOrReady_included, childMode: ImmOrIncl_immutable ]; <<--Basic building block 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 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 if called recursively or through ReplaceObject >> <<--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 if called recursively or through RepositionObject>> <<>> ReplaceDirectChild: PROC [me: CD.Object, design: CD.Design, replace: ReplaceList] RETURNS [changed: BOOL_FALSE]; PropagateChange: PROC [ob: CD.Object, design: CD.Design]; <<-- processes an CDEvent $AfterChange>> END.