
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,
reGenerate: BOOL _ FALSE,
name: Rope.ROPE ¬ NIL,
connection: REF _ NIL,
topWidget: XTk.Widget _ NIL,
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 { 
CreateShellForHandler[mh, hosw.name, hosw.connection ! 
Xl.XError, UNCAUGHT => {
hosw.lastFailureTime ¬ now;
CONTINUE;
};
];
}
ELSE {
};
};
};
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.

     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

--fields if to=TRUE
--fields for all 
--Time to try
--Don't try again, it is too soon
‌ت¢  –(cedarcode) style•NewlineDelimiter
ک code™K™BK™,K™-K™ —ڑدk	œک
Kڑœ‌œگک£Kک —ڑدnœ‌œ‌کKڑ‌œ-‌œ1کgKڑ‌œ(ک/—ڑ‌کKک —Kڑœ	‌œک'Kڑœ
‌œک)Kڑœ‌œ‌œک#Kڑœ‌œ‌œ&کQKڑœ‌œ‌œک%Kڑœ‌œ‌œ'کSKک Kڑœ‌œ‌œک;ڑœ‌œ‌œک)ڑœ‌œ‌œکK™Kڑœ‌œ‌œکKڑœ‌œ‌œکKڑœ‌œ‌œکKڑœ‌œک—K™Kڑœ‌œک3Kڑœ‌œ‌œکKڑœ%ک%KڑœکKک —Kڑ‍œ‌œ)‌œکFKڑ‍	œ‌œ)‌œک@ڑ‍œ‌œE‌œ‌œ‌œ‌œ	‌œکyKڑœ‌œ
ک.ڑ‌œ
‌œکKکڑ
‌œ‌œ‌œ‌œ‌œک?Kڑœ‌œک6Kڑœ‌œک%ڑ‌œ#‌œ+کRڑ‌œکK™ک7ڑœ‌œکKکKڑ‌œک	Kک—Kک—Kک—ڑ‌œکK™!Kک——Kک—Kک—Kڑ
‌œ‌œ'‌œ‌œ‌œکrKڑ‌œک Kڑ‌œ‌œ$‌œکAKڑ‌œکKکKک —ڑ‍œ‌œ‌œ‌œ‌œ‌œ‌œ‌œک€Kڑœ‌œ‌œک/Kڑœ‌œ.‌œ?ک’KکMKکKک —ڑ‍œ‌œ$‌œ‌œکlKڑœ‌œ‌œک/Kڑœ‌œ*کKKکMKڑ‌œ‌œ‌œ&ک>Kک—Kک ڑ‍œ‌œ‌œ‌œکBKڑ‌œ‌œ‌œ‌œ ک8KکKک —ڑ‍œ‌œ5کUKڑœ‌œ	ک-Kڑ‌œ‌œ‌œ.کFKکKک —ڑ‍œ‌œ‌œ&کgKک/Kک$Kک—Kک ڑ
‍œ‌œ‌œ‌œ‌œک^Kڑœ‌œ	ک-KکiKڑœ;‌œکOKڑœژکژKک.KکKک%KکKکKک —ڑ‍œ‌œکڑ‍œ‌œکKکBKک:KڑœW‌œک]Kک/Kک/Kک—ڑ‍œ‌œکKک?Kڑœ]‌œکdKک.Kک—ڑ‍œ‌œکKڑœT‌œکZKکHڑ‌œ‌œ‌œکKڑœ‌œک.ڑ‍œ‌œ‌œ	‌œک=Kڑœ/ک/Kڑ‌œ‌œ,‌œک?Kک—Kڑœ?ک?ڑ‌œکڑ‌œکKڑ‌œ‌œ‌œکKڑ‌œ‌œ‌œکKک—Kڑ‌œک—Kک—Kک—KکKکڑ‌کJڑœ‌œ0ک@Kڑ‌œ‌œ‌œ‌œک1Kڑ‌œ‌œ‌œ‌œکDKڑ‌œ"‌œ‌œک>Kڑ‌œک—کKک ——KکKڑ‌œکKک — …—    X  
  