<> <> <> <> DIRECTORY CDProperties, CDPropertiesExtras, CD, CDPrivate, Atom, RefTab, Rope, TokenIO, ViewerTools USING [TiogaContents, TiogaContentsRec]; CDPropertiesImpl: CEDAR MONITOR IMPORTS CD, CDPrivate, CDProperties, Atom, RefTab, TokenIO EXPORTS CDProperties, CDPropertiesExtras = BEGIN Properties: TYPE = CD.Properties; PropertyProcs: TYPE = CDProperties.PropertyProcs; PropertyProcsRec: TYPE = CDProperties.PropertyProcsRec; atomTab: RefTab.Ref = RefTab.Create[]; -- contains atoms [maybe in future ref's] where properties hang <<--Registration>> propertyNameTab: RefTab.Ref = RefTab.Create[]; -- key: propertynames; value: PropertyProcs registrationTab: RefTab.Ref = RefTab.Create[]; -- contains registrationKeys RegisterProperty: PUBLIC ENTRY PROC [prop: REF, registrationKey: REF_NIL] RETURNS [first: BOOLEAN_TRUE] = <<--registers "prop" in a table; any program which wants to use an ATOM >> <<--as a "prop" gets to know if it is already in use. >> BEGIN val: RefTab.Val; found: BOOL; [found, val] _ RefTab.Fetch[x: registrationTab, key: prop]; -- returns a registration key IF found THEN { IF registrationKey#NIL AND registrationKey=val THEN RETURN [FALSE]; RETURN WITH ERROR CD.Error[doubleRegistration] } ELSE { pp: PropertyProcs _ NEW[PropertyProcsRec]; [] _ RefTab.Insert[propertyNameTab, prop, pp]; -- procs [] _ RefTab.Insert[registrationTab, prop, registrationKey]; -- registration }; END; <<--Usage>> HasNoCDProperties: ERROR = CODE; PutProp: PUBLIC PROC [onto: REF, prop: REF, val: REF] = <<--a NIL val removes the property>> BEGIN WITH onto SELECT FROM a: CD.ApplicationPtr => PutPropOnApplication[a, prop, val]; o: CD.ObPtr => IF o.p.inDirectory THEN PutPropOnObject[o, prop, val] ELSE ERROR HasNoCDProperties; d: CD.Design => PutPropOnDesign[d, prop, val]; t: CD.Technology => PutPropOnTechnology[t, prop, val]; <<--l: CD.LevelRef => PutPropOnLevelRef[l, prop, val];>> at: ATOM => PutPropOnAtom[at, prop, val]; ENDCASE => ERROR HasNoCDProperties END; GetProp: PUBLIC PROC [from: REF, prop: REF] RETURNS [REF] = <<--NIL if prop is not found>> BEGIN RETURN [WITH from SELECT FROM a: CD.ApplicationPtr => CDProperties.GetPropFromList[a.properties, prop], o: CD.ObPtr => CDProperties.GetPropFromList[o.properties, prop], d: CD.Design => CDProperties.GetPropFromList[d.properties, prop], t: CD.Technology => CDProperties.GetPropFromList[t.properties, prop], --l: CD.LevelRef => CDProperties.GetPropFromList[l.properties, prop], at: ATOM => GetPropFromAtom[at, prop], ENDCASE => ERROR HasNoCDProperties] END; <<--speed ups >> PutPropOnObject: PUBLIC ENTRY PROC [onto: CD.ObPtr, prop: REF, val: REF] = <<--a NIL val removes the property>> BEGIN IF val#NIL THEN onto.properties _ Atom.PutPropOnList[onto.properties, prop, val] ELSE onto.properties _ Atom.RemPropFromList[onto.properties, prop] END; PutPropOnApplication: PUBLIC ENTRY PROC[onto: CD.ApplicationPtr, prop: REF, val: REF] = <<--a NIL val removes the property>> BEGIN IF val#NIL THEN onto.properties _ Atom.PutPropOnList[onto.properties, prop, val] ELSE onto.properties _ Atom.RemPropFromList[onto.properties, prop] END; PutPropOnDesign: PUBLIC ENTRY PROC [onto: CD.Design, prop: REF, val: REF] = <<--a NIL val removes the property>> BEGIN IF val#NIL THEN onto.properties _ Atom.PutPropOnList[onto.properties, prop, val] ELSE onto.properties _ Atom.RemPropFromList[onto.properties, prop] END; PutPropOnTechnology: PUBLIC ENTRY PROC[onto: CD.Technology, prop: REF, val: REF] = <<--a NIL val removes the property>> BEGIN IF val#NIL THEN onto.properties _ Atom.PutPropOnList[onto.properties, prop, val] ELSE onto.properties _ Atom.RemPropFromList[onto.properties, prop] END; PutPropOnAtom: PUBLIC PROC[onto: ATOM, prop: REF, val: REF] = <<--a NIL val removes the property>> {PutPropOnRef[onto: onto, prop: prop, val: val]}; PutPropOnLevel: PUBLIC ENTRY PROC[onto: CD.Level, prop: REF, val: REF] = <<--a NIL val removes the property>> BEGIN CDPrivate.levels[onto].properties _ IF val#NIL THEN Atom.PutPropOnList[CDPrivate.levels[onto].properties, prop, val] ELSE Atom.RemPropFromList[CDPrivate.levels[onto].properties, prop]; END; PutPropOnRef: ENTRY PROC[onto: REF, prop: REF, val: REF] = <<--a NIL val removes the property>> <<--here onto MUST NOT be a Chipndale ref pointing to a record with properties,>> <<--since then the properties must be used, not the hash table>> BEGIN x: REF; found: BOOL; pp: REF CD.Properties; [found, x] _ RefTab.Fetch[x: atomTab, key: onto]; IF found THEN pp _ NARROW[x, REF CD.Properties] ELSE { IF prop=NIL THEN RETURN; pp _ NEW[CD.Properties_NIL]; [] _ RefTab.Store[x: atomTab, key: onto, val: pp]; }; IF prop#NIL THEN pp^ _ Atom.PutPropOnList[propList: pp^, prop: prop, val: val] ELSE { pp^ _ Atom.RemPropFromList[propList: pp^, prop: prop]; IF pp^=NIL THEN [] _ RefTab.Delete[x: atomTab, key: onto] } END; GetPropFromRef: ENTRY PROC [from: REF, prop: REF] RETURNS [REF] = <<--NIL if prop is not found>> <<--here from MUST NOT be a Chipndale ref pointing to a record with properties,>> <<--since then the properties must be used, not the hash table>> INLINE BEGIN x: REF; found: BOOL; pp: REF CD.Properties; [found, x] _ RefTab.Fetch[x: atomTab, key: from]; IF NOT found THEN RETURN[NIL]; pp _ NARROW[x, REF CD.Properties]; RETURN[Atom.GetPropFromList[propList: pp^, prop: prop]] END; GetPropFromObject: PUBLIC PROC [from: CD.ObPtr, prop: REF] RETURNS [REF] = <<--NIL if prop is not found>> {RETURN[CDProperties.GetPropFromList[from.properties, prop]]}; GetPropFromApplication: PUBLIC PROC [from: CD.ApplicationPtr, prop: REF] RETURNS [REF] = <<--NIL if prop is not found>> {RETURN[CDProperties.GetPropFromList[from.properties, prop]]}; GetPropFromDesign: PUBLIC PROC [from: CD.Design, prop: REF] RETURNS [REF] = <<--NIL if prop is not found>> {RETURN[CDProperties.GetPropFromList[from.properties, prop]]}; GetPropFromTechnology: PUBLIC PROC [from: CD.Technology, prop: REF] RETURNS [REF] = <<--NIL if prop is not found>> {RETURN[CDProperties.GetPropFromList[from.properties, prop]]}; GetPropFromLevel: PUBLIC PROC [from: CD.Level, prop: REF] RETURNS [REF] = <<--NIL if prop is not found>> {RETURN[CDProperties.GetPropFromList[CDPrivate.levels[from].properties, prop]]}; GetPropFromAtom: PUBLIC PROC [from: ATOM, prop: REF] RETURNS [REF] = <<--NIL if prop is not found>> {RETURN[GetPropFromRef[from: from, prop: prop]]}; <<--property procedures>> InstallProcs: PUBLIC ENTRY PROC [prop: REF, new: PropertyProcsRec] = <<--prop must be registered and yours>> <<--overwrites values for which new has non NIL entries>> BEGIN p: PropertyProcs _ FetchProcs[prop]; IF p#NIL THEN BEGIN IF new.exclusive THEN p.exclusive_TRUE; IF new.makeCopy#NIL THEN p.makeCopy _ new.makeCopy; IF new.internalWrite#NIL THEN p.internalWrite _ new.internalWrite; IF new.internalRead#NIL THEN p.internalRead _ new.internalRead; IF new.ownersData#NIL THEN p.ownersData _ new.ownersData; END END; FetchProcs: PUBLIC PROC [prop: REF] RETURNS [PropertyProcs] = <<--never copy PropertyProcs^; it can be extended by future calls of InstallProcs>> BEGIN x: REF; found: BOOL; [found: found, val: x] _ RefTab.Fetch[propertyNameTab, prop]; IF found THEN RETURN [NARROW[x, PropertyProcs]] ELSE RETURN [NIL] END; CopyVal: PUBLIC PROC [prop: REF, val: REF] RETURNS [valCopy: REF] = {valCopy _ val}; DontCopy: PUBLIC PROC [prop: REF, val: REF] RETURNS [nil: REF] = {nil _ NIL}; CopyProps: PUBLIC PROC [propList: Properties] RETURNS [copy: Properties_NIL] = BEGIN FOR l: Properties _ propList, l.rest WHILE l#NIL DO copy _ CopyItem[copy, l.first] ENDLOOP; END; CopyItem: PROC[list: CDProperties.Properties, item: Atom.DottedPair] RETURNS [newList: CDProperties.Properties] = BEGIN p: CDProperties.PropertyProcs = FetchProcs[item.key]; IF p#NIL AND p.makeCopy#NIL THEN { newList _ Atom.PutPropOnList[ propList: list, prop: item.key, val: p.makeCopy[prop: item.key, val: item.val] ]; } ELSE IF ISTYPE[item.key, ATOM] THEN WITH item.val SELECT FROM r: Rope.ROPE => { newList _ Atom.PutPropOnList[ propList: list, prop: item.key, val: r ]; }; at: ATOM => { newList _ Atom.PutPropOnList[ propList: list, prop: item.key, val: at ]; }; pl: CD.Properties => { newList _ Atom.PutPropOnList[ propList: list, prop: item.key, val: CopyProps[pl] ]; }; ri: REF INT => { newList _ Atom.PutPropOnList[ propList: list, prop: item.key, val: NEW[INT_ri^] ]; }; ENDCASE => newList _ list ELSE newList _ list; END; AppendLists: PUBLIC PROC [winner, looser: CDProperties.Properties] RETURNS [copy: CDProperties.Properties] = BEGIN copy _ CopyProps[looser]; FOR l: Properties _ winner, l.rest WHILE l#NIL DO copy _ CopyItem[copy, l.first] ENDLOOP; END; RopePWrite: PUBLIC PROC [prop: REF, val: REF] = BEGIN WITH val SELECT FROM r: Rope.ROPE => TokenIO.WriteRope[r]; at: ATOM => TokenIO.WriteRope[Atom.GetPName[at]]; ENDCASE => TokenIO.WriteRope["bad property value"]; END; AtomPWrite: PUBLIC PROC [prop: REF, val: REF] = BEGIN WITH val SELECT FROM at: ATOM => TokenIO.WriteAtom[at]; r: Rope.ROPE => TokenIO.WriteAtom[Atom.MakeAtom[r]]; ENDCASE => TokenIO.WriteAtom[$Bad]; END; IntPWrite: PUBLIC PROC [prop: REF, val: REF] = BEGIN WITH val SELECT FROM ri: REF INT => TokenIO.WriteInt[ri^]; rc: REF CARDINAL => TokenIO.WriteInt[rc^]; rn: REF NAT => TokenIO.WriteInt[rn^]; ENDCASE => TokenIO.WriteInt[0]; END; SomePWrite: PUBLIC PROC [prop: REF, val: REF] = BEGIN WITH val SELECT FROM at: ATOM => TokenIO.WriteAtom[at]; r: Rope.ROPE => TokenIO.WriteRope[r]; ri: REF INT => TokenIO.WriteInt[ri^]; rc: REF CARDINAL => TokenIO.WriteInt[rc^]; rn: REF NAT => TokenIO.WriteInt[rn^]; ENDCASE => TokenIO.WriteAtom[$Unknown]; END; RopePRead: PUBLIC PROC [prop: ATOM] RETURNS [val: REF] = BEGIN val _ TokenIO.ReadRope[] END; AtomPRead: PUBLIC PROC [prop: ATOM] RETURNS [val: REF] = BEGIN val _ TokenIO.ReadAtom[] END; IntPRead: PUBLIC PROC [prop: ATOM] RETURNS [val: REF] = BEGIN val _ NEW[INT_TokenIO.ReadInt[]] END; SomePRead: PUBLIC PROC [prop: ATOM] RETURNS [val: REF] = BEGIN t: TokenIO.Token _ TokenIO.ReadToken[]; SELECT t.kind FROM atom, int, rope => val _ t.ref; ENDCASE => val _ $Error; END; <<-------------------------->> <<--now some special properties>> TiogaPCopy: PROC [prop: REF, val: REF] RETURNS [copy: REF] = BEGIN contents: Rope.ROPE _ NIL; formatting: Rope.ROPE _ NIL; WITH val SELECT FROM t: ViewerTools.TiogaContents => { contents _ t.contents; formatting _ t.formatting}; r: Rope.ROPE => contents _ r; ENDCASE => contents _ "$Error"; copy _ NEW[ViewerTools.TiogaContentsRec_[contents: contents, formatting: formatting]] END; TiogaPWrite: PROC [prop: REF, val: REF] = BEGIN contents: Rope.ROPE _ NIL; formatting: Rope.ROPE _ NIL; WITH val SELECT FROM t: ViewerTools.TiogaContents => { contents _ t.contents; formatting _ t.formatting}; r: Rope.ROPE => contents _ r; ENDCASE => NULL; TokenIO.WriteRope[contents]; TokenIO.WriteRope[formatting]; END; TiogaPRead: PROC [prop: ATOM] RETURNS [val: REF] = BEGIN contents: Rope.ROPE _ TokenIO.ReadRope[]; formatting: Rope.ROPE _ TokenIO.ReadRope[]; val _ NEW[ViewerTools.TiogaContentsRec_[contents: contents, formatting: formatting]] END; <<>> [] _ CDProperties.RegisterProperty[$SignalName]; [] _ CDProperties.RegisterProperty[$InstanceName]; [] _ CDProperties.RegisterProperty[$Tioga]; CDProperties.InstallProcs[prop: $SignalName, new: CDProperties.PropertyProcsRec[ makeCopy: CDProperties.CopyVal, internalWrite: CDProperties.RopePWrite, internalRead: CDProperties.RopePRead ]]; CDProperties.InstallProcs[prop: $InstanceName, new: CDProperties.PropertyProcsRec[ makeCopy: CDProperties.CopyVal, internalWrite: CDProperties.RopePWrite, internalRead: CDProperties.RopePRead ]]; CDProperties.InstallProcs[prop: $Tioga, new: CDProperties.PropertyProcsRec[ makeCopy: TiogaPCopy, internalWrite: TiogaPWrite, internalRead: TiogaPRead ]]; END.