-- TalkerImpl.mesa
-- Paul Rovner, May 4, 1983 5:09 pm

DIRECTORY
BBSafety USING [Mother],
CedarSnapshot USING [Register, AddSpaceProc, After],
Commander USING [Register, CommandProc],
Containers USING [ChildXBound, ChildYBound],
Labels USING [Label, Create, Set],
Icons USING [IconFlavor, NewIconFromFile],
MBQueue USING [Queue, Create, CreateMenuEntry, QueueClientAction],
Interpreter USING [EvaluateToRope],
IO USING [GetId, PutRope, STREAM, time, char, Put, EndOfStream, RIS],
Menus USING[CreateMenu, InsertMenuEntry, Menu, MenuProc],
Process USING [Detach],
Rope USING[ROPE, Concat, Find, Cat, Equal],
RPC USING[MakeKey],
TalkerOps USING[], -- EXPORTS ONLY
 TalkerOpsRpcControl USING[InterfaceRecord, ImportNewInterface, ExportInterface,
UnexportInterface],
TalkerPrivate USING[Handle, ConversationObject, Conversant, ConversantObject, Puller,
SendOutGoingLines, JoinConversation, ComputeStatus, RemakeStatusLabel,
PaintLine, KillConversation, IsViewer, BlinkOff, FindConversant,
JoinConversationHit, ShowStatusHit, LowerRope,
RemoveConversantFromOtherConversations],
TypeScript USING [Create, TS],
UserCredentials USING [GetUserCredentials],
VFonts USING [CharWidth, FontHeight],
ViewerClasses USING [Viewer],
ViewerEvents USING [EventProc, RegisterEventProc, ViewerEvent],
ViewerIO USING [CreateViewerStreams],
ViewerOps USING [CreateViewer],
Volume USING [GetType, systemID];

TalkerImpl: CEDAR MONITOR -- protects "conversations" list
 IMPORTS BBSafety, CedarSnapshot, Commander, Containers, Icons, Interpreter, IO, Labels,
MBQueue, Menus, Process, Rope, RPC, TalkerOpsRpcControl, TalkerPrivate, TypeScript,
UserCredentials, VFonts, ViewerEvents, ViewerIO, ViewerOps, Volume
EXPORTS TalkerOps, TalkerPrivate
= BEGIN OPEN Rope, TalkerPrivate;

-- VARIABLES
 conversations: LIST OF Handle ← NIL;
talkerIcon: Icons.IconFlavor = Icons.NewIconFromFile["Talker.icons", 0];
viewerEventQueue: MBQueue.Queue = MBQueue.Create[];

-- PROCEDURES
-- ******* interface procedures

-- registered with Commander
 Talk: Commander.CommandProc = {
--PROC [cmd: Commander.Handle]
 h: Handle ← NIL;
cls: IO.STREAM = IO.RIS[cmd.commandLine];
DO
{conversantName: ROPE ← NIL;
conversantName ← cls.GetId[ ! IO.EndOfStream => GOTO endOfStream;
ANY => CONTINUE];
IF conversantName # NIL
THEN {IF Find[conversantName, "."] = -1
THEN conversantName ← Concat[conversantName, ".pa"];
IF Rope.Equal[conversantName, GetLocalName[], FALSE] THEN GOTO badConversant;
IF h = NIL
THEN [h, ] ← FindConversation[conversantName
! ANY => GOTO badConversant]
ELSE JoinConversation[h, conversantName
! ANY => GOTO badConversant];
RemoveConversantFromOtherConversations[h, conversantName
! ANY => GOTO badConversant];
EXITS badConversant => cmd.out.PutRope
[Cat[" ***Talker error: no such conversant: ",
conversantName,
"\n"] ! ANY => CONTINUE]};
EXITS endOfStream => EXIT}
ENDLOOP;
IF h # NIL THEN RemakeStatusLabel[h];
}; -- end Talk

Talkable: Commander.CommandProc = {
--PROC [cmd: Commander.Handle]
 cls: IO.STREAM = IO.RIS[cmd.commandLine];
DO
{conversantName: ROPE ← NIL;
conversantName ← cls.GetId[ ! IO.EndOfStream => GOTO endOfStream;
ANY => CONTINUE];
IF conversantName # NIL
THEN {IF Find[conversantName, "."] = -1
THEN conversantName ← Concat[conversantName, ".pa"];
IF Rope.Equal[conversantName, GetLocalName[], FALSE] THEN GOTO badConversant;
[] ← TalkerOpsRpcControl.ImportNewInterface
[interfaceName: [instance: LowerRope[conversantName]]
! ANY => GOTO badConversant];
EXITS badConversant => cmd.out.PutRope
[Cat["  ",
conversantName,
" not registered as a conversant\n"]
! ANY => CONTINUE]};
EXITS endOfStream => EXIT}
ENDLOOP;
}; -- end Talkable

-- RPC magic. These are the only procs called by remote clients.
 PutMyLine: PUBLIC PROC[myName: ROPE, line: ROPE] = {
h: Handle ← NIL;
rePaintStatus: BOOL ← FALSE;
[h, rePaintStatus] ← FindConversation[myName ! ANY => CONTINUE];
IF h = NIL THEN RETURN;
PaintLine[h, Cat[myName, ": ", line]];
IF rePaintStatus THEN RemakeStatusLabel[h];
}; -- end PutMyLine

JoinWith: PUBLIC PROC[myName: ROPE, newConversant: ROPE] = {
h: Handle ← NIL;
rePaintStatus: BOOL ← FALSE;
IF Equal[newConversant, myName, FALSE] THEN RETURN;
[h, rePaintStatus] ← FindConversation[myName ! ANY => CONTINUE];
IF h = NIL THEN RETURN;
JoinConversation[h, newConversant];
RemakeStatusLabel[h];
RemoveConversantFromOtherConversations[h, newConversant];
RemoveConversantFromOtherConversations[h, myName];
}; -- end JoinWith

DealMeOut: PUBLIC PROC[myName: ROPE] = {
RemoveConversantFromOtherConversations[NIL, myName];
}; -- end DealMeOut

Cancel: PUBLIC PROC[conversant: ROPE] RETURNS[ROPE] = {
result: ROPE;
errorRope: ROPE;
noResult: BOOL;
motherRope: ROPE;
inner: PROC = {
[result, errorRope, noResult] ← Interpreter.EvaluateToRope[conversant];
};
motherRope ← BBSafety.Mother[inner];
IF motherRope # NIL THEN RETURN[Cat["Mother: ", motherRope]]
ELSE IF errorRope # NIL THEN RETURN[Cat["Error: ", errorRope]]
ELSE IF noResult THEN RETURN["NoResult"]
ELSE RETURN[result];
};

Horse: PROC[n, r: ROPE] RETURNS[ans: ROPE ← NIL] = {
ir: TalkerOpsRpcControl.InterfaceRecord;
IF Find[n, "."] = -1 THEN n ← Cat[n, ".pa"];
ir ← TalkerOpsRpcControl.ImportNewInterface[interfaceName: [instance: LowerRope[n]]];
 TRUSTED{ans ← ir.Cancel[r]};
};


-- ******* menu and event procedures

DisconnectHit: Menus.MenuProc = {
-- [parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
 h: Handle ← NARROW[clientData, Handle];
KillConversation[h];
RemakeStatusLabel[h];
}; -- end DisconnectHit
VEBundle: TYPE = RECORD[viewer: ViewerClasses.Viewer, event: ViewerEvents.ViewerEvent];
ViewerEvent: ViewerEvents.EventProc = {
PROC [viewer: ViewerClasses.Viewer, event: ViewerEvents.ViewerEvent];
MBQueue.QueueClientAction
[viewerEventQueue,
DoViewerEvent,
NEW[VEBundle ← [viewer, event]]];
};
DoViewerEvent: ENTRY PROC[r: REF ANY] = {
ENABLE UNWIND => NULL;
event: ViewerEvents.ViewerEvent;
viewer: ViewerClasses.Viewer;
[viewer: viewer, event: event] ← NARROW[r, REF VEBundle]^;
SELECT event FROM
open =>
{p: PROC[h: Handle] RETURNS[stop: BOOL ← FALSE] =
{IF IsViewer[h, viewer] THEN BlinkOff[h]};
[] ← InnerEnumerateConversations[p];
};
destroy =>
{p: PROC[h: Handle] RETURNS[stop: BOOL ← FALSE] =
{IF IsViewer[h, viewer]
THEN {
prev: LIST OF Handle ← NIL;
KillConversation[h];
FOR c: LIST OF Handle ← conversations, c.rest UNTIL c = NIL
DO
IF c.first = h
THEN
{IF prev = NIL
THEN conversations ← c.rest
ELSE prev.rest ← c.rest;
EXIT}
ELSE prev ← c;
ENDLOOP;
stop ← TRUE;
};
};
[] ← InnerEnumerateConversations[p];
};
ENDCASE
}; -- end DoViewerEvent
-- ******* construction procedures

FindConversation: ENTRY PROC[conversantName: ROPE]
RETURNS[h: Handle ← NIL, rePaintStatus: BOOL ← FALSE] = {
-- find a conversation with the specified conversant or create a new one
 ENABLE UNWIND => NULL;
p: PROC[ch: Handle] RETURNS[stop: BOOL ← FALSE] =
{IF FindConversant[ch, conversantName] # NIL THEN stop ← TRUE};
h ← InnerEnumerateConversations[p];
IF h # NIL
THEN RETURN[h, FALSE]
ELSE RETURN[NewConversant[conversantName], TRUE];
}; -- end FindConversation

NewConversant: INTERNAL PROC[conversantName: ROPE] RETURNS[handle: Handle] = {
container: ViewerClasses.Viewer ← NIL;
menu: Menus.Menu ← Menus.CreateMenu[lines: 1];
ymax: INTEGER ← 0;
emWidth: INTEGER ← VFonts.CharWidth['M];
emHeight: INTEGER ← VFonts.FontHeight[];
ir: TalkerOpsRpcControl.InterfaceRecord
← TalkerOpsRpcControl.ImportNewInterface
[interfaceName: [instance: LowerRope[conversantName]]];

AddLabel: PROC
[indent: INTEGER ← 0, trail: INTEGER ← 2]
RETURNS [label: Labels.Label] = {
-- adds a new label to the container at the given position
 -- returns the button and new position
 labelMaxChars: NAT ← 64;
x: INTEGER ← 0;
y: INTEGER ← ymax + 2;
w: INTEGER ← emWidth * labelMaxChars;
h: INTEGER ← emHeight;
label ← Labels.Create
[[name: " ", parent: container, border: FALSE,
wx: x + indent, wy: y, ww: w, wh: h]];
x ← label.wx + label.ww - 1;
y ← label.wy + label.wh - 1 + trail;
IF y > ymax THEN ymax ← y;
};

-- START NewConversant HERE
 handle ← NEW[ConversationObject
← [conversants: CONS[NEW[ConversantObject
← [ir: ir,
conversantName: conversantName]],
NIL
],
mbq: MBQueue.Create[],
localName: GetLocalName[]
]
];

-- build up the menu
 Menus.InsertMenuEntry
[menu: menu,
entry: MBQueue.CreateMenuEntry
[q: handle.mbq,
name: "Disconnect",
proc: DisconnectHit,
clientData: handle]];

Menus.InsertMenuEntry
[menu: menu,
entry: MBQueue.CreateMenuEntry
[q: handle.mbq,
name: "JoinConversation",
proc: JoinConversationHit,
clientData: handle]];

Menus.InsertMenuEntry
[menu: menu,
entry: MBQueue.CreateMenuEntry
[q: handle.mbq,
name: "ShowStatus",
proc: ShowStatusHit,
clientData: handle]];

container ← ViewerOps.CreateViewer
[flavor: $Container,
info: [name: Rope.Concat[conversantName, " conversation" ],
column: left,
menu: menu,
scrollable: FALSE,
icon: talkerIcon]];
handle.container ← container;

-- status area
 handle.statusLabel ← AddLabel[];
Labels.Set[handle.statusLabel, ComputeStatus[handle]];

-- typescript area
 ymax ← ymax + 2;
handle.ts ← TypeScript.Create
[info: [parent: container, wx: 0, wy: ymax, ww: 64, wh: 64],
paint: FALSE];
[handle.tsInStream, handle.tsOutStream]
← ViewerIO.CreateViewerStreams[name: NIL, viewer: handle.ts];
Containers.ChildXBound[container, handle.ts];
Containers.ChildYBound[container, handle.ts];

conversations ← CONS[handle, conversations];

TRUSTED {Process.Detach[FORK Puller[handle]]};

TRUSTED {Process.Detach[FORK SendOutGoingLines[handle, handle.conversants.first]]};

handle.tsOutStream.Put[IO.time[], IO.char['\n]];

}; -- end NewConversant



-- ******* enumeration procedures

NewConversation: ENTRY PROC[h: Handle] = {
ENABLE UNWIND => NULL;
conversations ← CONS[h, conversations];
}; -- end NewConversation

EnumerateConversations: PUBLIC PROC[proc: PROC[Handle] RETURNS[stop: BOOL]]
RETURNS[Handle] = {
FOR h: Handle ← FirstConversation[], NextConversation[h] UNTIL h = NIL
DO IF proc[h] THEN RETURN[h];
ENDLOOP;
RETURN[NIL];
}; -- end EnumerateConversations

InnerEnumerateConversations: INTERNAL PROC[proc: PROC[Handle] RETURNS[stop: BOOL]]
RETURNS[ans: Handle ← NIL] = {
FOR cl: LIST OF Handle ← conversations, cl.rest UNTIL cl = NIL
DO IF proc[cl.first] THEN RETURN[cl.first];
ENDLOOP;
}; -- end InnerEnumerateConversations

FirstConversation: ENTRY PROC RETURNS[Handle] = {
ENABLE UNWIND => NULL;
IF conversations = NIL THEN RETURN[NIL];
RETURN[conversations.first];
}; -- end FirstConversation

NextConversation: ENTRY PROC[h: Handle] RETURNS[Handle] = {
ENABLE UNWIND => NULL;
FOR cl: LIST OF Handle ← conversations, cl.rest UNTIL cl = NIL
DO IF cl.first = h THEN {IF cl.rest # NIL THEN RETURN[cl.rest.first] ELSE RETURN[NIL]};
ENDLOOP;
RETURN[NIL];
}; -- end NextConversation
CheckpointProc: PROC[p: CedarSnapshot.AddSpaceProc] = {
Finalize[];
};
RollbackProc: PROC[situation: CedarSnapshot.After] = {
Initialize[];
};
Initialize: ENTRY PROC = {
ENABLE UNWIND => NULL;
IF punt THEN punt ← FALSE ELSE RETURN;
First, establish the user at this Cedar workstation as an available conversant.
TRUSTED{
TalkerOpsRpcControl.ExportInterface
[interfaceName: [instance: LowerRope[GetLocalName[]]],
user: GetLocalName[],
password: RPC.MakeKey[UserCredentials.GetUserCredentials[].password]
! ANY => {punt ← TRUE; CONTINUE}]};
IF NOT punt THEN {
Next, register a "talk person" command with Commander
Commander.Register
["Talkable",
Talkable,
"Ask if specified Cedar users are registered as Talk conversants"];
Commander.Register
["Talk",
Talk,
"Create an interactive, 2-way typescript with other Cedar users"];
};
};
Finalize: ENTRY PROC = {
ENABLE UNWIND => NULL;
IF punt THEN RETURN ELSE punt ← TRUE;
TRUSTED{TalkerOpsRpcControl.UnexportInterface[! ANY => CONTINUE]};
};
LocalNameChanged: PROC[oldName: REF ANY] = {
Finalize[];
Initialize[];
};
GetLocalName: PUBLIC PROC RETURNS[ROPE] = {
ln: ROPE ← UserCredentials.GetUserCredentials[].name;
IF Find[ln, "."] = -1 THEN ln ← Concat[ln, ".pa"];
IF Equal[localName, ln, FALSE]
THEN
RETURN[localName]
ELSE {
MBQueue.QueueClientAction
[viewerEventQueue,
LocalNameChanged,
localName];
localName ← ln;
RETURN[localName];
};
};
-- START HERE
punt: BOOL ← TRUE; -- FALSE after start iff ExportInterface succeeded and is in effect
localName: ROPE ← UserCredentials.GetUserCredentials[].name;
IF Find[localName, "."] = -1 THEN localName ← Concat[localName, ".pa"];
IF Volume.GetType[Volume.systemID] = normal
THEN {
Initialize[];
Next, register "EventProc" with Viewers
[] ← ViewerEvents.RegisterEventProc[proc: ViewerEvent, event: open, filter: $Container];
[] ← ViewerEvents.RegisterEventProc[proc: ViewerEvent, event: destroy, filter: $Container];
Next, register with CedarSnapshot
TRUSTED {CedarSnapshot.Register[c: CheckpointProc, r: RollbackProc]};
};
END.