[Pixel]<Chipndale>6.1>CDCommon23>CDDirectory.mesa!1

CDDirectory.mesa (a ChipNDale module)

by Christian Jacobi, 23-Aug-83

last edited Christian Jacobi, March 25, 1986 1:58:20 pm PST

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];

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.