X11TclWidget.mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, January 28, 1992
Christian Jacobi, March 27, 1992 11:15 am PST
DIRECTORY
Commander, CommanderOps, IO, Rope, X11Tcl, Xl, XTk, XTkWidgets;
X11TclWidget:
CEDAR
PROGRAM
IMPORTS Commander, CommanderOps, IO, Rope, X11Tcl, Xl, XTk, XTkWidgets ~
Instance: TYPE = REF InstanceRec;
InstanceRec:
TYPE =
RECORD [
text, dest: XTk.Widget ¬ NIL,
log: IO.STREAM
];
LegalDestination:
PROC [destination: Rope.
ROPE]
RETURNS [
BOOL¬
TRUE] = {
IF Rope.IsEmpty[destination] THEN RETURN [FALSE];
};
DoStuff: XTkWidgets.ButtonHitProcType = {
state: X11Tcl.TclCode;
answer: Rope.ROPE;
i: Instance ~ NARROW[registerData];
text: Rope.ROPE ~ XTkWidgets.GetText[i.text];
destination: Rope.ROPE ~ XTkWidgets.GetText[i.dest];
[state, answer] ¬ X11Tcl.Send[c: i.text.connection, interpreterName: destination, command: text, timeout: 5000];
SELECT state
FROM
noInterpreter => IO.PutRope[i.log, "noInterpreter;"];
timeout => IO.PutRope[i.log, "timeout;"];
error => IO.PutRope[i.log, "error;"];
ok => IO.PutRope[i.log, "ok:"];
ENDCASE => {};
IO.PutF1[i.log, " %g\n", IO.rope[answer]];
};
CreateInstanceCommand: Commander.CommandProc ~ {
ENABLE {
Xl.XError => CommanderOps.Failed[err.explanation];
Xl.connectionNotCreated => CommanderOps.Failed[why.reason];
};
i: Instance ~ NEW[InstanceRec];
shell: XTk.Widget ~ XTkWidgets.CreateShell[windowHeader: "X11Tcl widget", className: $X11TclWidget, standardMigration: TRUE];
doit: XTk.Widget ~ XTkWidgets.CreateButton[text: "Apply", hitProc: DoStuff, registerData: i, tq: shell.rootTQ];
logWidget: XTk.Widget ~ XTkWidgets.CreateStreamWidget[[geometry: XTk.G[300, 100, 1]]];
i.log ¬ XTkWidgets.CreateStream[logWidget];
i.text ¬ XTkWidgets.CreateLabeledField[[], "command:", "date"];
i.dest ¬ XTkWidgets.CreateLabeledField[[], "interpreter:", "CedarCommander"];
XTkWidgets.SetShellChild[shell: shell, child: XTkWidgets.CreateYStack[stack: LIST[doit, i.dest, i.text, logWidget]]];
XTkWidgets.RealizeShell[shell];
};
Commander.Register["X11TclWidget", CreateInstanceCommand, "Creates a X11Tcl widget"];
END.