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; 
Viewer: TYPE = UserExec.Viewer;
ClickProc: TYPE = Menus.ClickProc;
ExecPrivateRecord: PUBLIC TYPE = UserExecPrivate.ExecPrivateRecord;
ResponseRecord: PUBLIC TYPE = UserExecPrivate.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];
};

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];
};
};
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;

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"];
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 by Teitelman, April 15, 1983 9:51 am
types
connecting concrete and opaque types
Manipulating ResponseRecord
internal procedure. returns ResponseRecord for viewer, or creates one if none there.
Responding: Askuser
main body of Askuser
user has not typed ahead. check for confirmation via typein as well as buttons.
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

Κ<–

"cedar" style˜JšΟcœ™+š
Οk	˜	Jšœžœžœ˜Jšœžœ˜Jšžœ
žœ;žœžœ˜dJšœžœ~˜‰
Jšœžœ!˜4Jšœžœ)˜6Jšœžœ˜"Jšœžœ˜#Jšœ	žœ]˜kJšœžœ0˜EJšœžœ˜.Jšœžœ
˜Jšœ
žœ"˜1˜J˜——JšΠblœžœ
žœ
žœ
žœžœ˜UJ˜Jšžœžœh˜xJ˜šžœ˜J˜—Jšœžœ
žœ
žœ˜
headš
œ™JšΟnœžœ˜Jš 	œžœ˜"š
œ$™$Jš œžœ
žœ%˜CJš œžœ
žœ"˜=——™š œžœ
žœžœ
žœ
žœžœ˜KJ˜@Jšœ
žœ=˜Jšžœž˜š
œ
˜
Jšžœžœ
žœ˜/J˜Jšžœžœ
žœ
˜šžœ"ž˜)Jš	žœ)žœ
žœ
žœ€
˜»
Jšžœ
˜—š
žœžœ
žœ
žœžœžœ
ž˜6Jšœ 
žœ˜¨
Jšžœ
˜—J˜2J˜——J˜,J˜—J˜š 
œžœ
žœžœ
žœ
žœžœ˜LJšœ
žœ=˜JJšžœžœ
žœ˜/Jš
œ˜Jšžœžœ
žœ
˜&J˜,šžœž˜J˜š
žœžœ
žœ
žœžœžœ
ž˜6JšžœBžœ
žœ<˜ˆ
Jšžœ
˜—J˜2J˜—J˜J˜—š œžœ
žœžœžœ	žœ˜[Jš	œ
 œžœ
žœžœ˜2Jš
œ&˜&J˜J˜Jšœ
žœ=˜JJ˜J˜J˜—š œžœ
žœžœ˜>š œžœ
žœžœ˜3Jšœžœ
˜Jš
œ˜JšžœB˜`J˜—Jšœ
žœ=˜JJ˜J˜J˜—š œžœ
žœ˜4š œžœ
žœžœ˜3Jšœžœ
˜Jšœžœ
˜J˜—Jšœ
žœ=˜JJ˜J˜#J˜J˜Jš
T™T—š	 œžœžœžœ"ž˜bJšœžœVžœ˜ršžœžœ
žœ
˜!Jšœžœ˜$J˜-J˜BJ˜—J˜——™Jš
 œ
žœ
žœ
žœžœ˜/J˜š œžœ
žœžœžœžœžœ.žœžœ
žœ
žœžœžœ˜½
Jšžœžœ
žœ˜/š	žœžœ
žœ
žœ
ž˜#Jš
œ
žœžœ
žœ
žœžœžœ˜ZJšžœ
žœ
žœ˜Jš
œ˜—š
œ
˜
šžœ
žœ˜Jš
œ˜Jš
œ˜Jšžœžœ
žœ
Πboœ˜1Jš
œ˜—š œžœžœ˜ šžœžœ
žœ
˜Jš‘œ ˜#Jšœ3žœ˜9J˜
—š
ž˜Jšœ/žœ*˜]Jš
œ˜—J˜—š œžœ˜Jšœžœ
˜Jšœ˜>Jš
œ0˜0šžœž˜Jšœ
žœžœ
žœ˜2—Jšžœ
žœ
˜J˜—š œžœ˜Jšœžœ
˜Jš
œ0˜0Jšžœ
žœžœ˜,Jšžœžœ
žœ#˜5JšžœUžœ˜`J˜—š œžœ
žœžœ˜'Jšžœžœ
žœ˜0Jšžœ˜Jš
œ˜—š œžœž˜!Jšžœžœ
žœ˜/Jšžœ
žœžœ
žœ˜HJšžœ
žœ˜J˜—Jšœ
žœ!˜.Jšœ	žœ
˜Jšœ	žœ#˜/J˜Jš
™šžœžœ
ž˜Jš
œ˜Jšœ
‘œ‘œ
‘œ˜*šžœžœ
ž˜J˜Jšžœ
˜—J˜J˜—Jš
œ&˜&Jš
œ˜Jšžœ
žœ
žœžœ#˜Iš	žœžœ
žœžœ
]˜…
Jšžœžœ
žœ ˜2šžœ˜Jš
œ"˜"J˜J˜—šžœ-ž˜7J˜"J˜Jšœ	žœ
˜Jšžœžœ
˜—Jšžœ˜	J˜—Jš	œžœ"žœžœžœ#˜‹
Jš
O™Oš
ž˜šžœ4ž˜>Jšœ$žœ˜.Jšœžœ˜#šœ˜š
ž˜Jšœž	œ
˜Jš
œ˜Jšœ/˜>Jšžœ
žœžœK˜xJš
žœžœ
žœžœžœ˜Fš
žœžœ
žœ
žœžœžœ
ž˜6Jšœžœ˜!šžœ
œžœ1žœ˜aJ˜J˜J˜Jšžœ˜	J˜—Jš
ž˜šžœ˜Jš
œ˜Jš
œ˜š
žœžœ
žœ
žœžœžœ
ž˜6Jšœžœ.˜AJšžœ
˜—Jš
œ7˜7Jš
œ)˜)J˜—Jšžœ
˜—Jšžœ˜Jšžœ˜	—J˜—Jšžœžœ
˜—Jšžœ
˜—Jš
ž˜š
œ˜Jš
œ˜Jš
œ˜Jšžœžœ
žœ
‘œ˜1Jš
œ˜—J˜—J˜J˜—Jš œžœ
žœžœžœžœ
žœžœžœžœ˜„
Jšžœ
žœžœ
˜Jšœ
žœ˜JšžœH˜Ošžœž˜Jšžœ˜Jš
žœžœ
žœžœ
žœ˜,Jšžœžœžœ
žœ˜@J˜ Jšžœ
˜—Jšžœžœ
žœžœ
žœ	0˜]Jšžœ˜J˜J˜š œΠckpœ˜Œ
Jšœžœ	˜ Jšœžœ
žœ˜2J˜—J˜Jš œžœ ˜2J˜—Jšžœ
˜™0J™JšœΟr™—™-Jšœ£™—™.J™·
Jšœ£™#—™.Jšœ£™—™.Jšœ£	™—J™—…—"Ύ1€