PropListTest.mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
Christian Jacobi, March 26, 1992 3:20 pm PST
Christian Jacobi, April 13, 1992 2:23 pm PDT
DIRECTORY
Atom, Commander, IO, Process, PropList, Rope, SimpleFeedback, XTk, XTkWidgets;
PropListTest:
CEDAR
PROGRAM
IMPORTS Atom, Commander, Process, IO, PropList, SimpleFeedback, XTkWidgets ~
propList: PropList.List ¬ PropList.NewPropList[];
MyRec:
TYPE =
RECORD [
keyWidget: XTkWidgets.Widget,
valWidget: XTkWidgets.Widget,
expectWidget: XTkWidgets.Widget
];
TestPutProp: XTk.WidgetNotifyProc = {
mr: REF MyRec ~ NARROW[registerData];
keyRope: Rope.ROPE ¬ XTkWidgets.GetText[mr.keyWidget];
valRope: Rope.ROPE ¬ XTkWidgets.GetText[mr.valWidget];
key: ATOM ~ Atom.MakeAtom[keyRope];
val: ATOM ~ Atom.MakeAtom[valRope];
PropList.PutProp[propList, key, val];
SimpleFeedback.PutF[$SystemScript, oneLiner, $Default, "put( key: %g, val: %g)\n", IO.atom[NARROW[key, ATOM]], IO.atom[NARROW[val, ATOM]]];
};
TestGetProp: XTk.WidgetNotifyProc = {
mr: REF MyRec ~ NARROW[registerData];
keyRope: Rope.ROPE ¬ XTkWidgets.GetText[mr.keyWidget];
key: ATOM ~ Atom.MakeAtom[keyRope];
val: REF ¬ PropList.GetProp[propList, key];
SimpleFeedback.PutF[$SystemScript, oneLiner, $Default, "get( key: %g) = %g\n", IO.atom[NARROW[key, ATOM]], IO.atom[NARROW[val, ATOM]]];
};
TestEnum: XTk.WidgetNotifyProc = {
Map: PropList.EachPropProc = {
SimpleFeedback.PutF[$SystemScript, oneLiner, $Default, " key: %g val: %g\n", IO.atom[NARROW[key, ATOM]], IO.atom[NARROW[val, ATOM]]];
};
mr: REF MyRec ~ NARROW[registerData];
SimpleFeedback.Append[$SystemScript, oneLiner, $Default, "Enumerate: \n"];
[] ¬ PropList.Enumerate[propList, Map];
SimpleFeedback.Append[$SystemScript, oneLiner, $Default, "end enumeration\n"];
};
TestCond: XTk.WidgetNotifyProc = {
mr: REF MyRec ~ NARROW[registerData];
keyRope: Rope.ROPE ¬ XTkWidgets.GetText[mr.keyWidget];
key: ATOM ~ Atom.MakeAtom[keyRope];
valRope: Rope.ROPE ¬ XTkWidgets.GetText[mr.valWidget];
val: ATOM ~ Atom.MakeAtom[valRope];
expRope: Rope.ROPE ¬ XTkWidgets.GetText[mr.expectWidget];
exp: ATOM ~ Atom.MakeAtom[expRope];
old: REF ¬ PropList.ConditionalPutProp[propList, key, exp, val];
SimpleFeedback.PutF[$SystemScript, oneLiner, $Default, "cond-put( key: %g, expected: %g val: %g, old: %g)\n", IO.atom[key], IO.atom[exp], IO.atom[val], IO.atom[NARROW[old, ATOM]]];
};
Init: PropList.InitializeProcType = {
};
TestGetPropOrInit: XTk.WidgetNotifyProc = {
Init: PropList.InitializeProcType = {
SimpleFeedback.Append[$SystemScript, oneLiner, $Default, "Start pause\n"];
Process.PauseMsec[8000];
SimpleFeedback.Append[$SystemScript, oneLiner, $Default, "Stop pause\n"];
val ¬ data
};
mr: REF MyRec ~ NARROW[registerData];
keyRope: Rope.ROPE ¬ XTkWidgets.GetText[mr.keyWidget];
key: ATOM ~ Atom.MakeAtom[keyRope];
newValRope: Rope.ROPE ¬ XTkWidgets.GetText[mr.valWidget];
newVal: ATOM ~ Atom.MakeAtom[newValRope];
val: REF;
SimpleFeedback.PutF[$SystemScript, oneLiner, $Default, "init start( key: %g)\n", IO.atom[key]];
val ¬ PropList.GetPropOrInit[propList, key, Init, newVal];
SimpleFeedback.PutF[$SystemScript, oneLiner, $Default, "init end( key: %g) = val: %g\n", IO.atom[key], IO.atom[NARROW[val]]];
};
TestCommand: Commander.CommandProc ~ {
mr: REF MyRec ~ NEW[MyRec];
put: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "<put prop>", hitProc: TestPutProp, registerData: mr];
get: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "<get prop>", hitProc: TestGetProp, registerData: mr];
enumerate: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "<enumerate>", hitProc: TestEnum, registerData: mr];
cond: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "<cond>", hitProc: TestCond, registerData: mr];
init: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "<init>", hitProc: TestGetPropOrInit, registerData: mr];
key: XTkWidgets.Widget ¬ mr.keyWidget ¬ XTkWidgets.CreateLabeledField[label: "Key:", init: "Unknown"];
val: XTkWidgets.Widget ¬ mr.valWidget ¬ XTkWidgets.CreateLabeledField[label: "Val:", init: "Unknown"];
expect: XTkWidgets.Widget ¬ mr.expectWidget ¬ XTkWidgets.CreateLabeledField[label: "Old:", init: "Unknown"];
container: XTkWidgets.Widget ¬ XTkWidgets.CreateYStack[[], LIST[put, get, enumerate, cond, init, key, val, expect]];
shell: XTkWidgets.Widget ¬ XTkWidgets.CreateShell[child: container, windowHeader: "test"];
XTkWidgets.RealizeShell[shell];
};
Commander.Register["PropListTest", TestCommand, "Create test widget for PropList"];
END.