VoiceUtilsImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Last modified by D. Swinehart, January 4, 1986 5:31:59 pm PST
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 ],
PupDefs USING [ AnyLocalPupAddress, PupAddress ],
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,
PupDefs,
RefTab,
Rope,
RPC,
UserCredentials,
UserProfile
EXPORTS VoiceUtils = {
OPEN IO;
Variables
pd: PUBLIC REF VoiceUtils.PDNEW[VoiceUtils.PD←[]];
Copies
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
WhereToReport: TYPE = VoiceUtils.WhereToReport;
WhereProc: TYPE = VoiceUtils.WhereProc;
Reporting and Suspending
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: REFNIL] = {
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[];
Associates Where atoms with print times.
Render null times harmless in printouts
origPrintTime: IOUtils.PFCodeProc ← NIL;
PrintTime: IOUtils.PFCodeProc = TRUSTED {
ts: ROPENIL;
i: INT ← 0;
zipTime: BasicTime.GMTLOOPHOLE[i];
WITH v: val SELECT FROM
time => {
SELECT v.value FROM
BasicTime.nullGMT => ts ← "<Doomsday>";
zipTime => ts←"<BigBang>";
ENDCASE;
IF ts#NIL THEN { stream.PutRope[ts]; RETURN; };
};
ENDCASE;
IF origPrintTime#NIL THEN origPrintTime[stream, val, format, char];
};
RName management
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: 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𡤌+('a-'A); ENDCASE};
RnameToRspec: PUBLIC PROC[name: VoiceUtils.Rname, defaultRegistry: ROPENIL] RETURNS [spec: VoiceUtils.Rspec] ={
j: INT𡤀
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]]]; };
Net Address Functions
OwnNetAddress: PUBLIC PROC RETURNS [netAddress: VoiceUtils.NetAddress] = TRUSTED {
pa: PupDefs.PupAddress;
pa ← PupDefs.AnyLocalPupAddress[[0,0]];
netAddress ← [net: pa.net, host: pa.host]; };
InstanceFromNetAddress: PUBLIC PROC[netAddress: VoiceUtils.NetAddress, suffix: ROPENIL]
RETURNS [instance: ROPE] = {
pa: PupDefs.PupAddress = [ net: [netAddress.net], host: [netAddress.host], socket: [a: 0, b: 0]];
instance ← Rope.Cat[Convert.RopeFromInt[pa.net, 8, FALSE], "#",
Convert.RopeFromInt[pa.host, 8, FALSE], "#", suffix];
};
Random Utilities
MakeAtom: PUBLIC PROC[rName: VoiceUtils.Rname, case: BOOLFALSE] RETURNS [ATOM] = {
case: if FALSE, case considered not important . . . all calls that expect results to match must use FALSE, since implementation is to convert rName to lower case.
if TRUE, leave rope alone and make the ATOM as is.
RETURN[Atom.MakeAtom[
IF ~case THEN LowerCaseRope[rName] ELSE rName]]; };
CommandTool parsing aid, to VoiceUtils
CmdOrToken: PUBLIC PROC[cmd: Commander.Handle, key: ROPE, default: ROPE]
If token read is "NIL" (or "nil"), return NIL -- allows arguments to be skipped.
RETURNS [value: ROPENIL] = {
value ← CommandTool.NextArgument[cmd];
IF value#NIL OR value.Equal["NIL", FALSE] THEN RETURN;
value ← UserProfile.Token[key: key, default: default];
};
Initialization
{
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."];
}.