File: FeedbackImpl.mesa
Last edited by: Eric Bier on March 3, 1987 4:33:26 pm PST
Contents: Routines for handling user error messages throughout Gargoyle.
Pier, October 24, 1986 2:00:58 pm PDT
DIRECTORY
AtomButtonsTypes, Feedback, IO, Labels, MessageWindow, Process, Rope, ViewerClasses, ViewerIO, ViewerOps;
FeedbackImpl: CEDAR PROGRAM
IMPORTS IO, Labels, MessageWindow, Process, Rope, ViewerIO, ViewerOps
EXPORTS Feedback = BEGIN
Problem: PUBLIC SIGNAL [msg: Rope.ROPE] = CODE;
MsgType: TYPE = Feedback.MsgType;
Viewer: TYPE = ViewerClasses.Viewer;
gScripts: LIST OF Script;
Script: TYPE = REF ScriptObj;
ScriptObj: TYPE = RECORD [
viewer: Viewer,
stream: IO.STREAM,
atomName: ATOM
];
FeedbackData: TYPE = REF FeedbackDataObj;
FeedbackDataObj: TYPE = AtomButtonsTypes.FeedbackDataObj;
typeAll: BOOL ← FALSE;
IF feedback#NIL THEN PutF[feedback, oneLiner, "Gargoyle Typescript of %t", [time[BasicTime.Now[]]] ];
ELSE IF feedback#NIL THEN Append[feedback, "Gargoyle Typescript already exists", oneLiner];
FindScript: PROC [atomName: ATOM] RETURNS [script: Script ← NIL] = {
FOR list: LIST OF Script ← gScripts, list.rest UNTIL list = NIL DO
IF list.first.atomName = atomName THEN RETURN[list.first];
ENDLOOP;
};
OpenTypescript: PUBLIC PROC [headerText: Rope.ROPE, atomName: ATOM, openHeight: NAT ← 120] RETURNS [alreadyExists: BOOL, typescript: Viewer] = {
script: Script ← FindScript[atomName];
newStream: IO.STREAM;
IF script=NIL OR script.viewer.destroyed THEN {
typescript ← ViewerOps.CreateViewer[
flavor: $TypeScript,
info: [name: headerText, menu: NIL, data: NIL, iconic: TRUE, column: right, scrollable: TRUE, icon: unInit], paint: FALSE];
ViewerOps.SetOpenHeight[typescript, openHeight];
ViewerOps.OpenIcon[icon: typescript, closeOthers: FALSE, bottom: TRUE, paint: TRUE];
[, newStream] ← ViewerIO.CreateViewerStreams[headerText, typescript, NIL, TRUE];
};
IF script=NIL THEN {
newScript: Script ← NEW[ScriptObj ← [typescript, newStream, atomName]];
gScripts ← CONS[newScript, gScripts];
}
ELSE IF script.viewer.destroyed THEN {
script^ ← [typescript, newStream, atomName];
};
};
GetTypescriptStream: PUBLIC PROC [atomName: ATOM] RETURNS [IO.STREAM] = {
script: Script ← FindScript[atomName];
IF script = NIL THEN RETURN[NIL];
RETURN[script.stream];
};
RegisterFeedback: PUBLIC PROC [label: Viewer, atomName: ATOM] RETURNS [feedback: FeedbackData] = {
feedback ← NEW[FeedbackDataObj ← [label, atomName]];
};
Append: PUBLIC PROC [feedback: FeedbackData, msg: Rope.ROPE, msgType: MsgType] = {
AppendHerald[feedback, msg, msgType];
AppendTypescript[feedback, msg, msgType];
};
AppendRaw: PUBLIC PROC [atomName: ATOM, msg: Rope.ROPE, msgType: MsgType] = {
AppendHeraldRaw[atomName, msg, msgType];
AppendTypescriptRaw[atomName, msg, msgType];
};
AppendHerald: PUBLIC PROC [feedback: FeedbackData, msg: Rope.ROPE, msgType: MsgType] = {
clearHerald: BOOL ← msgType = oneLiner OR msgType = begin;
addCR: BOOL ← msgType = oneLiner OR msgType = end;
IF feedback = NIL THEN RETURN; -- this should only happen while the viewer is being created.
BEGIN
oldRope: Rope.ROPE ← NARROW[feedback.label.class.get[feedback.label]];
IF Rope.Equal[msg, oldRope, FALSE] THEN RETURN; -- don't repeat messages
IF clearHerald THEN Labels.Set[feedback.label, msg] ELSE Labels.Set[feedback.label, Rope.Concat[oldRope, msg]];
END;
IF typeAll THEN AppendTypescript[feedback, msg, msgType];
};
LastRope: PROC [ropes: LIST OF Rope.ROPE] RETURNS [last: Rope.ROPE] = {
IF ropes = NIL THEN RETURN[NIL];
FOR list: LIST OF Rope.ROPE ← ropes, list.rest UNTIL list = NIL DO
last ← list.first;
ENDLOOP;
};
AppendHeraldRaw: PUBLIC PROC [atomName: ATOM, msg: Rope.ROPE, msgType: MsgType] = {
clearHerald: BOOL ← msgType = oneLiner OR msgType = begin;
addCR: BOOL ← msgType = oneLiner OR msgType = end;
oldRope: Rope.ROPE ← LastRope[MessageWindow.GetHistory[]];
IF Rope.Equal[msg, oldRope, FALSE] THEN RETURN; -- don't repeat messages
IF clearHerald THEN {
MessageWindow.Clear[];
MessageWindow.Append[msg];
}
ELSE MessageWindow.Append[msg];
IF typeAll THEN AppendTypescriptRaw[atomName, msg, msgType];
};
Eq: PROC [x, y: Script] RETURNS[BOOL] = {RETURN[x = y]};
DRemove: PUBLIC PROC [ref: Script, list: LIST OF Script] RETURNS[LIST OF Script] = {
l, l1: LIST OF Script ← NIL;
l ← list;
UNTIL l = NIL DO
IF Eq[l.first, ref] THEN {
IF l1 = NIL THEN RETURN[l.rest]; -- ref was first object on list
l1.rest ← l.rest;
RETURN[list];
};
l1 ← l;
l ← l.rest;
ENDLOOP;
RETURN [list];
}; -- of Dremove;
AppendTypescript: PUBLIC PROC [feedback: FeedbackData, msg: Rope.ROPE, msgType: MsgType] = {
clearHerald: BOOL ← msgType = oneLiner OR msgType = begin;
addCR: BOOL ← msgType = oneLiner OR msgType = end;
script: Script ← FindScript[feedback.atomName];
stream: IO.STREAM;
stream ← IF script = NIL THEN NIL ELSE script.stream;
IF stream#NIL THEN { -- there is (was) a typescript
ENABLE IO.Error => {
IF ec#StreamClosed THEN {
IF feedback#NIL THEN {
Append[feedback, ". . . Serious typescript IO Error", oneLiner];
Blink[feedback];
};
};
gScripts ← DRemove[script, gScripts];
CONTINUE;
};
stream.PutF[msg]; -- try writing to typescript
IF addCR THEN stream.PutChar[IO.CR];
};
};
AppendTypescriptRaw: PUBLIC PROC [atomName: ATOM, msg: Rope.ROPE, msgType: MsgType] = {
clearHerald: BOOL ← msgType = oneLiner OR msgType = begin;
addCR: BOOL ← msgType = oneLiner OR msgType = end;
script: Script ← FindScript[atomName];
stream: IO.STREAM;
stream ← IF script = NIL THEN NIL ELSE script.stream;
IF stream#NIL THEN { -- there is (was) a typescript
ENABLE IO.Error => {
IF ec#StreamClosed THEN {
MessageWindow.Append[". . . Serious typescript IO Error"];
MessageWindow.Blink[];
};
gScripts ← DRemove[script, gScripts];
CONTINUE;
};
stream.PutF[msg]; -- try writing to typescript
IF addCR THEN stream.PutChar[IO.CR];
};
};
ClearHerald: PUBLIC PROC [feedback: FeedbackData] = {
Remove any messages from the herald.
IF feedback#NIL THEN Labels.Set[feedback.label, ""];
};
ClearHeraldRaw: PUBLIC PROC [atomName: ATOM] = {
Remove any messages from the Message Window.
MessageWindow.Clear[];
};
PutF: PUBLIC PROC [feedback: FeedbackData, msgType: MsgType, format: Rope.ROPE ← NIL, v1, v2, v3, v4, v5: IO.Value ← [null[]] ] = {
msg: Rope.ROPE ← IO.PutFR[format, v1, v2, v3, v4, v5];
Append[feedback, msg, msgType];
};
PutFRaw: PUBLIC PROC [atomName: ATOM, msgType: MsgType, format: Rope.ROPE ← NIL, v1, v2, v3, v4, v5: IO.Value ← [null[]] ] = {
msg: Rope.ROPE ← IO.PutFR[format, v1, v2, v3, v4, v5];
AppendRaw[atomName, msg, msgType];
};
PutFHerald: PUBLIC PROC [feedback: FeedbackData, msgType: MsgType, format: Rope.ROPE ← NIL, v1, v2, v3, v4, v5: IO.Value ← [null[]] ] = {
msg: Rope.ROPE ← IO.PutFR[format, v1, v2, v3, v4, v5];
AppendHerald[feedback, msg, msgType];
};
PutFHeraldRaw: PUBLIC PROC [atomName: ATOM, msgType: MsgType, format: Rope.ROPE ← NIL, v1, v2, v3, v4, v5: IO.Value ← [null[]] ] = {
msg: Rope.ROPE ← IO.PutFR[format, v1, v2, v3, v4, v5];
AppendHeraldRaw[atomName, msg, msgType];
};
PutFTypescript: PUBLIC PROC [feedback: FeedbackData, msgType: MsgType, format: Rope.ROPE ← NIL, v1, v2, v3, v4, v5: IO.Value ← [null[]] ] = {
msg: Rope.ROPE ← IO.PutFR[format, v1, v2, v3, v4, v5];
AppendTypescript[feedback, msg, msgType];
};
PutFTypescriptRaw: PUBLIC PROC [atomName: ATOM, msgType: MsgType, format: Rope.ROPE ← NIL, v1, v2, v3, v4, v5: IO.Value ← [null[]] ] = {
msg: Rope.ROPE ← IO.PutFR[format, v1, v2, v3, v4, v5];
AppendTypescriptRaw[atomName, msg, msgType];
};
Blink: PUBLIC PROC [feedback: FeedbackData] = {
IF feedback#NIL THEN {
Labels.SetDisplayStyle[feedback.label, $WhiteOnBlack];
Process.Pause[Process.MsecToTicks[150]];
Labels.SetDisplayStyle[feedback.label, $BlackOnWhite];
Process.Pause[Process.MsecToTicks[150]];
Labels.SetDisplayStyle[feedback.label, $WhiteOnBlack];
Process.Pause[Process.MsecToTicks[150]];
Labels.SetDisplayStyle[feedback.label, $BlackOnWhite];
};
};
BlinkRaw: PUBLIC PROC [atomName: ATOM] = {
MessageWindow.Blink[];
};
END.