
<<edited by Teitelman, April 15, 1983 9:51 am>>
DIRECTORY
Ascii USING [DEL],
Atom USING [GetPName],
IO USING [CharsAvail, GetChar, char, atom, PutChar, PutF, PutRope, ROPE, rope, STREAM, UserAborted],
Menus USING [AppendMenuEntry, ClickProc, CreateEntry, FindEntry, GetLine, GetNumberOfLines, Menu, MenuEntry, MenuLine, 
ReplaceMenuEntry],
MessageWindow USING [Append, Confirm, Clear, Blink],
Process USING [EnableAborts, SetTimeout, MsecToTicks],
Rope USING [Concat, Fetch, Upper],
SafeStorage USING [NarrowRefFault],
UserExec USING [ExecHandle, CheckForAbort, UserAbort, UserAborted, Viewer, ReleaseStreams, AcquireStreams],
UserExecPrivate USING [ResponseRecord, ExecPrivateRecord, BlinkIcon],
ViewerAbort USING [UserAbort, ResetUserAbort],
ViewerClasses USING [Column],
ViewerOps USING [PaintViewer, FetchProp, AddProp]
; 

UserExecConfirmImpl: CEDAR MONITOR LOCKS response USING response: REF ResponseRecord 

IMPORTS Atom, IO, Menus, MessageWindow, Process, Rope, SafeStorage, UserExec, ViewerAbort, ViewerOps, UserExecPrivate   

EXPORTS UserExec  

= BEGIN OPEN IO; 
<<types>>
Viewer: TYPE = UserExec.Viewer;
ClickProc: TYPE = Menus.ClickProc;
<<connecting concrete and opaque types>>
ExecPrivateRecord: PUBLIC TYPE = UserExecPrivate.ExecPrivateRecord;
ResponseRecord: PUBLIC TYPE = UserExecPrivate.ResponseRecord;
<<Manipulating ResponseRecord>>
SetupAskUser: PUBLIC PROC [viewer: Viewer, keyList: LIST OF ATOM _ NIL] = {
lineToUse: Menus.MenuLine _ Menus.GetNumberOfLines[viewer.menu];
response: REF UserExecPrivate.ResponseRecord = GetResponseRecord[viewer]; 
IF response.menuCount = 0 THEN
{
IF keyList = NIL THEN keyList _ defaultKeyList;
ResetUserResponse[viewer];
IF lineToUse = 0 THEN ERROR;
WHILE (lineToUse _ lineToUse - 1) >= 0 DO
IF Menus.GetLine[viewer.menu, lineToUse] # NIL THEN EXIT;  -- workaround, if add yes/no to empty line (e.g. to action area that has 
been aborted), then get error when try to remove them. 
ENDLOOP;
FOR l: LIST OF ATOM _ keyList, l.rest UNTIL l = NIL DO
Menus.AppendMenuEntry[menu: viewer.menu, line: lineToUse, entry: Menus.CreateEntry[name: Atom.GetPName[l.first], proc: 
ResponseProc, clientData: l.first, fork: FALSE]];
ENDLOOP;
ViewerOps.PaintViewer[viewer: viewer, hint: menu];
};
response.menuCount _ response.menuCount + 1;
};

FinishAskUser: PUBLIC PROC [viewer: Viewer, keyList: LIST OF ATOM _ NIL] = {
response: REF UserExecPrivate.ResponseRecord = GetResponseRecord[viewer]; 
IF keyList = NIL THEN keyList _ defaultKeyList;
ResetUserResponse[viewer];
IF response.menuCount = 0 THEN RETURN;
response.menuCount _ response.menuCount - 1;
IF response.menuCount = 0 THEN
{entry: Menus.MenuEntry;
FOR l: LIST OF ATOM _ keyList, l.rest UNTIL l = NIL DO
IF (entry _ Menus.FindEntry[viewer.menu, Atom.GetPName[l.first]]) # NIL THEN Menus.ReplaceMenuEntry[menu: viewer.menu, oldEntry: 
entry];
ENDLOOP;
ViewerOps.PaintViewer[viewer: viewer, hint: menu];
};
};

GetUserResponse: PUBLIC PROC [viewer: Viewer] RETURNS [hasResponded: BOOL, value: ATOM] =  
{DoIt: ENTRY PROC [response: REF ResponseRecord] =
{hasResponded _ response.hasResponded;
value _ response.value;
};
response: REF UserExecPrivate.ResponseRecord = GetResponseRecord[viewer]; 
DoIt[response];
}; 

SetUserResponse: PUBLIC PROC [viewer: Viewer, value: ATOM] = {
DoIt: ENTRY PROC [response: REF ResponseRecord] = {
response.hasResponded _ TRUE;
response.value _ value;
NOTIFY response.HasResponded; -- in case exec is waiting for confirmation, this will wake it up.
};
response: REF UserExecPrivate.ResponseRecord = GetResponseRecord[viewer]; 
DoIt[response];
};

ResetUserResponse:  PUBLIC PROC [viewer: Viewer] = {
DoIt: ENTRY PROC [response: REF ResponseRecord] = {
response.hasResponded _ FALSE;
response.value _ NIL;
};
response: REF UserExecPrivate.ResponseRecord = GetResponseRecord[viewer]; 
DoIt[response];
ViewerAbort.ResetUserAbort[viewer];
};

<<internal procedure. returns ResponseRecord for viewer, or creates one if none there.>>
GetResponseRecord: PROC [viewer: Viewer] RETURNS[response: REF UserExecPrivate.ResponseRecord] = {
response _ NARROW[ViewerOps.FetchProp[viewer: viewer, prop: $Response] ! SafeStorage.NarrowRefFault => CONTINUE]; 
IF response = NIL THEN TRUSTED { 
response _ NEW[ResponseRecord _ []];
Process.EnableAborts[@response.HasResponded];
ViewerOps.AddProp[viewer: viewer, prop: $Response, val: response];
};
};
<<Responding: Askuser>>
defaultKeyList: LIST OF ATOM _ LIST[$Yes, $No];

AskUser: PUBLIC PROC [msg: ROPE, timeout: INT _ -1, defaultKey: ATOM _ NIL, exec: UserExec.ExecHandle, viewer: Viewer _ NIL, 
keyList: LIST OF ATOM _ defaultKeyList] RETURNS[value: ATOM] = {
IF keyList = NIL THEN keyList _ defaultKeyList;
IF exec = NIL AND viewer = NIL THEN
{IF keyList = defaultKeyList THEN RETURN[IF MessageWindow.Confirm[msg] THEN $Yes ELSE $No]
ELSE RETURN[NIL];
};
{
ENABLE UNWIND => {
FinishAskUser[viewer, keyList];
MessageWindow.Clear[];
IF exec # NIL THEN UserExec.ReleaseStreams[exec];
};
Inform: PROC [message: ROPE] = {
IF exec # NIL THEN { 
out.PutF["*n*m%g ? *u", rope[msg]];
MessageWindow.Append[message: message, clearFirst: TRUE];
}
ELSE {
MessageWindow.Append[message: msg, clearFirst: TRUE]; MessageWindow.Append[message: message];
};
};
RespondedViaButton: PROC = {
hasResponded: BOOL;
UserExec.CheckForAbort[exec];  -- user might have clicked STOP
[hasResponded, value] _ GetUserResponse[viewer];
IF hasResponded THEN
{IF exec # NIL THEN out.PutF["%g\n", atom[value]]}
ELSE ERROR;
};
TimedOut: PROC = {
hasResponded: BOOL;
[hasResponded, value] _ GetUserResponse[viewer];
IF NOT hasResponded THEN value _ defaultKey;
IF exec # NIL THEN out.PutF["...%g*s\n", atom[value]]
ELSE MessageWindow.Append[message: Rope.Concat["...", Atom.GetPName[value]], clearFirst: TRUE]; 
};
SomethingTyped: PROC RETURNS [BOOL] = {
IF exec # NIL THEN UserExec.CheckForAbort[exec];
RETURN[in.CharsAvail[]];
};
Aborted: PROC RETURNS [BOOL]  = {
IF exec # NIL THEN UserExec.CheckForAbort[exec]
ELSE IF ViewerAbort.UserAbort[viewer] THEN ERROR IO.UserAborted[viewer];
RETURN[FALSE];
};
response: REF UserExecPrivate.ResponseRecord; 
in, out: STREAM;
private: REF UserExecPrivate.ExecPrivateRecord;

<<main body of Askuser>>
IF exec # NIL THEN {
viewer _ exec.viewer;
[in, out] _ UserExec.AcquireStreams[exec];
UNTIL in.backingStream = NIL DO
in _ in.backingStream;
ENDLOOP;
private _ exec.privateStuff;
};
response _ GetResponseRecord[viewer]; 
SetupAskUser[viewer, keyList];
IF viewer # NIL AND viewer.iconic THEN UserExecPrivate.BlinkIcon[viewer];
IF exec = NIL OR in.CharsAvail[] THEN { -- user has typed ahead. dont want to mess up his typeahead, so can only response by 
button. 
IF exec = NIL THEN Inform[" (respond using menu)"]
ELSE {
Inform["Respond using menu only"];
MessageWindow.Blink[];
};
SELECT WaitForResponse[response, timeout, Aborted] FROM
responded => RespondedViaButton[];
timedout => TimedOut[];
other => NULL;
ENDCASE => ERROR;
GOTO Out;
};
Inform[IF private.execState = notListening OR private.execState = dormant THEN "Respond using menu" ELSE "Respond using menu or 
keyboard"];
<<user has not typed ahead. check for confirmation via typein as well as buttons.>>
DO
SELECT WaitForResponse[response, timeout, SomethingTyped] FROM
responded => {RespondedViaButton[]; GOTO Out};
timedout => {TimedOut[]; GOTO Out};
other => {  -- something typed
DO
char: CHARACTER;
char _ in.GetChar[];
timeout _ -1;  -- once user types a character, don't timeout. 
IF char = ' THEN {out.PutChar[char]; LOOP};  -- primarily so user can type a character and then think without timing out
IF char = Ascii.DEL THEN {IF keyList = defaultKeyList THEN char _ 'N};
FOR l: LIST OF ATOM _ keyList, l.rest UNTIL l = NIL DO
r: ROPE = Atom.GetPName[l.first];
IF char = '\n  -- matches first key --  OR Rope.Upper[Rope.Fetch[r, 0]] = Rope.Upper[char] THEN {
out.PutRope[r];
out.PutChar['\n];
value _ l.first;
GOTO Out;
};
REPEAT
FINISHED => {  -- didn't match
out.PutChar[char];
out.PutF["*n*mType one of: "];
FOR l: LIST OF ATOM _ keyList, l.rest UNTIL l = NIL DO
out.PutF["%g, ", IO.char[Rope.Fetch[Atom.GetPName[l.first], 0]]];
ENDLOOP;
out.PutF["or use the corresponding menu button\n\n*u"];
Inform["Respond using menu or keyboard"];
};
ENDLOOP;
EXIT;  
ENDLOOP; 
};
ENDCASE => ERROR;
ENDLOOP;
EXITS
Out => {
FinishAskUser[viewer, keyList];
MessageWindow.Clear[];
IF exec # NIL THEN UserExec.ReleaseStreams[exec];
};
};
}; 

WaitForResponse: ENTRY PROC [response: REF ResponseRecord, timeout: INT, pred: PROC RETURNS [BOOL] _ NIL] RETURNS [whatHappened] = {
ENABLE UNWIND => NULL;
elapsedTime: INT _ 0;
TRUSTED {Process.SetTimeout[@response.HasResponded, Process.MsecToTicks[100]]};
UNTIL response.hasResponded DO
WAIT response.HasResponded;
IF pred # NIL AND pred[] THEN RETURN[other];
IF timeout # -1 AND elapsedTime > timeout THEN RETURN[timedout];
elapsedTime _ elapsedTime + 100;
ENDLOOP;
IF pred # NIL AND pred[] THEN RETURN[other]  -- basically to allow pred to check for aborting
ELSE RETURN[responded];
};

ResponseProc: ClickProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: MouseButton _ red, shift, control: BOOL _ 
FALSE] -- = {
viewer: Viewer = NARROW[parent];
SetUserResponse[viewer, NARROW[clientData, ATOM]];
};

whatHappened: TYPE = {responded, timedout, other};

END.
<<Edited on January 28, 1983 5:49 pm, by Teitelman>>
<<removed file correction stuff>>
<<changes to: whatHappened>>
<<Edited on March 6, 1983 5:42 pm, by Teitelman>>
<<changes to: AskUser>>
<<Edited on March 25, 1983 4:15 pm, by Teitelman>>
<<fixed bug wherein anything requiring confirmation in a viewer for actionarea that had been aborted or proceeded, i.e. had a blank 
second line, caused an addressfault (viewers problem)>>
<<changes to: DIRECTORY, SetupAskUser>>
<<Edited on April 13, 1983 2:25 pm, by Teitelman>>
<<changes to: AskUser>>
<<Edited on April 15, 1983 9:51 am, by Teitelman>>
<<changes to: DIRECTORY>>
<<>>