DIRECTORY Commander, Core, CoreClasses, CoreOps, CoreProperties, HashTable, IO, ProcessProps, Properties, Rope; CorePropertiesImpl: CEDAR PROGRAM IMPORTS CoreOps, HashTable, IO, ProcessProps, ImplementationProperties: Properties, Rope EXPORTS CoreProperties SHARES Core = BEGIN OPEN CoreProperties; Properties: TYPE = Core.Properties; propTable: HashTable.Table _ HashTable.Create[]; GetProp: PUBLIC PROC [from: Properties, prop: ATOM] RETURNS [value: REF ANY _ NIL] = { value _ ImplementationProperties.GetProp[from, prop]; }; PutProp: PUBLIC PROC [on: Properties, prop: ATOM, value: REF ANY _ NIL] RETURNS [new: Properties] = { new _ ImplementationProperties.PutProp[on, prop, value]; }; CopyProps: PUBLIC PROC [propList: Properties] RETURNS [copy: Properties] = { copy _ AppendProps[propList, NIL]; }; AppendProps: PUBLIC PROC [winner, loser: Properties] RETURNS [copy: Properties _ NIL] = { CopyItem: PROC [list: Properties, item: ImplementationProperties.KeyVal] RETURNS [newList: Properties] = BEGIN prop: ATOM = NARROW [item.key]; propCopyProc: REF _ GetProp[FetchProperties[prop], propCopy]; newValue: REF _ IF propCopyProc=NIL THEN NIL ELSE (NARROW [propCopyProc, REF PropCopyProc])^[prop: prop, value: item.val]; IF newValue=NIL THEN newList _ list ELSE newList _ ImplementationProperties.PutProp[propList: list, prop: prop, val: newValue]; END; WHILE loser#NIL DO copy _ CopyItem[copy, loser.first]; loser _ loser.rest; ENDLOOP; WHILE winner#NIL DO copy _ CopyItem[copy, winner.first]; winner _ winner.rest; ENDLOOP; }; Enumerate: PUBLIC PROC [props: Properties, consume: PROC [prop: ATOM, val: REF ANY]] = { FOR pl: Properties _ props, pl.rest WHILE pl # NIL DO consume[NARROW [pl.first.key], pl.first.val]; ENDLOOP; }; PrintProperties: PUBLIC PROC [props: Properties, out: IO.STREAM _ NIL, indent: NAT _ 0, cr: BOOL _ TRUE, level: NAT _ 2] = { PrintIt: PROC [prop: ATOM, val: REF ANY _ NIL] = { propprops: Properties _ FetchProperties[prop]; pp: REF PropPrintProc; IF propprops#NIL THEN { pp _ NARROW [GetProp[propprops, propPrint]]; IF pp # NIL THEN { pp^[to: out, prop: prop, val: val, indent: indent, level: level]; } }; IF propprops=NIL OR pp=NIL THEN { CoreOps.PrintIndent[indent, out, cr]; IO.PutF[out, "%g: ", IO.atom[prop]]; WITH val SELECT FROM atom: ATOM => IO.PutF[out, "%g", IO.atom[atom]]; rope: Core.ROPE => IO.PutF[out, "%g", IO.rope[rope]]; refInt: REF INT => IO.PutF[out, "%g", IO.int[refInt^]]; ENDCASE => {}; }; }; IF out=NIL THEN out _ NARROW[ProcessProps.GetProp[$CommanderHandle], Commander.Handle].out; Enumerate[props, PrintIt]; }; RegisterProperty: PUBLIC PROC [prop: ATOM, properties: Properties _ NIL] RETURNS [sameProp: ATOM] = { [] _ HashTable.Store[propTable, prop, properties]; sameProp _ prop; }; StoreProperties: PUBLIC PROC [prop: ATOM, properties: Properties] = { [] _ HashTable.Store[propTable, prop, properties]; }; FetchProperties: PUBLIC PROC [prop: ATOM] RETURNS [properties: Properties] = { found: BOOL; value: HashTable.Value; [found, value] _ HashTable.Fetch[propTable, prop]; IF NOT found THEN RETURN[NIL]; properties _ NARROW [value, Properties]; }; propPrint: PUBLIC ATOM _ $PropPrint; propCopy: PUBLIC ATOM _ $PropCopy; propCompare: PUBLIC ATOM _ $PropCompare; DoCopy: PropCopyProc = {valCopy _ value}; PropDoCopy: PUBLIC REF PropCopyProc _ NEW [PropCopyProc _ DoCopy]; DontPrint: PropPrintProc = {}; PropDontPrint: PUBLIC REF PropPrintProc _ NEW [PropPrintProc _ DontPrint]; RopeCompare: PUBLIC PropCompareProc = { equal _ Rope.Equal[NARROW [value1, Rope.ROPE], NARROW [value2, Rope.ROPE]]; }; PropRopeCompare: PUBLIC REF PropCompareProc _ NEW [PropCompareProc _ RopeCompare]; IntCompare: PUBLIC PropCompareProc = { equal _ NARROW [value1, REF INT]^=NARROW [value2, REF INT]^; }; PropIntCompare: PUBLIC REF PropCompareProc _ NEW [PropCompareProc _ IntCompare]; Props: PUBLIC PROC [lit1, lit2, lit3, lit4, lit5, lit6: PropertyLiteral _ []] RETURNS [properties: Properties] = { properties _ PutProp[on: NIL, prop: lit1.key, value: lit1.val]; properties _ PutProp[on: properties, prop: lit2.key, value: lit2.val]; properties _ PutProp[on: properties, prop: lit3.key, value: lit3.val]; properties _ PutProp[on: properties, prop: lit4.key, value: lit4.val]; properties _ PutProp[on: properties, prop: lit5.key, value: lit5.val]; properties _ PutProp[on: properties, prop: lit6.key, value: lit6.val]; }; GetWireProp: PUBLIC PROC [from: Core.Wire, prop: ATOM] RETURNS [value: REF ANY _ NIL] = { value _ GetProp[from: from.properties, prop: prop]; }; PutWireProp: PUBLIC PROC [on: Core.Wire, prop: ATOM, value: REF ANY _ NIL] = { on.properties _ PutProp[on: on.properties, prop: prop, value: value]; }; GetCellClassProp: PUBLIC PROC [from: Core.CellClass, prop: ATOM] RETURNS [value: REF ANY _ NIL] = { value _ GetProp[from: from.properties, prop: prop]; }; PutCellClassProp: PUBLIC PROC [on: Core.CellClass, prop: ATOM, value: REF ANY _ NIL] = { on.properties _ PutProp[on: on.properties, prop: prop, value: value]; }; GetCellTypeProp: PUBLIC PROC [from: Core.CellType, prop: ATOM] RETURNS [value: REF ANY _ NIL] = { value _ GetProp[from: from.properties, prop: prop]; }; PutCellTypeProp: PUBLIC PROC [on: Core.CellType, prop: ATOM, value: REF ANY _ NIL] = { on.properties _ PutProp[on: on.properties, prop: prop, value: value]; }; GetCellInstanceProp: PUBLIC PROC [from: CoreClasses.CellInstance, prop: ATOM] RETURNS [value: REF ANY _ NIL] = { value _ GetProp[from: from.properties, prop: prop]; }; PutCellInstanceProp: PUBLIC PROC [on: CoreClasses.CellInstance, prop: ATOM, value: REF ANY _ NIL] = { on.properties _ PutProp[on: on.properties, prop: prop, value: value]; }; END. XCorePropertiesImpl.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Bertrand Serlet, May 29, 1986 6:23:32 pm PDT Barth, January 28, 1986 3:32:00 pm PST Spreitzer, August 8, 1985 3:12:59 pm PDT Pradeep Sindhu February 7, 1986 5:06:44 pm PST Global table for putting property properties. Operations Registration Short Cuts Κ’˜codešœ™Kšœ Οmœ1™