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
= 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