XTkFeedbackCommands.mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
Christian Jacobi, March 26, 1992 3:20 pm PST
Christian Jacobi, April 8, 1992 3:29 pm PDT
DIRECTORY
Atom, Commander, Feedback, Rope, SimpleFeedback, XTk, XTkFeedback, XTkWidgets;
XTkFeedbackCommands:
CEDAR
PROGRAM
IMPORTS Atom, Commander, Feedback, Rope, SimpleFeedback, XTkFeedback, XTkWidgets ~
------------------------------
Exercising feedback
ExercizerRec:
TYPE =
RECORD [
routerWidget: XTkWidgets.Widget,
msgClassWidget: XTkWidgets.Widget,
msgWidget: XTkWidgets.Widget
];
DoExercise: XTk.WidgetNotifyProc = {
tr: REF ExercizerRec ~ NARROW[registerData];
message: Rope.ROPE ¬ XTkWidgets.GetText[tr.msgWidget];
router: Rope.ROPE ¬ XTkWidgets.GetText[tr.routerWidget];
msgClass: Rope.ROPE ¬ XTkWidgets.GetText[tr.msgClassWidget];
SimpleFeedback.Append[Atom.MakeAtom[router], oneLiner, Atom.MakeAtom[msgClass], message];
};
CreateTestExercizer: Commander.CommandProc ~ {
tr: REF ExercizerRec ~ NEW[ExercizerRec];
button: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "<exercise feedback handler>", hitProc: DoExercise, registerData: tr];
routerWidget: XTkWidgets.Widget ¬ tr.routerWidget ¬ XTkWidgets.CreateLabeledField[label: "Router:", init: "Unknown"];
msgClassWidget: XTkWidgets.Widget ¬ tr.msgClassWidget ¬ XTkWidgets.CreateLabeledField[label: "MsgClass:", init: "Unknown"];
msgWidget: XTkWidgets.Widget ¬ tr.msgWidget ¬ XTkWidgets.CreateLabeledField[label: "message:", init: "...Hello..."];
container: XTkWidgets.Widget ¬ XTkWidgets.CreateYStack[[], LIST[button, routerWidget, msgClassWidget, msgWidget]];
shell: XTkWidgets.Widget ¬ XTkWidgets.CreateShell[child: container, windowHeader: "Feedback exercisor", packageName: "XTkFeedback", shortName: "XTkFeedbackExercise"];
XTkWidgets.RealizeShell[shell];
};
------------------------------
Creating feedback routers
CreatorRec:
TYPE =
RECORD [
routerWidget: XTkWidgets.Widget,
msgClassWidget: XTkWidgets.Widget
];
CreateAHandler: XTk.WidgetNotifyProc = {
tr: REF ExercizerRec ~ NARROW[registerData];
routerName: Rope.ROPE ¬ XTkWidgets.GetText[tr.routerWidget];
msgClassName: Rope.ROPE ¬ XTkWidgets.GetText[tr.msgClassWidget];
routerKey: ATOM ~ Atom.MakeAtom[routerName];
msgClassKey: ATOM ~ Atom.MakeAtom[msgClassName];
router: Feedback.MsgRouter ¬ Feedback.EnsureRouter[routerKey];
h: Feedback.MsgHandler ~ XTkFeedback.CreateHandlerOnShell[name: Rope.Cat["Feedback for ", routerName, " (", msgClassName, ")"]];
[] ¬ Feedback.SetHandler[router, msgClassKey, h];
SimpleFeedback.Append[routerKey, oneLiner, msgClassKey, "Feedback widget just created"];
};
HandlerCreator: Commander.CommandProc ~ {
cr: REF ExercizerRec ~ NEW[ExercizerRec];
button: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "<create feedback handler>", hitProc: CreateAHandler, registerData: cr];
routerWidget: XTkWidgets.Widget ¬ cr.routerWidget ¬ XTkWidgets.CreateLabeledField[label: "Router name:", init: "Unknown"];
msgClassWidget: XTkWidgets.Widget ¬ cr.msgClassWidget ¬ XTkWidgets.CreateLabeledField[label: "MsgClass name:", init: "Default"];
container: XTkWidgets.Widget ¬ XTkWidgets.CreateYStack[[], LIST[button, routerWidget, msgClassWidget]];
shell: XTkWidgets.Widget ¬ XTkWidgets.CreateShell[child: container, windowHeader: "Feedback handler creation", packageName: "XTkFeedback", shortName: "XTkFeedbackCreate"];
XTkWidgets.RealizeShell[shell];
};
------------------------------
Commander.Register["XTkFeedbackExercise", CreateTestExercizer, "Create a feedback exercizer tool"];
Commander.Register["XTkFeedbackCreate", HandlerCreator, "Create a feedback-handler creation tool"];
END.