XCommanderImpl.mesa
Copyright Ó 1991, 1992 by Xerox Corporation. All rights reserved.
Christian Jacobi, September 20, 1991 5:37:08 pm PDT
Christian Jacobi, February 23, 1993 7:17 pm PST
DIRECTORY
Ascii, Atom, Commander, CommanderBackdoor, CommanderOps, Identification, IO, Process, ProcessProps, Rope, Xl, XTk, XTkLabelsExtras, XTkWidgets;
XCommanderImpl:
CEDAR
MONITOR
LOCKS data USING data: Data
IMPORTS Commander, CommanderBackdoor, CommanderOps, Identification, IO, Process, ProcessProps, Rope, Xl, XTk, XTkLabelsExtras, XTkWidgets =
BEGIN
Data: TYPE = REF DataRec;
DataRec:
TYPE =
MONITORED RECORD [
cmd: Commander.Handle ¬ NIL,
ctd: CommanderBackdoor.CommandToolData ¬ NIL,
field: XTk.Widget ¬ NIL,
ready: Rope.ROPE ¬ NIL,
nonEmpty: CONDITION,
rubout: BOOL ¬ FALSE,
destroyed: BOOL ¬ FALSE,
out: IO.STREAM ¬ NIL
];
CancelAbort:
PROC [cmd: Commander.Handle] = {
ctd: CommanderBackdoor.CommandToolData ~ CommanderBackdoor.GetCommandToolData[cmd];
IF ctd#
NIL
THEN {
rp: REF PROCESS ¬ ctd.process;
IF rp#
NIL
THEN {
process: PROCESS ¬ rp;
IF process#
NIL
THEN
Process.CancelAbort[process ! Process.InvalidProcess => CONTINUE];
}
};
};
Forked:
PROC [data: Data] ~ {
Inner:
PROC ~ {
cmd: Commander.Handle ~ data.cmd;
result: REF ¬ $Failure;
msg: Rope.ROPE ¬ NIL;
hadFailure: BOOL ¬ FALSE;
hadFailure ¬ CommanderOps.ReadEvalPrintLoop[cmd];
IO.PutRope[cmd.out, " -- Exiting XCommander\n"];
IF hadFailure THEN {IO.PutRope[cmd.out, " (some commands failed)\n"];};
};
ProcessProps.AddPropList[LIST[NEW[Atom.DottedPairNode ¬ ["",""]]], Inner]; -- dummy prop list so SetProcessProperty has a chance to work.
};
StopHit: XTk.WidgetNotifyProc = {
EntryStop:
ENTRY
PROC [data: Data] = {
ENABLE UNWIND => NULL;
data.rubout ¬ TRUE;
data.ready ¬ NIL;
CommanderBackdoor.AbortCommander[data.cmd];
BROADCAST data.nonEmpty
};
data: Data ~ NARROW[registerData];
EntryStop[data];
};
DelHit:
ENTRY
PROC [data: Data] = {
ENABLE UNWIND => NULL;
data.rubout ¬ TRUE;
data.ready ¬ NIL;
BROADCAST data.nonEmpty
};
GetAndClear:
PROC [data: Data]
RETURNS [text: Rope.
ROPE] = {
text ¬ XTkWidgets.GetText[data.field];
XTkWidgets.SetText[data.field, ""];
};
StuffHit: XTk.WidgetNotifyProc = {
data: Data ~ NARROW[registerData];
WITH callData
SELECT
FROM
a:
ATOM =>
SELECT callData
FROM
$provide => Append[data, GetAndClear[data]];
$enter => Append[data, Rope.Concat[GetAndClear[data], "\n"]];
ENDCASE => {};
ri: REF INT =>
SELECT ri
FROM
-2 => Append[data, Rope.Concat[GetAndClear[data], "\n"]];
ENDCASE => {};
ENDCASE => {};
};
Destroy: XTk.WidgetNotifyProc = {
data: Data ~ NARROW[registerData];
data.destroyed ¬ TRUE
};
FilterChar: XTk.WidgetNotifyProc = {
data: Data ~ NARROW[registerData];
WITH callData
SELECT
FROM
r: Rope.
ROPE =>
IF Rope.Length[r]=1
THEN {
char: CHAR ~ Rope.Fetch[r];
SELECT char
FROM
Ascii.
CR, Ascii.
LF => {
Append[data, Rope.Concat[GetAndClear[data], "\n"]];
};
Ascii.
DEL => {
[] ¬ GetAndClear[data];
DelHit[data];
};
ENDCASE => {};
};
ENDCASE => {};
};
CreateXCommanderWidget:
PROC [connection:
REF ¬
NIL] = {
Ruler:
PROC []
RETURNS [XTk.Widget] = {
RETURN [ XTkWidgets.CreateRuler[[geometry: XTk.G[-1, 1]]] ]
};
data: Data ~ NEW[DataRec];
stream: XTk.Widget ~ XTkWidgets.CreateStreamWidget[[geometry: XTk.G[500, 200]]];
menuContainer: XTk.Widget ~ XTkWidgets.CreateXStack[];
mainContainer: XTk.Widget ~ XTkWidgets.CreateYStack[];
field: XTk.Widget ~ XTkWidgets.CreateField[text: ""];
stopper: XTk.Widget ~ XTkWidgets.CreateButton[text: "STOP!", hitProc: StopHit, registerData: data];
provide: XTk.Widget ~ XTkWidgets.CreateButton[text: " forward", hitProc: StuffHit, registerData: data, callData: $provide];
enter: XTk.Widget ~ XTkWidgets.CreateButton[text: " ENTER", hitProc: StuffHit, registerData: data, callData: $enter];
shell: XTk.Widget ~ XTkWidgets.CreateShell[
child: mainContainer,
windowHeader: Rope.Concat["XCommander ", Identification.Self[]],
iconName: "XCommander",
className: $XCommander
];
TRUSTED {Process.SetTimeout[@data.nonEmpty, Process.SecondsToTicks[10]]};
data.field ¬ field;
XTk.AddPermanentMatch[stream, [proc: EventProc, handles: Xl.CreateEventFilter[buttonPress], data: data], [buttonPress: TRUE]];
XTk.RegisterNotifier[field, $FieldCharInput, FilterChar, data];
XTk.RegisterNotifier[field, $HandwritingClientMessage, StuffHit, data];
XTk.RegisterNotifier[shell, $postWidgetDestruction, Destroy, data];
--
XTkWidgets.AppendChild[mainContainer, Ruler[]];
XTkWidgets.AppendChild[mainContainer, menuContainer];
XTkWidgets.AppendChild[mainContainer, Ruler[]];
XTkWidgets.AppendChild[mainContainer, field];
XTkWidgets.AppendChild[mainContainer, Ruler[]];
XTkWidgets.AppendChild[mainContainer, stream];
--
XTkWidgets.AppendChild[menuContainer, stopper];
XTkWidgets.AppendChild[menuContainer, provide];
XTkWidgets.AppendChild[menuContainer, enter];
--
XTkWidgets.SetFocusMethod[shell: shell, focusProtocol: true, inputHint: false];
XTkWidgets.BindScreenShell[shell, connection];
data.out ¬ XTkWidgets.CreateStream[stream];
data.cmd ¬ CommanderOps.CreateFromStreams[
in: IO.CreateStream[inputStreamProcs, data],
out: data.out
];
data.ctd ¬ CommanderBackdoor.GetCommandToolData[data.cmd];
data.ctd.Before ¬ CancelAbort;
data.ctd.After ¬ CancelAbort;
TRUSTED {Process.Detach[FORK Forked[data]]};
XTkWidgets.RealizeShell[shell];
};
XCommanderCommand: Commander.CommandProc = {
server: Rope.ROPE ¬ CommanderOps.NextArgument[cmd];
CreateXCommanderWidget[server !
Xl.connectionNotCreated => CommanderOps.Failed[why.reason]
]
};
XCommanderLoopCommand: Commander.CommandProc = {
delay: Process.Ticks ¬ Process.SecondsToTicks[10];
server: Rope.ROPE ¬ CommanderOps.NextArgument[cmd];
DO
Process.CheckForAbort[];
BEGIN
CreateXCommanderWidget[server ! Xl.connectionNotCreated => GOTO TryAgain];
RETURN;
EXITS TryAgain => {}
END;
Process.Pause[delay];
ENDLOOP;
};
inputStreamProcs:
REF
IO.StreamProcs ¬
IO.CreateStreamProcs[
variety: $input,
class: $XCommanderInputStream,
charsAvail: MyCharsAvail,
getChar: MyGetChar
];
Append:
PROC [data: Data, text: Rope.
ROPE] = {
EntryAppend:
ENTRY
PROC [data: Data, text: Rope.
ROPE] = {
data.ready ¬ Rope.Concat[data.ready, text];
BROADCAST data.nonEmpty
};
IO.PutRope[data.out, text];
EntryAppend[data, text];
};
MyGetChar:
PROC [self:
IO.
STREAM]
RETURNS [ch:
CHAR] = {
EntryGetChar:
ENTRY
PROC [data: Data, self:
IO.
STREAM]
RETURNS [ch:
CHAR] = {
WHILE Rope.Length[data.ready]<=0
DO
IF data.field.state=dead
OR data.destroyed
THEN {
RETURN WITH ERROR IO.EndOfStream[self];
};
IF data.rubout THEN EXIT;
WAIT data.nonEmpty;
ENDLOOP;
IF data.rubout
THEN {
data.rubout ¬ FALSE;
RETURN WITH ERROR IO.Rubout[self];
};
ch ¬ Rope.Fetch[data.ready, 0];
data.ready ¬ Rope.Substr[data.ready, 1]
};
data: Data ~ NARROW[self.streamData];
IF data.destroyed THEN IO.EndOfStream[self];
ch ¬ EntryGetChar[data, self];
};
MyCharsAvail:
PROC [self:
IO.
STREAM, wait:
BOOL]
RETURNS [n:
INT ¬ 0] = {
EntryCharsAvail:
ENTRY
PROC [data: Data, self:
IO.
STREAM, wait:
BOOL]
RETURNS [
INT] = {
DO
avail: INT ¬ Rope.Length[data.ready];
IF data.rubout OR data.field.state=dead OR data.destroyed THEN RETURN [MAX[avail, 1]];
IF avail>0 OR ~wait THEN RETURN [avail];
WAIT data.nonEmpty;
ENDLOOP;
};
data: Data ~ NARROW[self.streamData];
IF data.destroyed THEN RETURN[1];
n ¬ EntryCharsAvail[data, self, wait];
};
EventProc: Xl.EventProcType = {
ENABLE Xl.XError => GOTO oops;
data: Data ~ NARROW[clientData];
WITH event
SELECT
FROM
bp: Xl.ButtonPressEvent => {
XTkLabelsExtras.SetCharInsertionIndex[data.field, LAST[INT]];
XTkWidgets.SetFocus[XTk.RootWidget[data.field], bp.timeStamp, data.field];
};
ENDCASE => {};
EXITS oops => {};
};
Commander.Register["XCommander", XCommanderCommand, "Create a commander widget"];
Commander.Register["XCommanderRetry", XCommanderLoopCommand, "Create a commander widget; retry until success or aborted"];
END.