PlumbCommandsCommonImpl.mesa
Copyright Ó 1989, 1992 by Xerox Corporation. All rights reserved.
Peter B. Kessler, May 15, 1990 3:23 pm PDT
Norman Adams, June 8, 1990 2:17 pm PDT.
Spreitze, April 3, 1990 2:00 pm PDT
Brent Welch March 7, 1991 4:05 pm PST
Willie-s, June 16, 1992 4:59 pm PDT
Bier, March 11, 1993 6:10 pm PST
DIRECTORY
Args, Ascii, Basics, CharDisplays, Commander, DisplayControllers, EditedStream, FileNames, IO, PlumbCommandsCommon, Plumber, Process, Rope, TermProgs, TiogaOps, TIPLinking, TIPTableAccess, TIPTypes, TIPUser, TypeScript, UnixFileDescriptorStream, UnixTypes, ViewerClasses, ViewerEvents, ViewerIO, ViewerOps;
PlumbCommandsCommonImpl: CEDAR PROGRAM
IMPORTS
Args, Basics, CharDisplays, DisplayControllers, EditedStream, FileNames, IO, Plumber, Process, Rope, TermProgs, TiogaOps, TIPLinking, TIPTableAccess, TIPUser, TypeScript, UnixFileDescriptorStream, ViewerEvents, ViewerIO, ViewerOps
EXPORTS
PlumbCommandsCommon
~ {
TIPTable: TYPE ~ TIPTypes.TIPTable;
myTipTableFile: Rope.ROPE ¬ Rope.Concat[FileNames.CurrentWorkingDirectory[], "Plumber.tip"];
PlumbAndTermCommand: PUBLIC PROC [cmd: Commander.Handle, termCommand: BOOLEAN]
RETURNS [result: REF, msg: Rope.ROPE] ~ {
execP, ttyP, waitP, termP, debugP: BOOLEAN;
todo, termName: Rope.ROPE;
execArg, ttyArg, waitArg, termArg, debugArg, commandArg: Args.Arg;
[execArg, ttyArg, waitArg, debugArg, termArg, commandArg] ¬
Args.ArgsGet[ cmd: cmd, format: "-E%b-T%b-W%b-D%b-term%s[s"
! Args.Error => {
msg ¬ Rope.Concat["Badly formed arguments: ", reason];
GO TO argsError
};
];
termP ¬ termArg.ok;
termName ¬ IF termArg.ok THEN termArg.rope ELSE "sun";
execP ¬ execArg.ok;
ttyP ¬ ttyArg.ok;
waitP ¬ waitArg.ok;
debugP ¬ debugArg.ok;
IF commandArg.ok THEN {
todo ¬ commandArg.rope;
} ELSE {
-- didn't get a command so use LocalShell, set execP and ttyP as LocalShell needs
IF termCommand THEN {
todo ¬ Rope.Concat["LocalShell -f TERM=", termName];
execP ¬ TRUE;
ttyP ¬ TRUE;
} ELSE {
todo ¬ "LocalShell";
execP ¬ TRUE;
ttyP ¬ TRUE;
}
};
IF termCommand THEN
RETURN DoTermCommand[ cmd, execP, ttyP, waitP, termP, debugP, todo, termName ]
ELSE
RETURN DoPlumbCommand[ cmd, execP, ttyP, waitP, termP, debugP, todo, termName ];
EXITS argsError => RETURN [result: $Failure, msg: msg];
};
DoTermCommand: PROC [cmd: Commander.Handle, execP, ttyP, waitP, termP, debugP: BOOLEAN, todo, termName: Rope.ROPE] RETURNS [result: REF, msg: Rope.ROPE] ~ {
IF ~ Basics.IsBound[TermProgs.GetTerm] THEN
RETURN [result: $Failure, msg: "Terminal Emulator not loaded."];
{
term: TermProgs.Term ~ TermProgs.GetTerm[name: termName, cmd: cmd];
charDisplay: CharDisplays.CharDisplay;
displayController: DisplayControllers.DisplayController;
-- fill in the file descriptor when we get it back from plumber
driverStream: IO.STREAM ¬ UnixFileDescriptorStream.Create[ ];
IF term = NIL THEN RETURN [result: $Failure, msg: "Couldn't load terminal requested."];
charDisplay ¬ CharDisplays.Create[
class: CharDisplays.GetClass["Simple"], -- Formerly "UnselectedFlushedBufferedTioga"
client: NEW [CharDisplays.ClientRep ¬ [InitiateChangeDetails, driverStream]],
name: IO.PutFR[ "%g (%g)", IO.rope[todo], IO.rope[termName] ],
name: todo,
tipTableName: term.tipTableName,
det: term.det,
initData: driverStream
];
IF ~ execP THEN
todo ¬ IO.PutFR["TERM=%g %g", IO.rope[termName], IO.rope[todo] ];
displayController ¬ DisplayControllers.Create[ cd: charDisplay, cp: term.cp];
DisplayControllers.SetDriver[ displayController, driverStream ];
IF waitP THEN TRUSTED {
[] ¬ SwimUpstream[ viewer: charDisplay.viewer, toViewer: displayController.toDisplay, fromViewer: displayController.fromDisplay, command: todo, exec: execP, tty: ttyP, debug: debugP, driverStream: driverStream]
} ELSE
Process.Detach[FORK SwimUpstream[ viewer: charDisplay.viewer, toViewer: displayController.toDisplay, fromViewer: displayController.fromDisplay, command: todo, exec: execP, tty: ttyP, debug: debugP, driverStream: driverStream] ];
RETURN [result: NIL, msg: NIL]
}
};
InitiateChangeDetails: PROC [c: CharDisplays.Client, cd: CharDisplays.CharDisplay, new: CharDisplays.DisplayDetails] RETURNS [BOOL] ~ {
driverStream: IO.STREAM ~ NARROW[c.clientData];
cd.class.ChangeDetails[cd, new];
UnixFileDescriptorStream.SetTerminalSize[ driverStream, cd.det.lines, cd.det.columns ];
RETURN [TRUE]};
DoPlumbCommand: PROC [cmd: Commander.Handle, execP, ttyP, waitP, termP, debugP: BOOLEAN, todo, termName: Rope.ROPE] RETURNS [result: REF, msg: Rope.ROPE] ~ {
IF termP THEN
RETURN DoTermCommand[ cmd, execP, ttyP, waitP, termP, todo, termName ]
RETURN[result: $Failure, msg: "Use the 'term' command"]
ELSE {
toTypescript, fromTypescript: IO.STREAM;
plumbTipTable: TIPUser.TIPTable ¬ NIL;
typescript: TypeScript.TS ~
TypeScript.Create[info: [name: todo, column: right, iconic: TRUE]];
layer Plumber.tip on top of the typescript.
plumbTipTable ¬ TIPUser.InstantiateNewTIPTable[myTipTableFile
! TIPUser.InvalidTable => CONTINUE];
IF plumbTipTable # NIL THEN {
plumbTipTable.mouseTicks ¬ MIN[
plumbTipTable.mouseTicks, typescript.tipTable.mouseTicks];
TIPTableAccess.SetMouseTicks[plumbTipTable,
MIN[TIPTableAccess.GetMouseTicks[plumbTipTable],
TIPTableAccess.GetMouseTicks[typescript.tipTable]] ];
plumbTipTable.opaque ¬ FALSE;
TIPTableAccess.SetOpaque[plumbTipTable, FALSE];
[] ¬ TIPLinking.Append[early: plumbTipTable, late: typescript.tipTable];
typescript.tipTable ¬ plumbTipTable;
};
TiogaOps.SetNodeStyle[style: "ascii", node: TiogaOps.ViewerDoc[viewer: typescript]];
[in: fromTypescript, out: toTypescript] ¬ ViewerIO.CreateViewerStreams[
name: todo, viewer: typescript, editedStream: FALSE];
EditedStream.SetEcho[self: fromTypescript, echoTo: NIL];
toTypescript ¬ PlumberTypescriptCreate[out: toTypescript ];
IF waitP THEN TRUSTED {
[] ¬ SwimUpstream[ viewer: typescript, toViewer: toTypescript, fromViewer: fromTypescript, command: todo, exec: execP, tty: ttyP, debug: debugP, driverStream: NIL ]
} ELSE
Process.Detach[FORK SwimUpstream[ viewer: typescript, toViewer: toTypescript, fromViewer: fromTypescript, command: todo, exec: execP, tty: ttyP, debug: debugP, driverStream: NIL ] ];
RETURN [result: NIL, msg: NIL]
}
};
Only here because "discrimination on opaque types is unimplemented"
ConduitWrapper: TYPE = REF ConduitWrapperRep;
ConduitWrapperRep: TYPE = RECORD [ conduit: Plumber.Conduit ];
DestroyPlumberViewer: ViewerEvents.EventProc ~ {
PROC [viewer: Viewer, event: ViewerEvent, before: BOOL] RETURNS [abort: BOOLFALSE]
wrapper: ConduitWrapper ¬ NARROW[ViewerOps.FetchProp[viewer: viewer, prop: $PlumberConduit]];
IF event # destroy OR before # TRUE THEN ERROR;
Process.Detach[ FORK Plumber.Terminate[wrapper.conduit, $Normal] ];
RETURN [abort: FALSE];
};
SwimUpstream: PROCEDURE [
viewer: ViewerClasses.Viewer, toViewer: IO.STREAM, fromViewer: IO.STREAM,
command: Rope.ROPE, exec,tty,debug: BOOLEAN, driverStream: IO.STREAM]
RETURNS [] ~ {
wd: Rope.ROPE ~ FileNames.CurrentWorkingDirectory[];
conduit: Plumber.Conduit ~ Plumber.MakeConduit[
stdin:fromViewer, stdout:toViewer, stderr:toViewer, debug:debug, noisy: TRUE
];
RecordSourceFD: PROC [fd: UnixTypes.FileDescriptor] ~ {
IF driverStream # NIL THEN UnixFileDescriptorStream.SetFD[ driverStream, fd ];
};
WHILE viewer.menu = NIL AND viewer.parent # NIL DO viewer ¬ viewer.parent ENDLOOP;
ViewerOps.AddProp[viewer: viewer, prop: $PlumberConduit, val: NEW[ConduitWrapperRep ¬ [conduit: conduit]]];
[] ¬ ViewerEvents.RegisterEventProc[proc: DestroyPlumberViewer, event: ViewerEvents.ViewerEvent.destroy, filter: viewer, before: TRUE];
viewer.guardDestroy ¬ TRUE;
[] ¬ Plumber.SpawnWithConduit[ conduit: conduit, command: command, wd: wd, exec: exec, tty: tty, reportSourceFD: RecordSourceFD ];
viewer.guardDestroy ¬ FALSE;
RETURN;
};
Plumber TypeScript output streams
PlumberTypescriptStateRep: TYPE = RECORD [
out: IO.STREAM,
viewer: ViewerClasses.Viewer
];
PlumberTypescriptState: TYPE = REF PlumberTypescriptStateRep;
PlumberTypescriptCreate: PROC [out: IO.STREAM] RETURNS [IO.STREAM] ~ {
s: PlumberTypescriptState;
v: ViewerClasses.Viewer ¬ ViewerIO.GetViewerFromStream[stream: out];
IF NOT TypeScript.IsATypeScript[ts: v] THEN ERROR;
s ¬ NEW [ PlumberTypescriptStateRep ¬ [ out: out, viewer: v ] ];
RETURN [IO.CreateStream[PlumberTypescriptProcs, s]];
};
PlumberTypescriptPutChar: PROC [self: IO.STREAM, char: CHAR] ~ {
s: PlumberTypescriptState = NARROW[self.streamData];
SELECT char FROM
Ascii.BEL => ViewerOps.BlinkViewer[viewer: s.viewer, milliseconds: 50];
Ascii.BS => TypeScript.BackSpace[ts: s.viewer];
Ascii.TAB, Ascii.LF, IN [Ascii.SP..0176C] => IO.PutChar[s.out, char];
ENDCASE => NULL;
};
PlumberTypescriptPutBlock: PROC [self: IO.STREAM, block: REF READONLY TEXT, startIndex: NAT ¬ 0, count: NAT ¬ NAT.LAST] ~ {
s: PlumberTypescriptState = NARROW[self.streamData];
haveSpecial: BOOLEAN ¬ FALSE;
IF startIndex+count > block.maxLength THEN count ¬ block.length - startIndex;
FOR i: INT IN [startIndex..startIndex+count) DO
char: CHAR ¬ block[i];
haveSpecial ¬ NOT ((char IN [Ascii.SP..0176C]) OR (char=Ascii.TAB) OR (char=Ascii.LF));
IF haveSpecial THEN EXIT;
ENDLOOP;
IF haveSpecial THEN
MessageWindow.Append["|",FALSE]
ELSE
MessageWindow.Append[".",FALSE];
IF haveSpecial THEN
FOR i: INT IN [startIndex..startIndex+count) DO
PlumberTypescriptPutChar[ self, block[i] ]
ENDLOOP
ELSE
IO.PutBlock[self: s.out, block: block, startIndex: startIndex, count: count];
};
PlumberTypescriptProcs: REF IO.StreamProcs = IO.CreateStreamProcs [
variety: $output,
class: $PlumberTypescriptOutput,
putBlock: PlumberTypescriptPutBlock,
putChar: PlumberTypescriptPutChar
];
}.