DIRECTORY CD, CDGenerate, CDGenerateBackdoor, CDDirectory, CDEvents, CDMenuSpecials, CDProperties, Rope, SymTab; CDGenerateImpl: CEDAR MONITOR IMPORTS CDDirectory, CDEvents, CDMenuSpecials, CDProperties, SymTab EXPORTS CDGenerate, CDGenerateBackdoor = BEGIN publicTables: PUBLIC SymTab.Ref _ SymTab.Create[case: TRUE]; Table: TYPE = CDGenerate.Table; TableRep: TYPE = CDGenerate.TableRep; GeneratorProc: TYPE = CDGenerate.GeneratorProc; IGeneratorProc: TYPE = CDGenerateBackdoor.IGeneratorProc; SelectorProc: TYPE = CDGenerateBackdoor.SelectorProc; Registration: TYPE = RECORD [generator: GeneratorProc, cache: BOOL, data: REF]; Entry: TYPE = RECORD[obName: Rope.ROPE, ob: CD.Object, registration: REF Registration, lastChange: REF_NIL]; Indirection: TYPE = RECORD [onTopOf: Table, iGenerator: IGeneratorProc, selector: SelectorProc, flush: BOOL, clear: BOOL, register: BOOL]; changePropertyKey: REF ATOM _ NEW[ATOM _ $changePropertyKey]; ObjectHasChanged: CDEvents.EventProc = BEGIN WITH x SELECT FROM ob: CD.Object => { IF ob.class.inDirectory THEN CDProperties.PutPropOnObject[onto: ob, prop: changePropertyKey, val: NEW[INT]] }; ENDCASE => NULL; END; GetCache: PROC [table: Table, design: CD.Design] RETURNS [cache: SymTab.Ref] = TRUSTED BEGIN WITH CDProperties.GetPropFromDesign[from: design, prop: LOOPHOLE[table]] SELECT FROM symtab: SymTab.Ref => cache _ symtab; ENDCASE => { cache _ SymTab.Create[case: table.case]; CDProperties.PutPropOnDesign[onto: design, prop: LOOPHOLE[table], val: cache]; }; END; OkObject: PROC [design: CD.Design, entry: REF Entry] RETURNS [ok: BOOL_TRUE] = BEGIN IF entry.ob.class.inDirectory THEN { ob1: CD.Object _ CDDirectory.Fetch[design, entry.obName].object; IF ob1=NIL OR ob1#entry.ob THEN RETURN [ok_FALSE]; ok _ entry.lastChange=CDProperties.GetPropFromObject[from: ob1, prop: changePropertyKey]; }; END; Create: PUBLIC PROC [case: BOOL _ TRUE, cache: BOOL _ TRUE] RETURNS [table: Table] = BEGIN table _ NEW[TableRep_[rep: SymTab.Create[case: case, mod: 51], case: case, cache: cache]]; END; CreateIndirect: PUBLIC PROC [onTopOf: Table, iGenerator: IGeneratorProc, selector: SelectorProc_NIL, cache: BOOL _ TRUE, flushThrough: BOOL _ TRUE, clearThrough: BOOL _ TRUE, registerThrough: BOOL _ TRUE] RETURNS [table: Table] = BEGIN ind: REF Indirection _ NEW[Indirection _ [iGenerator: iGenerator, onTopOf: onTopOf, selector: selector, flush: flushThrough, clear: clearThrough, register: registerThrough]]; table _ NEW[TableRep _ [rep: ind, case: onTopOf.case, cache: cache AND onTopOf.cache]]; END; Indiretee: PUBLIC PROC [table: Table] RETURNS [Table] = BEGIN WITH table.rep SELECT FROM ind: REF Indirection => RETURN [ind.onTopOf] ENDCASE => RETURN [NIL] END; Clear: PUBLIC PROC [table: Table] = BEGIN WITH table.rep SELECT FROM symtab: SymTab.Ref => { EachPair: SymTab.EachPairAction = { [] _ symtab.Delete[key]; quit _ FALSE; }; [] _ symtab.Pairs[EachPair]; }; ind: REF Indirection => IF ind.clear THEN Clear[ind.onTopOf]; ENDCASE => ERROR END; Register: PUBLIC PROC [table: Table, key: Rope.ROPE, generator: GeneratorProc, cache: BOOL, data: REF] RETURNS [first: BOOL] = BEGIN WITH table.rep SELECT FROM symtab: SymTab.Ref => { IF generator=NIL THEN first _ ~ symtab.Delete[key] ELSE first _ symtab.Store[key, NEW[Registration _ [generator: generator, cache: cache AND table.cache, data: data]]] }; ind: REF Indirection => IF ind.register THEN RETURN [Register[ind.onTopOf, key, generator, cache, data]]; ENDCASE => ERROR END; FetchRegRef: PROC [table: Table, key: Rope.ROPE] RETURNS [reg: REF Registration_NIL] = BEGIN WITH table.rep SELECT FROM symtab: SymTab.Ref => WITH symtab.Fetch[key].val SELECT FROM reg: REF Registration => RETURN [reg]; ENDCASE => NULL; ind: REF Indirection => RETURN [FetchRegRef[ind.onTopOf, key]] ENDCASE => NULL; END; FetchRegistration: PUBLIC PROC [table: Table, key: Rope.ROPE] RETURNS [generator: GeneratorProc_NIL, cache: BOOL_FALSE, data: REF_NIL] = BEGIN reg: REF Registration = FetchRegRef[table, key]; IF reg#NIL THEN { generator _ reg.generator; cache _ reg.cache AND table.cache; data _ reg.data }; END; FetchCached: PUBLIC PROC[table: Table, design: CD.Design, key: Rope.ROPE] RETURNS [ob: CD.Object_NIL] = BEGIN IF table.cache THEN { reg: REF Registration _ FetchRegRef[table, key]; IF reg=NIL OR reg.cache THEN { obCache: SymTab.Ref _ GetCache[table, design]; entry: REF Entry _ NARROW[obCache.Fetch[key].val]; IF entry#NIL AND entry.registration=reg THEN { IF OkObject[design, entry] THEN RETURN [entry.ob] ELSE [] _ obCache.Delete[key] } } } END; FetchNCall: PUBLIC PROC[table: Table, design: CD.Design, key: Rope.ROPE, cache: BOOL] RETURNS [ob: CD.Object_NIL] = BEGIN ob _ FetchIndirect[passTable: table, realTable: table, design: design, key: key, cache: cache] END; Flush: PUBLIC PROC [table: Table, design: CD.Design, key: Rope.ROPE] = BEGIN IF table.cache THEN { cache: SymTab.Ref _ GetCache[table, design]; [] _ cache.Delete[key] }; WITH table.rep SELECT FROM ind: REF Indirection => IF ind.flush THEN Flush[ind.onTopOf, design, key]; ENDCASE => NULL; END; FlushAll: PUBLIC PROC [table: Table, design: CD.Design] = BEGIN IF table.cache THEN TRUSTED { cache: SymTab.Ref _ SymTab.Create[case: table.case]; CDProperties.PutPropOnDesign[onto: design, prop: LOOPHOLE[table], val: cache] }; WITH table.rep SELECT FROM ind: REF Indirection => IF ind.flush THEN FlushAll[ind.onTopOf, design] ENDCASE => NULL; END; SelectOneOf: PUBLIC PROC[table: Table, label: Rope.ROPE] RETURNS [key: Rope.ROPE_NIL] = BEGIN WITH table.rep SELECT FROM symtab: SymTab.Ref => key _ CDMenuSpecials.SelectOneOf[symtab, label]; ind: REF Indirection => { IF ind.selector=SelectOneOf THEN key _ SelectOneOf[ind.onTopOf, label] ELSE IF ind.selector#NIL THEN key _ ind.selector[table, label] }; ENDCASE => ERROR END; AssertTable: PUBLIC ENTRY PROC [project: Rope.ROPE] RETURNS [table: Table] = TRUSTED BEGIN WITH publicTables.Fetch[project].val SELECT FROM tab: Table => table _ tab; ENDCASE => { table _ Create[]; [] _ publicTables.Store[project, LOOPHOLE[table]]; } END; FetchIndirect: PUBLIC PROC [passTable, realTable: Table, design: CD.Design, key: Rope.ROPE, cache: BOOL_FALSE] RETURNS [ob: CD.Object_NIL] = BEGIN reg: REF Registration_NIL; obCache: SymTab.Ref; entry: REF Entry_NIL; IF cache AND realTable.cache THEN { --THEN also onTopOf.cache ! reg _ FetchRegRef[realTable, key]; IF reg=NIL OR reg.cache THEN { obCache _ GetCache[realTable, design]; entry _ NARROW[obCache.Fetch[key].val]; IF entry#NIL AND entry.registration=reg THEN { IF OkObject[design, entry] THEN RETURN [entry.ob] ELSE [] _ obCache.Delete[key] }; }; }; WITH realTable.rep SELECT FROM st: SymTab.Ref => { IF reg=NIL THEN reg _ FetchRegRef[realTable, key]; IF reg#NIL THEN ob _ reg.generator[design: design, key: key, table: passTable, data: reg.data]; }; ind: REF Indirection => TRUSTED { ob _ ind.iGenerator[design: design, key: key, passTable: passTable, realTable: realTable]; }; ENDCASE => ERROR; IF cache AND realTable.cache THEN { IF reg=NIL OR reg.cache THEN { IF ob=NIL THEN [] _ obCache.Delete[key] ELSE { entry _ NEW[Entry _ [ obName: CDDirectory.Name[ob], ob: ob, registration: reg, lastChange: CDProperties.GetPropFromObject[from: ob, prop: changePropertyKey] ]]; [] _ obCache.Store[key, entry]; } } }; END; CDEvents.RegisterEventProc[event: $AfterChange, proc: ObjectHasChanged]; END. ºCDGenerateImpl.mesa (part of ChipNDale) Copyright c 1985 by Xerox Corporation. All rights reserved. by Christian Jacobi, June 5, 1985 8:02:35 pm PDT Last Edited by Christian Jacobi, June 19, 1985 3:54:27 pm PDT --NIL if not indirect --fetches registration of real generator --cache means original registration and is not updated according to any indirection --returns NIL if not found, not cached or looks different --returns NIL if not found or generated --Removes this entry from the cache --Removes all entries from the cache --Interactive selection --NIL if discarded --Fetches a table; if not done then create one and store it for next call of AssertTable. --This table can be imported by lots of unknown applications... --Like FetchNCall except: --passTable will be passed trough only --realTable table to be really called. --To be called from indirection generators --check fetch from cache --make an actual call... --store in cache Ê e˜šœ'™'Jšœ Ïmœ1™Jšžœžœ˜—Jšžœ˜—J˜š œžœžœžœžœžœ žœžœžœžœ˜ˆJšœS™SJšž˜Jšœžœ(˜0šžœžœžœ˜Jšœ˜Jšœžœ˜#Jšœ˜Jšœ˜—Jšžœ˜—J˜š  œž œžœžœžœžœžœ˜gJšœ9™9Jšž˜šžœ žœ˜Jšœžœ(˜0š žœžœžœ žœž˜Jšœ.˜.Jšœžœ žœ˜2šžœžœžœžœ˜.Jšžœžœžœ ˜1Jšžœ˜J˜—J˜—J˜—Jšžœ˜J™—š  œžœžœžœžœ žœžœžœžœ˜sJšœ'™'Jšž˜Jšœ^˜^Jšžœ˜J™—š  œžœžœžœžœ˜FJšœ#™#Jšž˜šžœ žœ˜Jšœ,˜,Jšœ˜J˜—šžœ žœž˜Jšœžœžœ žœ!˜JJšžœžœ˜—Jšžœ˜J™—š œžœžœžœ ˜9Jšœ$™$Jšž˜šžœ žœžœ˜Jšœ4˜4Jšœ1žœ˜MJ˜—šžœ žœž˜Jšœžœžœ žœ˜GJšžœžœ˜—Jšžœ˜J™—š  œžœžœžœžœ žœžœ˜WJšœ™Jšœ™Jšž˜šžœ žœžœ˜JšœF˜Fšœžœ˜Jšžœžœ&˜FJšžœžœžœžœ!˜>J˜—Jšžœž˜—Jšžœ˜—J˜š   œžœžœžœžœžœ˜LJšœY™YJšœ?™?Jšž ˜ šžœ!žœž˜0Jšœ˜šžœ˜ Jšœ˜Jšœ!žœ ˜2J˜——Jšžœ˜—J˜š  œžœžœ'žœžœ žœžœžœžœžœ˜ŒJšœ™Jšœ'™'Jšœ'™'Jšœ*™*Jšž˜Jšœžœžœ˜Jšœ˜Jšœžœžœ˜Jšœ™šžœžœžœ¡˜?Jšœ"˜"šžœžœžœ žœ˜Jšœ&˜&Jšœžœ˜'šžœžœžœžœ˜.Jšžœžœžœ ˜1Jšžœ˜J˜—J˜—J˜—Jšœ™šžœžœžœ˜šœ˜Jšžœžœžœ#˜2šžœžœž˜JšœO˜O—J˜—šœžœžœ˜!JšœZ˜ZJ˜—Jšžœž˜—Jšœ™šžœžœžœ˜$šžœžœžœ žœ˜Jšžœžœžœ˜'šžœ˜šœžœ ˜Jšœ˜Jšœ˜Jšœ˜JšœM˜MJšœ˜—Jšœ˜Jšœ˜—J˜—J˜—Jšžœ˜—J˜JšœH˜HJšžœ˜J˜—…—Ú+ù