VoiceUtilsImpl.mesa
Copyright © 1985, 1986 by Xerox Corporation. All rights reserved.
Last modified by D. Swinehart, May 9, 1986 11:50:39 am PDT
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;
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: 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𡤌+('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]]]; };
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];
};
Net Address Functions
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: ROPENIL]
RETURNS [instance: ROPE] = {
instance ← Rope.Cat[Convert.RopeFromInt[netAddress.net, 8, FALSE], "#",
Convert.RopeFromInt[netAddress.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."];
}.
Swinehart, May 9, 1986 11:06:55 am PDT
Convert to new Cedar communications package
changes to: DIRECTORY, VoiceUtilsImpl, OwnNetAddress, NetAddressFromRope, InstanceFromNetAddress