<> <> <> DIRECTORY AMEvents USING [ CallDebugger ], Atom USING [ GetProp, MakeAtom, PropList, PutProp ], BasicTime USING [ GMT, Now, nullGMT, Unpack, Unpacked ], Commander USING [ CommandProc, GetProperty, Handle, Register ], CommandTool USING [ NextArgument ], Convert USING [ RopeFromInt ], IO, IOUtils USING [ CopyPFProcs, PFCodeProc, SetDefaultPFCodeProc, SetPFCodeProc ], ProcessProps USING [ GetPropList ], Pup USING [ nullSocket ], PupName USING [ NameLookup ], RefTab USING [ Create, Fetch, Ref, Store ], Rope USING [ Cat, Concat, Equal, Fetch, Length, MakeRope, ROPE, Size, SkipTo, Substr ], RPC USING [ MakeKey, EncryptionKey ], UserCredentials USING [ Get ], UserProfile USING [ Token ], VoiceUtils ; VoiceUtilsImpl: CEDAR PROGRAM IMPORTS AMEvents, Atom, BasicTime, Commander, CommandTool, Convert, IO, IOUtils, ProcessProps, PupName, RefTab, Rope, RPC, UserCredentials, UserProfile EXPORTS VoiceUtils = { OPEN IO; <> pd: PUBLIC REF VoiceUtils.PD _ NEW[VoiceUtils.PD_[]]; <> ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; WhereToReport: TYPE = VoiceUtils.WhereToReport; WhereProc: TYPE = VoiceUtils.WhereProc; <> <<>> WP: TYPE = REF WPRec; WPRec: TYPE = RECORD [ proc: WhereProc, fixedWhereData: REF, defaultIfNotFound: VoiceUtils.DNFProc_NIL ]; RegisterWhereToReport: PUBLIC PROC[ proc: WhereProc, where: WhereToReport, fixedWhereData: REF, defaultIfNotFound: VoiceUtils.DNFProc] = { Atom.PutProp[$ReportStreams, where, NEW[WPRec_[proc: proc, fixedWhereData: fixedWhereData, defaultIfNotFound: defaultIfNotFound]]]; }; FindWhere: PUBLIC PROC[where: WhereToReport, whereData: REF] RETURNS [s: IO.STREAM] = { wp: WP; IF where=NIL THEN RETURN[pd.sysOut]; wp _ NARROW[Atom.GetProp[$ReportStreams, where]]; IF wp=NIL THEN RETURN[pd.sysOut]; s_wp.proc[wp.fixedWhereData, whereData]; IF s#NIL THEN RETURN[s]; RETURN[IF s#NIL THEN s ELSE IF wp.defaultIfNotFound=NIL OR wp.defaultIfNotFound[where, whereData] THEN pd.sysOut ELSE NIL]; }; Report: PUBLIC PROC[remark: ROPE, where: WhereToReport, whereData: REF _NIL] = { reportS: STREAM _ FindWhere[where, whereData]; seconds: INT; IF remark=NIL OR reportS = NIL THEN RETURN; seconds _ LogTime[reportS, where]; reportS.PutF[" %02d: %s\n", int[seconds], rope[remark]]; -- wish I could affort looking up caller. }; ReportFR: PUBLIC PROC[remark: ROPE, where: WhereToReport, whereData: REF, a1, a2, a3: IO.Value] = { Report[IO.PutFR[remark, a1, a2, a3], where, whereData]; }; Problem: PUBLIC PROC[ remark: ROPE, where: WhereToReport, whereData: REF] = TRUSTED { IF remark=NIL THEN remark_"Unspecified problem"; Report[remark, where, whereData]; IF pd.attended THEN AMEvents.CallDebugger[remark]; }; ProblemFR: PUBLIC PROC[ remark: ROPE, where: WhereToReport, whereData: REF, a1, a2: IO.Value] = TRUSTED { Problem[IO.PutFR[remark, a1, a2], where, whereData]; }; CmdWhere: WhereProc = { pl: Atom.PropList _ ProcessProps.GetPropList[]; ch: Commander.Handle; IF pl=NIL THEN RETURN[NIL]; ch _ NARROW[Commander.GetProperty[$CommanderHandle, pl]]; IF ch=NIL THEN RETURN[NIL]; RETURN[ch.err]; }; SetAttended: Commander.CommandProc = { pd.attended _ TRUE; Report["Attended[TRUE]", $Cmd, NIL]; }; ClearAttended: Commander.CommandProc = { pd.attended _ FALSE; Report["Attended[FALSE]", $Cmd, NIL]; }; LogTime: PROC[s: IO.STREAM, where: ATOM] RETURNS [seconds: INT] = { oldT: REF BasicTime.Unpacked _ NARROW[RefTab.Fetch[logTimes, where].val]; now: BasicTime.GMT _ BasicTime.Now[]; nowU: BasicTime.Unpacked _ BasicTime.Unpack[now]; seconds _ nowU.second; nowU.second _ 0; nowU.secondsThisYear _ 0; IF oldT=NIL THEN { oldT_NEW[BasicTime.Unpacked]; []_RefTab.Store[logTimes, where, oldT]; }; IF nowU=oldT^ THEN RETURN; oldT^ _ nowU; s.PutF["%g\n", time[now]]; }; logTimes: RefTab.Ref _ RefTab.Create[]; <> <<>> <> origPrintTime: IOUtils.PFCodeProc _ NIL; PrintTime: IOUtils.PFCodeProc = TRUSTED { ts: ROPE _ NIL; i: INT _ 0; zipTime: BasicTime.GMT _ LOOPHOLE[i]; WITH v: val SELECT FROM time => { SELECT v.value FROM BasicTime.nullGMT => ts _ ""; zipTime => ts_""; ENDCASE; IF ts#NIL THEN { stream.PutRope[ts]; RETURN; }; }; ENDCASE; IF origPrintTime#NIL THEN origPrintTime[stream, val, format, char]; }; <> <<>> Registrize: PUBLIC PROC[name: ROPE] RETURNS [ROPE] = { dot: INT; IF name=NIL THEN RETURN[NIL]; dot_Rope.SkipTo[name, 0, "."]; IF dot=name.Length[] THEN name_Rope.Concat[name, DefaultRegistry[]]; RETURN[name]; }; DefaultRegistry: PROC RETURNS [registry: ROPE] = INLINE { name: ROPE=CurrentRName[]; dot: INT=Rope.SkipTo[name, 0, "."]; IF dot=name.Length[] THEN ERROR; RETURN[name.Substr[dot]]; }; CurrentRName: PUBLIC PROC RETURNS [ROPE] = { RETURN[UserCredentials.Get[].name]; }; CurrentPasskey: PUBLIC PROC[passwordText: ROPE] RETURNS [RPC.EncryptionKey] = { IF passwordText=NIL THEN passwordText_UserCredentials.Get[].password; RETURN[RPC.MakeKey[passwordText]]; }; LowerCaseRope: PUBLIC PROC[r: ROPE] RETURNS [ROPE] = { RETURN[Rope.MakeRope[base: r, size: r.Size[], fetch: LCFetch]]}; LCFetch: SAFE PROC[data: REF, index: INT] RETURNS [c: CHAR] = TRUSTED { SELECT (c_NARROW[data,ROPE].Fetch[index]) FROM IN ['A..'Z]=>c_c+('a-'A); ENDCASE}; <<>> RnameToRspec: PUBLIC PROC[name: VoiceUtils.Rname, defaultRegistry: ROPE_NIL] RETURNS [spec: VoiceUtils.Rspec] ={ j: INT_0; i: INT; WHILE (i_Rope.SkipTo[s: name, pos: j, skip: "."])#Rope.Size[name] DO j_i+1; ENDLOOP; IF j#0 THEN defaultRegistry_Rope.Substr[base: name, start: j] ELSE j_i+1; IF Rope.Size[defaultRegistry]=0 THEN RETURN[NIL]; spec_NEW[VoiceUtils.RspecBody_[simpleName: Rope.Substr[name, 0, j-1], registry: defaultRegistry]]; }; RspecToRname: PUBLIC PROC[spec: VoiceUtils.Rspec] RETURNS [name: VoiceUtils.Rname] = { RETURN[Rope.Concat[spec.simpleName, Rope.Concat[".", spec.registry]]]; }; RspecToSortName: PUBLIC PROC[spec: VoiceUtils.Rspec] RETURNS [name: ROPE] ={ RETURN[Rope.Concat[spec.registry, Rope.Concat[".", spec.simpleName]]]; }; MakeRName: PUBLIC PROC[name: ROPE, style: VoiceUtils.RNameStyle_ rNameDotLark] RETURNS[rName: ROPE] = { s1: VoiceUtils.Rspec = RnameToRspec[name, "lark"]; s2: VoiceUtils.Rspec = RnameToRspec[s1.simpleName]; isDotLark: BOOL = s1.registry.Equal["lark", FALSE]; RETURN[SELECT style FROM rName => RspecToRname[s1], nameDotLark => IF isDotLark THEN RspecToRname[s1] ELSE RspecToRname[s1].Cat[".lark"], rNameDotLark => IF s2#NIL THEN IF isDotLark THEN RspecToRname[s1] ELSE ERROR ELSE RspecToRname[s1].Cat[".lark"], ENDCASE=>NIL]; }; <<>> <> OwnNetAddress: PUBLIC PROC RETURNS [netAddress: VoiceUtils.NetAddress] = { netAddress _ NetAddressFromRope[netAddressRope: "ME"]; }; NetAddressFromRope: PUBLIC PROC[netAddressRope: ROPE] RETURNS [netAddress: VoiceUtils.NetAddress_VoiceUtils.nullNetAddress] = { IF netAddressRope=NIL THEN RETURN; netAddress _ PupName.NameLookup[name: netAddressRope, default: Pup.nullSocket]; }; InstanceFromNetAddress: PUBLIC PROC[netAddress: VoiceUtils.NetAddress, suffix: ROPE_NIL] RETURNS [instance: ROPE] = { instance _ Rope.Cat[Convert.RopeFromInt[netAddress.net, 8, FALSE], "#", Convert.RopeFromInt[netAddress.host, 8, FALSE], "#", suffix]; }; <<>> <> <<>> MakeAtom: PUBLIC PROC[rName: VoiceUtils.Rname, case: BOOL_FALSE] RETURNS [ATOM] = { <> <> RETURN[Atom.MakeAtom[ IF ~case THEN LowerCaseRope[rName] ELSE rName]]; }; <<>> <> <<>> CmdOrToken: PUBLIC PROC[cmd: Commander.Handle, key: ROPE, default: ROPE] <> RETURNS [value: ROPE_NIL] = { value _ CommandTool.NextArgument[cmd]; IF value#NIL OR value.Equal["NIL", FALSE] THEN RETURN; value _ UserProfile.Token[key: key, default: default]; }; <> { r: REF = Atom.GetProp[$Interfaces, $PrintTime]; origPrintTime _ IF r=NIL THEN IOUtils.SetPFCodeProc[IOUtils.CopyPFProcs[NIL], 't, PrintTime].previous ELSE NARROW[r, REF IOUtils.PFCodeProc]^; IF r=NIL THEN Atom.PutProp[$Interfaces, $PrintTime, NEW[IOUtils.PFCodeProc _ origPrintTime]]; []_IOUtils.SetDefaultPFCodeProc['t, PrintTime]; }; pd.ch _ NARROW[Commander.GetProperty[$CommanderHandle, ProcessProps.GetPropList[]]]; IF pd.ch#NIL THEN { pd.sysIn _ pd.ch.in; pd.sysOut _ pd.ch.out; }; RegisterWhereToReport[CmdWhere, $Cmd, NIL, NIL]; Commander.Register["Attended", SetAttended, "Break on errors"]; Commander.Register["Unattended", ClearAttended, "Log on errors, then muddle on."]; }. <> <> <> <<>>