<<>> <> <> <> <> <<>> <> <<>> DIRECTORY Atom USING [GetProp, PutProp, GetPName, MakeAtom], BasicTime USING [FromNSTime, GMT, Now, nullGMT, OutOfRange, ToNSTime], Convert USING [BoolFromRope, CardFromRope, Error, IntFromRope, TimeFromRope, RopeFromBool, RopeFromInt, RopeFromTimeRFC822], IO USING [card, PutFR1], LoganBerry USING [AttributeType, AttributeValue, Entry], RefTab USING [Create, Delete, EachPairAction, Fetch, Pairs, Ref, Store], Rope USING [Equal, ROPE], LoganBerryEntry; LoganBerryEntryImpl: CEDAR PROGRAM IMPORTS Atom, BasicTime, Convert, IO, RefTab, Rope EXPORTS LoganBerryEntry ~ BEGIN ROPE: TYPE ~ Rope.ROPE; Formatter: TYPE ~ LoganBerryEntry.Formatter; <> <> <<>> GetAttr: PUBLIC PROC [entry: LoganBerry.Entry, type: LoganBerry.AttributeType] RETURNS [LoganBerry.AttributeValue] = { <> FOR e: LoganBerry.Entry ¬ entry, e.rest WHILE e # NIL DO IF e.first.type = type THEN RETURN[e.first.value]; ENDLOOP; RETURN[NIL]; }; GetAllAttrs: PUBLIC PROC [entry: LoganBerry.Entry, type: LoganBerry.AttributeType] RETURNS [LIST OF LoganBerry.AttributeValue] ~ { <> result, lastr: LIST OF LoganBerry.AttributeValue ¬ NIL; FOR e: LoganBerry.Entry ¬ entry, e.rest WHILE e # NIL DO IF e.first.type = type THEN { IF lastr # NIL THEN {lastr.rest ¬ LIST[e.first.value]; lastr ¬ lastr.rest} ELSE result ¬ lastr ¬ LIST[e.first.value]; }; ENDLOOP; RETURN[result]; }; <<>> SetAttr: PUBLIC PROC [entry: LoganBerry.Entry, type: LoganBerry.AttributeType, value: LoganBerry.AttributeValue] RETURNS [] ~ { <> FOR e: LoganBerry.Entry ¬ entry, e.rest WHILE e # NIL DO IF e.first.type = type THEN { e.first.value ¬ value; }; ENDLOOP; }; ChangeAttr: PUBLIC PROC [entry: LoganBerry.Entry, type: LoganBerry.AttributeType, value: LoganBerry.AttributeValue] RETURNS [found: BOOLEAN] ~ { <> FOR e: LoganBerry.Entry ¬ entry, e.rest WHILE e # NIL DO IF e.first.type = type THEN { e.first.value ¬ value; RETURN[TRUE]; }; ENDLOOP; RETURN[FALSE]; }; AddAttr: PUBLIC PROC [entry: LoganBerry.Entry, type: LoganBerry.AttributeType, value: LoganBerry.AttributeValue] RETURNS [new: LoganBerry.Entry] ~ { <> e: LoganBerry.Entry ¬ entry; new ¬ LIST[[type, value]]; IF e # NIL THEN { WHILE e.rest # NIL DO e ¬ e.rest; ENDLOOP; e.rest ¬ new; new ¬ entry; }; RETURN[new]; }; RemoveAttr: PUBLIC PROC [entry: LoganBerry.Entry, type: LoganBerry.AttributeType, value: LoganBerry.AttributeValue] RETURNS [new: LoganBerry.Entry] ~ { <> prev: LoganBerry.Entry ¬ NIL; new ¬ entry; FOR e: LoganBerry.Entry ¬ entry, e.rest WHILE e # NIL DO IF (e.first.type = type) AND Rope.Equal[s1: e.first.value, s2: value, case: FALSE] THEN { IF prev # NIL THEN prev.rest ¬ e.rest ELSE new ¬ e.rest; EXIT; }; prev ¬ e; ENDLOOP; RETURN[new]; }; <> <<>> CopyEntry: PUBLIC PROC [entry: LoganBerry.Entry] RETURNS [new: LoganBerry.Entry] ~ { <> last: LoganBerry.Entry ¬ NIL; new ¬ NIL; FOR e: LoganBerry.Entry ¬ entry, e.rest WHILE e # NIL DO IF last # NIL THEN {last.rest ¬ LIST[[e.first.type, e.first.value]]; last ¬ last.rest} ELSE new ¬ last ¬ LIST[[e.first.type, e.first.value]]; ENDLOOP; RETURN[new]; }; <<>> ReverseEntry: PUBLIC PROC [entry: LoganBerry.Entry] RETURNS [new: LoganBerry.Entry] ~ { <> l1, l2, l3: LoganBerry.Entry ¬ NIL; IF entry = NIL THEN RETURN[NIL]; l3 ¬ entry; UNTIL (l1 ¬ l3) = NIL DO l3 ¬ l3.rest; l1.rest ¬ l2; l2 ¬ l1; ENDLOOP; RETURN[l2]; }; <<>> AppendEntries: PUBLIC PROC [e1, e2: LoganBerry.Entry] RETURNS [new: LoganBerry.Entry] = { <> IF e2=NIL THEN RETURN[e1]; IF e1=NIL THEN RETURN[e2]; new ¬ e1; FOR aL: LoganBerry.Entry ¬ e1, aL.rest WHILE aL#NIL DO IF aL.rest#NIL THEN LOOP; aL.rest ¬ e2; RETURN; ENDLOOP; ERROR; }; EntriesEqual: PUBLIC PROC [e1, e2: LoganBerry.Entry] RETURNS [BOOL] = { <> e2prime: LoganBerry.Entry; IF e1 = e2 THEN RETURN [TRUE]; -- Quick check <> e2prime ¬ NIL; FOR tail: LoganBerry.Entry ¬ e2, tail.rest WHILE tail # NIL DO e2prime ¬ CONS[tail.first, e2prime]; ENDLOOP; <> FOR tail: LoganBerry.Entry ¬ e1, tail.rest WHILE tail # NIL DO prev: LoganBerry.Entry ¬ NIL; FOR e: LoganBerry.Entry ¬ e2prime, e.rest WHILE e # NIL DO IF e.first.type = tail.first.type THEN { -- These two attribute pairs should compare IF e.first.value # tail.first.value AND NOT Rope.Equal[e.first.value, tail.first.value] THEN RETURN [FALSE]; IF prev = NIL THEN e2prime ¬ e.rest ELSE prev.rest ¬ e.rest; EXIT; }; prev ¬ e; REPEAT FINISHED => RETURN [FALSE]; ENDLOOP; ENDLOOP; <> RETURN [e2prime = NIL]; }; <> <> lastTimestamp: CARD ¬ 0; <<>> NewTimestamp: PUBLIC PROC [] RETURNS [ts: LoganBerryEntry.Timestamp] ~ { <> lastTimestamp ¬ MAX[lastTimestamp+1, BasicTime.ToNSTime[BasicTime.Now[]]]; ts ¬ IO.PutFR1["%010g", IO.card[lastTimestamp]]; }; <> <> <<>> I2V: PUBLIC PROC [i: INT] RETURNS [v: LoganBerry.AttributeValue ¬ NIL] ~ { v ¬ Convert.RopeFromInt[from: i, showRadix: FALSE ! Convert.Error => CONTINUE]; }; B2V: PUBLIC PROC [b: BOOL] RETURNS [v: LoganBerry.AttributeValue ¬ NIL] ~ { v ¬ Convert.RopeFromBool[b]; }; S2V: PUBLIC PROC [s: ROPE] RETURNS [v: LoganBerry.AttributeValue ¬ NIL] ~ { v ¬ s; }; A2V: PUBLIC PROC [a: ATOM] RETURNS [v: LoganBerry.AttributeValue ¬ NIL] ~ { v ¬ IF a # NIL THEN Atom.GetPName[a] ELSE NIL; }; T2V: PUBLIC PROC [t: BasicTime.GMT] RETURNS [v: LoganBerry.AttributeValue ¬ NIL] ~ { v ¬ Convert.RopeFromTimeRFC822[t ! Convert.Error => CONTINUE; BasicTime.OutOfRange => CONTINUE]; }; <<>> T2Ts: PUBLIC PROC [t: BasicTime.GMT] RETURNS [v: LoganBerry.AttributeValue] ~ { v ¬ IO.PutFR1["%010g", IO.card[BasicTime.ToNSTime[t]]]; }; <<>> <> V2B: PUBLIC PROC [v: LoganBerry.AttributeValue] RETURNS [b: BOOL ¬ FALSE] ~ { b ¬ Convert.BoolFromRope[v ! Convert.Error => CONTINUE]; }; V2I: PUBLIC PROC [v: LoganBerry.AttributeValue] RETURNS [i: INT ¬ -1] ~ { i ¬ Convert.IntFromRope[v ! Convert.Error => CONTINUE]; }; V2S: PUBLIC PROC [v: LoganBerry.AttributeValue] RETURNS [s: ROPE] ~ { RETURN[v]; }; V2T: PUBLIC PROC [v: LoganBerry.AttributeValue] RETURNS [t: BasicTime.GMT ¬ BasicTime.nullGMT] ~ { t ¬ Convert.TimeFromRope[v ! Convert.Error => CONTINUE]; }; V2A: PUBLIC PROC [v: LoganBerry.AttributeValue] RETURNS [a: ATOM] ~ { a ¬ IF v # NIL THEN Atom.MakeAtom[v] ELSE NIL; }; Ts2T: PUBLIC PROC [v: LoganBerry.AttributeValue] RETURNS [t: BasicTime.GMT] ~ { t ¬ BasicTime.FromNSTime[Convert.CardFromRope[v]]; }; <> formatterTable: RefTab.Ref; ParseError: PUBLIC ERROR [explanation: Rope.ROPE ¬ NIL] = CODE; RegisterFormatter: PUBLIC PROC [name: ATOM, formatter: Formatter] RETURNS [] ~ { <> IF formatter#NIL THEN [] ¬ RefTab.Store[formatterTable, name, formatter] ELSE [] ¬ RefTab.Delete[formatterTable, name]; }; <<>> GetFormatterByName: PUBLIC PROC [name: ATOM] RETURNS [formatter: Formatter] ~ { <> f: Formatter ¬ NARROW[RefTab.Fetch[formatterTable, name].val]; RETURN[f]; }; <<>> EnumerateFormatters: PUBLIC PROC [action: LoganBerryEntry.EachFormatterAction] RETURNS [BOOL] ~ { <> Action: RefTab.EachPairAction = { <<[key: ROPE, val: RefTab.Val] RETURNS [quit: BOOL _ FALSE]>> f: Formatter ¬ NARROW[val]; RETURN[action[f]]; }; RETURN[RefTab.Pairs[formatterTable, Action]]; }; <<>> <> formatterTable ¬ NARROW[Atom.GetProp[$LoganBerryEntry, $formatterTable]]; IF formatterTable = NIL THEN { formatterTable ¬ RefTab.Create[]; Atom.PutProp[$LoganBerryEntry, $formatterTable, formatterTable]; }; END.