XTkFeedbackImpl.mesa
Copyright Ó 1992, 1993 by Xerox Corporation. All rights reserved.
Christian Jacobi, March 26, 1992 3:19 pm PST
Christian Jacobi, March 10, 1993 11:33 am PST
DIRECTORY
Atom, BasicTime, IO, Feedback, FeedbackClasses, FeedbackConcreteTypes, FeedbackTypes, Rope, SimpleFeedback, EnvironmentVariables, Xl, XTk, XTkFeedback, XTkWidgets;
XTkFeedbackImpl: CEDAR PROGRAM
IMPORTS Atom, BasicTime, Feedback, FeedbackClasses, IO, Rope, EnvironmentVariables, Xl, XTk, XTkWidgets
EXPORTS XTkFeedback, Feedback, FeedbackTypes ~
BEGIN
MsgType: TYPE = SimpleFeedback.MsgType;
MsgClass: TYPE = SimpleFeedback.MsgClass;
MsgRouter: TYPE = REF MsgRouterObj;
MsgRouterObj: PUBLIC <<FeedbackTypes>> TYPE = FeedbackConcreteTypes.MsgRouterObj;
MsgHandler: TYPE ~ REF MsgHandlerObj;
MsgHandlerObj: PUBLIC <<FeedbackTypes>> TYPE = FeedbackConcreteTypes.MsgHandlerObj;
HandlerOnStreamWidget: TYPE ~ REF HandlerOnStreamWidgetRec;
HandlerOnStreamWidgetRec: TYPE ~ RECORD [
top: BOOL ← FALSE,
--fields if to=TRUE
reGenerate: BOOL ← FALSE,
name: Rope.ROPE ¬ NIL,
connection: REF ← NIL,
topWidget: XTk.Widget ← NIL,
--fields for all
lastFailureTime: BasicTime.GMT ¬ BasicTime.nullGMT,
to: IO.STREAM,
state: {before, after, chars} ¬ after
];
DontClearHerald: PROC [mh: MsgHandler, msgClass: MsgClass] ~ {RETURN};
DontBlink: PROC [mh: MsgHandler, msgClass: MsgClass] ~ {RETURN};
MyPutF: PROC [mh: MsgHandler, msgType: MsgType, msgClass: MsgClass, format: Rope.ROPE, list: LIST OF IO.Value ¬ NIL ] ~ {
hosw: HandlerOnStreamWidget ~ NARROW[mh.data];
IF hosw.top THEN {
w: XTk.Widget ¬ hosw.topWidget;
IF w=NIL OR (w.fastAccessAllowed#ok AND hosw.reGenerate) THEN {
lastFailureTime: BasicTime.GMT ¬ hosw.lastFailureTime;
now: BasicTime.GMT ¬ BasicTime.Now[];
IF lastFailureTime=BasicTime.nullGMT OR BasicTime.Period[lastFailureTime, now]>10
THEN {
--Time to try
CreateShellForHandler[mh, hosw.name, hosw.connection !
Xl.XError, UNCAUGHT => {
hosw.lastFailureTime ¬ now;
CONTINUE;
};
];
}
ELSE {
--Don't try again, it is too soon
};
};
};
IF hosw.state=before OR (Feedback.typeBreaksAt[msgType].begin AND hosw.state#after) THEN IO.PutChar[hosw.to, '\n];
IO.PutFL[hosw.to, format, list];
IF NOT Feedback.typeBreaksAt[msgType].end THEN hosw.state ¬ chars
ELSE hosw.state ¬ before;
};
CreateHandlerOnShell: PUBLIC PROC [name: Rope.ROPE, reGenerate: BOOL ¬ FALSE, connection: REF ¬ NIL] RETURNS [h: MsgHandler] ~ {
stream: IO.STREAM ¬ XTkWidgets.CreateStream[];
hosw: HandlerOnStreamWidget ~ NEW[HandlerOnStreamWidgetRec ¬ [to: stream, top: TRUE, reGenerate: reGenerate, connection: connection, name: name]];
h ¬ FeedbackClasses.CreateHandler[MyPutF, DontClearHerald, DontBlink, hosw];
};
CreateHandlerOnStreamWidget: PUBLIC PROC [streamWidget: XTkWidgets.Widget ← NIL] RETURNS [h: MsgHandler] ~ {
stream: IO.STREAM ¬ XTkWidgets.CreateStream[];
hosw: HandlerOnStreamWidget ~ NEW[HandlerOnStreamWidgetRec ¬ [to: stream]];
h ¬ FeedbackClasses.CreateHandler[MyPutF, DontClearHerald, DontBlink, hosw];
IF streamWidget#NIL THEN SetWidgetForHandler[h, streamWidget];
};
IsHandlerOnWidgets: PUBLIC PROC [h: MsgHandler] RETURNS [BOOL] = {
RETURN [h#NIL AND ISTYPE[h.data, HandlerOnStreamWidget]]
};
SetWidgetForHandler: PUBLIC PROC [h: MsgHandler, streamWidget: XTkWidgets.Widget] = {
hosw: HandlerOnStreamWidget ~ NARROW[h.data];
IF streamWidget#NIL THEN XTkWidgets.BindStream[streamWidget, hosw.to];
};
CreateStreamWidgetForHandler: PUBLIC PROC [h: MsgHandler] RETURNS [streamWidget: XTkWidgets.Widget] = {
streamWidget ¬ XTkWidgets.CreateStreamWidget[];
SetWidgetForHandler[h, streamWidget]
};
CreateShellForHandler: PUBLIC PROC [h: MsgHandler, name: Rope.ROPE, connection: REF ¬ NIL] ~ {
hosw: HandlerOnStreamWidget ~ NARROW[h.data];
streamWidget: XTkWidgets.Widget ¬ XTkWidgets.CreateStreamWidget[widgetSpec: [geometry: XTk.G[350, 200]]];
container: XTkWidgets.Widget ¬ XTkWidgets.CreateYStack[[], LIST[streamWidget]];
shell: XTkWidgets.Widget ¬ XTkWidgets.CreateShell[child: container, windowHeader: name, packageName: "XTkFeedback", shortName: "XTkFeedback"];
XTkWidgets.BindScreenShell[shell, connection];
XTkWidgets.RealizeShell[shell];
SetWidgetForHandler[h, streamWidget];
hosw.topWidget ← shell;
};
Init: PROC [] = {
InitReliable: PROC [] = {
router1: Feedback.MsgRouter ¬ Feedback.EnsureRouter[$X11Reliable];
router2: Feedback.MsgRouter ¬ Feedback.EnsureRouter[$X11];
h: Feedback.MsgHandler ~ CreateHandlerOnShell[name: "Feedback (for $X11)", reGenerate: TRUE];
[] ¬ Feedback.SetHandler[router1, $Default, h];
[] ¬ Feedback.SetHandler[router2, $Default, h];
};
InitSingleTry: PROC [] = {
router: Feedback.MsgRouter ¬ Feedback.EnsureRouter[$X11Single];
h: Feedback.MsgHandler ~ CreateHandlerOnShell[name: "Feedback (for $X11Single)", reGenerate: FALSE];
[] ¬ Feedback.SetHandler[router, $Default, h];
};
InitTheDefault: PROC [] = {
h: Feedback.MsgHandler ~ CreateHandlerOnShell[name: "Default feedback", reGenerate: TRUE];
old: Feedback.MsgHandler ~ Feedback.SetGlobalDefaultHandlersBehavior[h];
IF old#NIL THEN {
isSplitter: BOOL; h1, h2: Feedback.MsgHandler;
Try: PROC [mh: Feedback.MsgHandler] RETURNS [found: BOOL] ~ {
[found] ¬ FeedbackClasses.IsStoringHandler[mh];
IF found THEN FeedbackClasses.PlayStore[mh, h, $History, TRUE];
};
[isSplitter, h1, h2] ¬ FeedbackClasses.IsSplittingHandler[old];
IF isSplitter
THEN {
IF Try[h1].found THEN RETURN;
IF Try[h2].found THEN RETURN;
}
ELSE [] ¬ Try[old];
};
};
InitReliable[];
InitSingleTry[];
BEGIN
value: Rope.ROPE ¬ EnvironmentVariables.Get["CedarXTkFeedback"];
IF Rope.Equal[value, "FALSE", FALSE] THEN RETURN;
IF Rope.Equal[value, "TRUE", FALSE] THEN {InitTheDefault[]; RETURN};
IF Atom.GetProp[$Viewers, $Viewers]=NIL THEN InitTheDefault[];
END;
};
Init[];
END.