
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.


    آ  
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
‌ت	p  –(cedarcode) style•NewlineDelimiter
™ codeڑœ™Kڑœ
دeœ7™BKڑœ3™3K™/—Kک ڑدk	œک
KڑœI‍œDکڈ—ڑدnœ‍œ‍کKڑ‍œ‍œکKڑ‍œ=‍œEک‹—Kڑ‍œکKک Kڑœ‍œ‍œ	کڑœ	‍œ‍œک"Kڑœ‍œکKڑœ)‍œک-Kڑœ‍œکKڑœ‍œ‍œکKڑœ
‍	œکKڑœ‍œ‍œکKڑœ‍œ‍œکKڑœ‍œ‍œ‍کKک—Kک ڑںœ‍œک-KڑœSکSڑ‍œ‍œ‍œکKڑœ‍œ‍œکڑ‍œ‍œ‍œکKڑœ	‍œکڑ‍œ	‍œ‍œکKڑœ8‍œکB—Kک—Kک—Kک—ڑںœ‍œکڑںœ‍œکKڑœ!ک!Kڑœ‍œکKڑœ
‍œ‍œکKڑœ‍œ‍œکKک1Kڑ‍œ.ک0Kڑ‍œ‍œ‍œ1کGKڑœک—Kڑœ‍œ‍œ*دc>ک‰KڑœکKک —ڑںœک!ڑں	œ‍œ‍œک&Kڑ‍œ‍œ‍œکKڑœ‍œکKڑœ‍œکKڑœ+ک+Kڑ‍	œکKڑœک—Kڑœ‍œک"KکKکKک —ڑںœ‍œ‍œک#Kڑ‍œ‍œ‍œکKڑœ‍œکKڑœ‍œکKڑ‍	œکJکJک —ڑںœ‍œ‍œ‍œک<Kک&Kڑœ#ک#KڑœکKک —ڑںœک"Kڑœ‍œک"ڑ‍œ
‍œ‍کڑœ‍œکڑ‍œ
‍کKک,Kک=Kڑ‍œک——ڑ‍کڑ‍œ‍کKک9Kڑ‍œک——Kڑ‍œک—KڑœکKک —ڑںœک!Kڑœ‍œک"Kڑœ‍کKک—Kک ڑں
œک$Kڑœ‍œک"ڑ‍œ
‍œ‍کڑœ‍œ‍œ‍œک*Kڑœ‍œکڑ‍œ‍کڑœ‍œ‍œکJک3Jک—ڑœ‍œکJکJکJک—Kڑ‍œک—Kک—Kڑ‍œک—Kک—ڑںœ‍œ‍œ‍œک8ڑںœ‍œ‍œک'Kڑ‍œ5ک;Kڑœک—Kڑœ‍œ
کKکPKڑœ6ک6Kڑœ6ک6Kڑœ5ک5KڑœcکcKک{Kکuڑœ+ک+KڑœکKک@KڑœکKکKک—Kڑ‍œBکIKکKڑœw‍œک~Kک?KکGKکCKڑœکKڑœ/ک/Kڑœ5ک5Kڑœ/ک/Kڑœ-ک-Kڑœ/ک/Kڑœ.ک.KڑœکKڑœ/ک/Kک/Kک-KڑœکKکOKڑœ.ک.Kک+ک*Kڑœ‍œ'ک-KڑœکKڑœک—Kک:KکKکKڑ‍œ‍œک,KڑœکKک—Kک ڑںœک,Kڑœ‍œ"ک3ڑœ ک Kڑœ:ک:Kڑœک—KکKک —ڑںœک0Kک2Kڑœ‍œ"ک3ڑ‍کKکڑ‍کKڑœ;‍œکJKڑ‍œکKڑ‍œکKڑ‍œک—KکKڑ‍œک—Kک—K–"cedar" styleک –"cedar" styleڑœ‍œ‍œ‍œک<K–"cedar" styleکK–"cedar" styleڑœکK–"cedar" styleڑœکK–"cedar" styleڑœکK–"cedar" styleڑœکK–"cedar" styleک —ڑںœ‍œ‍œک.ڑںœ‍œ‍œ‍œک9Kک+Kڑ‍	œکKک—Kڑ‍œکKکKک—Kک ڑں	œ‍œ‍œ‍œ‍œ‍œک8ڑںœ‍œ‍œ‍œ‍œ‍œ‍œکMڑ‍œ‍ک#ڑ‍œ‍œ‍œک1Kڑ‍œ‍œ‍œ‍œک'Kک—Kڑ‍œ‍œ‍œکKڑ‍œکKڑ‍œک—ڑ‍œ‍œکKڑœ‍œکKڑ‍œ‍œ‍œ‍œک"Kک—KکKک'Kک—Kڑœ‍œک%Kڑ‍œ‍œ‍œک,KکKکKک —ڑںœ‍œ‍œ‍œ‍œ‍œ‍œ	کIڑںœ‍œ‍œ‍œ‍œ‍œ‍œ‍œکWڑ‍کKڑœ‍œک%Kڑ‍œ‍œ‍œ‍œ‍œ‍œکVKڑ‍œ	‍œ‍œ‍œ	ک(Kڑ‍œکKڑ‍œک—Kڑœک—Kڑœ‍œک%Kڑ‍œ‍œ‍œک!Kک&KڑœکKک —ڑں	œکKڑ‍œ‍œکKڑœ‍œک ڑ‍œ‍œ‍ککKڑœ2‍œ‍œک=KکJKک—Kڑ‍œک—Kڑ‍œکKک—Kک KکQKکzKڑ‍œکKک— …—    ¾  'ً  