TclCommander.mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
Christian Jacobi, January 28, 1992
Christian Jacobi, June 19, 1992 12:48 pm PDT
DIRECTORY
Atom, Commander, CommanderBackdoor, CommanderOps, IO, ProcessProps, Rope, Xl, X11Tcl;
TclCommander:
CEDAR
PROGRAM
IMPORTS Atom, Commander, CommanderBackdoor, CommanderOps, IO, ProcessProps, Rope, Xl, X11Tcl ~
CreateListenerCommand: Commander.CommandProc ~ {
connection: Xl.Connection;
success: BOOL;
overwrite: BOOL ¬ FALSE;
detach: BOOL ¬ FALSE;
display: Rope.ROPE ¬ NIL;
interpreterName: Rope.ROPE ¬ "CedarCommander";
DO
arg: Rope.ROPE ¬ CommanderOps.NextArgument[cmd];
IF arg=NIL THEN EXIT;
SELECT
TRUE
FROM
Rope.Equal[arg, "-display", FALSE] => display ¬ CommanderOps.NextArgument[cmd];
Rope.Equal[arg, "-interp", FALSE] => interpreterName ¬ CommanderOps.NextArgument[cmd];
Rope.Equal[arg, "-force", FALSE] => overwrite ¬ TRUE;
Rope.Equal[arg, "-noforce", FALSE] => overwrite ¬ FALSE;
Rope.Equal[arg, "-detach", FALSE] => detach ¬ TRUE;
ENDCASE => CommanderOps.Failed["unknown argument"];
ENDLOOP;
connection ¬ Xl.CreateConnection[server: display];
success ¬ X11Tcl.RegisterInterpreter[c: connection, interpreterName: interpreterName, listener: CommandProc, overwrite: overwrite, refCounting: TRUE];
Xl.DecRefCount[connection];
IF success
THEN {
msg ¬ "ok";
IF detach
THEN {
--detaches regular CommanderOnStandardStreamsImpl
Atom.PutProp[$CommanderOnStandardStreams, $DontExit, $DontExit];
};
}
ELSE result ¬ $Failure
};
NoPrompt:
PROC [cmd: Commander.Handle] ~ {
};
CommandProc: X11Tcl.ListenerProc = {
inStream: IO.STREAM ¬ IO.RIS[command];
outStream: IO.STREAM ¬ IO.ROS[];
Inner:
PROC = {
commander: Commander.Handle = CommanderOps.CreateFromStreams[in: inStream, out: outStream];
CommanderBackdoor.GetCommandToolData[commander].Prompt ¬ NoPrompt;
[] ¬ CommanderOps.ReadEvalPrintLoop[commander];
};
ProcessProps.AddPropList[LIST[NEW[Atom.DottedPairNode ¬ ["", ""]]], Inner];
reply ¬ IO.RopeFromROS[outStream];
};
Commander.Register["TclCommander", CreateListenerCommand, "create a Tcl remote commander"];
END.