[Cyan]<DATools6.0>IMS>IMSCommandImpl.mesa!5

IMSCommandImpl.mesa

Created by: Neil Gunther on September 23, 1985 1:05:17 pm PDT

Last edited by Neil Gunther, December 12, 1985 4:16:48 pm PST

DIRECTORY

Ascii USING [BS, DEL, BEL, ControlA, TAB, CR, SP],

Commander USING [CommandProc, Register],

CommandTool USING [ArgumentVector, Failed, Parse],

Convert USING [RopeFromCard],

EditedStream USING [SetEcho],

FS USING [Error, StreamOpen],

GPIB USING [DeviceAddr, maxWriteBuffer, ReadDevice, InitializeController, SelectedDeviceClear, InterfaceClear, FinalizeController, WriteDevice],

IO,

IOClasses USING [CreateDribbleOutputStream],

List USING [Length, Remove],

Loader USING [BCDBuildTime],

Menus USING [AppendMenuEntry, CreateEntry, FindEntry, MenuEntry,
MenuProc, ReplaceMenuEntry],

Process USING [Abort, Detach, InvalidProcess],

RefText USING [AppendChar, New],

Rope,

RuntimeError USING [BoundsFault],

TIPUser USING [InstantiateNewTIPTable, RegisterTIPPredicate, TIPPredicate, TIPTable],

TypeScript USING [BackSpace, ChangeLooks, Create, InsertCharAtFrontOfBuffer, TS],

ViewerClasses USING [Viewer],

ViewerEvents USING [EventProc, EventRegistration, RegisterEventProc, UnRegisterEventProc],

ViewerIO USING [CreateViewerStreams],

ViewerOps USING [AddProp, FetchProp, PaintViewer],

ViewerTools USING [GetSelectedViewer, SetSelection];

IMSCommandImpl: CEDAR MONITOR LOCKS h.LOCK USING h: Handle

IMPORTS Commander, CommandTool, Convert, EditedStream, FS, GPIB, IO, IOClasses, List, Loader, Menus, Process, RefText, Rope, RuntimeError, TIPUser, TypeScript, ViewerEvents, ViewerIO, ViewerOps, ViewerTools

SHARES Menus, ViewerClasses, ViewerOps = BEGIN

Handle: TYPE = REF IMSCommandInstanceRecord;

State: TYPE = {idle, starting, running, closing, destroy};

bufferType: TYPE = {sender, receiver};

DisconnectChar: CHAR = 220C;

AbortChar: CHAR = 221C;

ConnectChar: CHAR = 222C;

IMSCommandInstanceRecord: TYPE = MONITORED RECORD [

ts: TypeScript.TS, -- the primary typescript

state: State ← idle,

lorc: CHAR ← 'c,

logFileName: Rope.ROPE,

logStream: IO.STREAM,

argv: CommandTool.ArgumentVector,

pleaseStop: BOOL ← FALSE,

DeviceHandlerStopped: BOOL ← FALSE,

ControllerStopped: BOOL ← FALSE,

inDestroy: BOOL ← FALSE,

ControllerToDeviceProcess: PROCESS,

deviceName: Rope.ROPE ← "MasterUnit", --default name

addr: GPIB.DeviceAddr ← 1, -- default address

useOldHost: BOOL ← FALSE,

destroyOnClose: BOOL ← FALSE,

connectionOpen: BOOL ← FALSE,

in: IO.STREAM,

origOut: IO.STREAM,

out: IO.STREAM,

tipTable: TIPUser.TIPTable,

oldSplit: Menus.MenuEntry ← NIL

];

logFileNumber: INT ← 0;

chatInstanceList: LIST OF REF ANY ← NIL;

destroyEvent: ViewerEvents.EventRegistration ← NIL;

closeEvent: ViewerEvents.EventRegistration ← NIL;

chatTipTable: TIPUser.TIPTable;

sendBuffer: REF TEXT ← RefText.New[GPIB.maxWriteBuffer];

recvBuffer: Rope.ROPE;

DeviceHandler: INTERNAL PROC [h: Handle] = {

ENABLE ANY => GOTO Cleanup;

aborting: SIGNAL = CODE;

c: CHAR;

IF h.pleaseStop OR h.state # running THEN GOTO Cleanup;

ClearBuffer[receiver];

TRUSTED {recvBuffer ← GPIB.ReadDevice[h.addr]};

IF Rope.Match["End", recvBuffer] THEN h.out.PutF["%g\n", IO.rope[recvBuffer]]

ELSE {

FOR i: INT IN [0..Rope.Length[recvBuffer]) DO

c ← Rope.Fetch[recvBuffer, i];

IF c = '\l THEN LOOP;

SELECT c FROM

Ascii.BEL => NULL;

Ascii.ControlA, Ascii.BS => TypeScript.BackSpace[h.ts];

Ascii.TAB, Ascii.CR, IN[Ascii.SP..0176C] => h.out.PutChar[c];

ENDCASE => NULL;

ENDLOOP;

};

EXITS

Cleanup => h.DeviceHandlerStopped ← TRUE;

};

StartUpConnection: PROC [h: Handle] = {

ENABLE UNWIND => h.state ← idle;

Laddr: LONG CARDINAL ← h.addr;

h.state ← starting;

h.pleaseStop ← FALSE;

h.DeviceHandlerStopped ← FALSE;

h.ControllerStopped ← FALSE;

ViewerTools.SetSelection[h.ts, NIL];

h.out.PutF["\nIMSCommand Viewer of %t.\n", IO.time[Loader.BCDBuildTime[]]];

IF h.logStream # NIL THEN h.out.PutF["Log file: %g\n", IO.rope[h.logFileName]]

ELSE h.out.PutF["No log file.\n"];

OpenConnection[h];

h.state ← running;

IF h.connectionOpen THEN PutPrompt[h];

};

OpenConnection: PROC [h: Handle] = TRUSTED {

ENABLE {ANY => GOTO attemptFailed};

Laddr: LONG CARDINAL ← h.addr;

h.out.PutF["Opening connection to %g@gpib[%g%g]... ", IO.rope[h.deviceName], IO.rope[IF h.addr<9 THEN "0" ELSE ""], IO.card[Laddr]];

IF GPIB.InitializeController[] THEN {

GPIB.InterfaceClear[];

GPIB.SelectedDeviceClear[h.addr];

h.out.PutF["open.\n"];

h.connectionOpen ← TRUE;

-- in viewer herald

SetName[h, Rope.Cat["IMS Commander for ", h.deviceName, IF h.addr<9 THEN "@gpib[0" ELSE "@gpib[", Convert.RopeFromCard[Laddr], "]"]];

}

ELSE { h.out.PutF["\nUnknown GPIB address.\n"]; h.connectionOpen ← FALSE;};

EXITS

attemptFailed => {

h.out.PutF[" I don't see any XBus on this machine! ... Connection attempt aborted.\n"];

h.connectionOpen ← FALSE;

};

CloseConnection: PROC [h: Handle, print: BOOL] = TRUSTED {

{ENABLE ANY => GOTO failed;};

IF NOT h.connectionOpen AND print THEN {

h.out.PutF["\nNo connection opened!\n"];

RETURN;

};

h.pleaseStop ← TRUE;

IF print THEN h.out.PutF["\nClosing connection to %s", IO.rope[h.deviceName] ! IO.Error => CONTINUE];

IF h.connectionOpen THEN GPIB.FinalizeController[];

IF print THEN h.out.PutF[" ... Closed.\n" ! IO.Error => CONTINUE];

IF h.logStream # NIL THEN h.logStream.Flush[];

h.state ← idle;

SetName[h, "IMS Commander"];

h.connectionOpen ← FALSE;

EXITS

failed => NULL;

};

SetName: PROC [h: Handle, r: Rope.ROPE] = { -- in Viewer herald

InternalSetName: PROC [v: ViewerClasses.Viewer] = {

v.name ← r; ViewerOps.PaintViewer[viewer: v, hint: caption]};

EnumerateSplits[h.ts, InternalSetName ! ANY => CONTINUE];

};

IMSCommandMain: Commander.CommandProc = TRUSTED {

ENABLE RuntimeError.BoundsFault => GOTO invalidGPIB;

h: Handle ← NEW[IMSCommandInstanceRecord ← []];

execOut: IO.STREAM ← cmd.out;

switchChar: CHAR;

i: NAT ← 2;

h.argv ← CommandTool.Parse[cmd ! CommandTool.Failed => {msg ← errorMsg; CONTINUE; }];

IF h.argv = NIL THEN RETURN;

WHILE i < h.argv.argc DO

IF h.argv[i].Length[] > 1 THEN

SELECT h.argv[i].Fetch[0] FROM

'- => {

switchChar ← h.argv[i].Fetch[1];

SELECT switchChar FROM

'@ => h.addr ← IO.GetCard[IO.RIS[h.argv[i+1]]];

'd => h.destroyOnClose ← TRUE;

ENDCASE => h.lorc ← switchChar;

};

ENDCASE => execOut.PutF["IMSCommander: unknown command: %s.\n", IO.rope[h.argv[i]]];

i ← i + 1;

ENDLOOP;

IF h.logFileName.Length[] = 0 THEN {

h.logFileName ← IO.PutFR["IMSCommander%d.log", IO.int[logFileNumber]];

logFileNumber ← logFileNumber + 1;

};

h.ts ← TypeScript.Create[info: [name: "IMS Commander", iconic: FALSE], paint: TRUE];

TypeScript.ChangeLooks[h.ts, 'f]; -- look fixed pitch Gacha

h.ts.file ← h.logFileName;

h.ts.icon ← typescript;

create log file

h.logStream ← FS.StreamOpen[fileName: h.logFileName, accessOptions: $create ! FS.Error => IF error.group = user THEN {

execOut.PutF["IMSCommander : Cannot open %s\n", IO.rope[h.logFileName]];

CONTINUE;

}];

plug in IMSCommander TIP table.

chatTipTable.link ← h.ts.tipTable;

chatTipTable.opaque ← FALSE;

h.tipTable ← h.ts.tipTable ← chatTipTable;

[in: h.in, out: h.origOut] ← ViewerIO.CreateViewerStreams[name: "IMSCommander.log", viewer: h.ts, editedStream: FALSE];

h.out ← h.origOut;

IF h.logStream # NIL THEN h.out ← IOClasses.CreateDribbleOutputStream[output1: h.origOut, output2: h.logStream];

EditedStream.SetEcho[h.in, NIL];

IF h.argv.argc > 1 THEN {

h.deviceName ← h.argv[1];

h.useOldHost ← TRUE;

IF h.lorc = 'c THEN TypeScript.InsertCharAtFrontOfBuffer[ts: h.ts, char: ConnectChar];

};

IF List.Length[chatInstanceList] = 0 THEN {

closeEvent ← ViewerEvents.RegisterEventProc[proc: MyClose, event: close];

destroyEvent ← ViewerEvents.RegisterEventProc[proc: MyDestroy, event: destroy]

};

chatInstanceList ← CONS[h, chatInstanceList];

Menus.AppendMenuEntry[menu: h.ts.menu, entry: Menus.CreateEntry[name: "Disconnect", proc: MyDisconnect, clientData: h, fork: TRUE, documentation: "Close GPIB connection"]];

Menus.AppendMenuEntry[menu: h.ts.menu, entry: Menus.CreateEntry[name: "Connect", proc: MyConnect, clientData: h, documentation: "Open GPIB Connection to selected host"]];

Menus.AppendMenuEntry[menu: h.ts.menu, entry: Menus.CreateEntry[name: "FlushLog", proc: MyFlushLog, clientData: h, documentation: "Flush log file to disk."]];

Menus.AppendMenuEntry[menu: h.ts.menu, entry: Menus.CreateEntry[name: "STOP!", proc: MyStop, clientData: h, fork: TRUE, documentation: "Stop everything!"]];

h.oldSplit ← Menus.FindEntry[menu: h.ts.menu, entryName: "Split"];

Menus.ReplaceMenuEntry[menu: h.ts.menu, oldEntry: h.oldSplit, newEntry: Menus.CreateEntry[name: "Split", proc: MySplit, fork: TRUE, clientData: h, documentation: "Split window"]];

ViewerOps.AddProp[h.ts, $IMSCommandToolData, h];

ViewerOps.PaintViewer[viewer: h.ts, hint: all];

h.ControllerToDeviceProcess ← FORK ControllerToDevice[h];

Process.Detach[h.ControllerToDeviceProcess];

EXITS

invalidGPIB => cmd.out.PutF["IMSCommand: Invalid GPIB address!\n"];

};

PutPrompt: PROC [h: Handle] = {

h.out.PutF["%lIM$:%l ", IO.rope["b"], IO.rope["B"]];

ClearBuffer[sender];

ClearBuffer[receiver];

};

ControllerToDevice: ENTRY PROC [h: Handle] = TRUSTED {{

-- watches keyboard & viewer buttons

char: CHAR;

waitingForEnd: BOOL ← FALSE;

ClearBuffer[sender];

DO ENABLE {

ABORTED => GOTO abort;

IO.Error => {

last viewer destroyed !

Close connection and exit

IF h.connectionOpen THEN CloseConnection[h, FALSE];

GOTO ioError;

}};

char ← h.in.GetChar[];

IF h.inDestroy THEN {

CloseConnection[h, FALSE];

GOTO destroy};

SELECT char FROM

AbortChar => {

IF h.state = running THEN CloseConnection[h, TRUE]};

DisconnectChar => {

IF h.state = running THEN CloseConnection[h, TRUE]};

ConnectChar => {

IF h.state = idle THEN {

h.lorc ← 'c;

StartUpConnection[h];

}};

Ascii.BS, Ascii.DEL => {

IF sendBuffer.length = 0 THEN LOOP; --avoid smashing prompt

TypeScript.BackSpace[h.ts];

sendBuffer.length ← sendBuffer.length-1};

ENDCASE => {

SELECT h.state FROM

running => {

h.out.PutChar[char];

sendBuffer ← RefText.AppendChar[sendBuffer, char];

IF char = '\n THEN { --IMS strips this

sendBuffer ← RefText.AppendChar[sendBuffer, '\l]; --IMS terminator

--handle a multi-line commands

--ship each line out asap to avoid buffer o/flow

IF Rope.Match["*#TXT*", Rope.FromRefText[sendBuffer], FALSE] AND NOT waitingForEnd THEN {

waitingForEnd ← TRUE;

--ship multi-line header

GPIB.WriteDevice[h.addr, Rope.FromRefText[sendBuffer]];

ClearBuffer[sender];

LOOP;

};

IF waitingForEnd THEN {

IF Rope.Match["*END*", Rope.FromRefText[sendBuffer], FALSE] THEN {

waitingForEnd ← FALSE;

--multi-line trailer; treat as normal command line

}

ELSE { --ship current line of multi-line command

GPIB.WriteDevice[h.addr, Rope.FromRefText[sendBuffer]];

ClearBuffer[sender];

LOOP};

};

GPIB.WriteDevice[h.addr, Rope.FromRefText[sendBuffer]];

ClearBuffer[sender];

DeviceHandler[h];

PutPrompt[h]}};

ENDCASE => h.out.PutChar[char];

};

ENDLOOP;

EXITS

ioError, abort, destroy => {IF h.logStream # NIL THEN h.logStream.Close[]};

}};

ClearBuffer: PRIVATE PROC [buffer: bufferType] = {

SELECT buffer FROM

sender => {sendBuffer.length ← 0};

receiver => { };

ENDCASE;

};

--Menu & Window procs

MyDestroy: ViewerEvents.EventProc = {

This EventProc exits only to keep h.ts pointing to a valid copy of the typescript

viewer. It is only needed for the use of TypeScript.InsertCharAtFrontOfBuffer.

h: Handle ← NARROW[ViewerOps.FetchProp[viewer, $IMSCommandToolData]];

IF h = NIL THEN RETURN;

IF NumSplit[viewer] = 1 THEN { -- last one

h.inDestroy ← TRUE;

chatInstanceList ← List.Remove[h, chatInstanceList];

IF List.Length[chatInstanceList] = 0 THEN {

ViewerEvents.UnRegisterEventProc[proc: destroyEvent, event: destroy];

ViewerEvents.UnRegisterEventProc[proc: closeEvent, event: close];

};

}

ELSE IF NumSplit[viewer] > 1 THEN {

IF viewer = h.ts THEN {

Another: PROC [v: ViewerClasses.Viewer] = {

IF v # viewer THEN h.ts ← v;

};

EnumerateSplits[viewer, Another];

}};

};

MyClose: ViewerEvents.EventProc = {

h: Handle ← NARROW[ViewerOps.FetchProp[viewer, $IMSCommandToolData]];

IF h = NIL THEN RETURN;

TypeScript.InsertCharAtFrontOfBuffer[ts: h.ts, char: DisconnectChar];

};

MyConnect: Menus.MenuProc = {

viewer: TypeScript.TS ← NARROW[parent];