[_CDCSL_93-16_]<1>Cedar>release>TerminalEmulator>EmTermCapImpl.mesa

EmTermCapImpl.Mesa

Last Edited by: Spreitzer, March 14, 1985 11:51:46 am PST

DIRECTORY Ascii, Atom, Basics, BasicTime, CharDisplays, Convert, DisplayControllers, EmTermCap, FS, IO, OrderedSymbolTableRef, Rope, TermCaps;

EmTermCapImpl: CEDAR PROGRAM

IMPORTS Atom, DisplayControllers, IO, Rope, TermCaps

EXPORTS EmTermCap

= {OPEN CharDisplays, DisplayControllers, TermCaps;

AtomList: TYPE = EmTermCap.AtomList;

Cant: PUBLIC ERROR [msg: ROPE] = CODE;

NumChars: INT ¬ 1 + (LAST[CHAR] - FIRST[CHAR]);

MakeTermController: PUBLIC PROC [term: Term, allowPartial: BOOL ¬ FALSE] RETURNS [cp: ControlProgram, det: DisplayDetails, unGrokked: AtomList] = {

tabStr: ROPE ¬ NIL;

tabDat: ATOM ¬ $dontTouch;

PerCap: PROC [cap: Cap] RETURNS [stop: BOOL] = {

Int: PROC RETURNS [i: INT] = {

WITH cap.val SELECT FROM

ri: RefInt => RETURN [ri];

ENDCASE => Cant[cap.name.Cat[" not an int"]]};

Str: PROC RETURNS [r: ROPE] = {

WITH cap.val SELECT FROM

s: String => RETURN [s.str];

ENDCASE => Cant[cap.name.Cat[" not a str"]]};

key: ATOM ¬ Atom.MakeAtom[cap.name];

stop ¬ FALSE;

WITH cap.val SELECT FROM

s: String => {IF s.str.Length[] = 0 AND s.pad = 0.0 THEN RETURN};

ENDCASE;

SELECT key FROM

$ae => NULL--ignore alt char set--;

$al => AddInstruction[cp, LIST[Str[]], [Line, $ins]];

$am => det.autoMargins ¬ TRUE;

$as => NULL--ignore alt char set--;

$bc => AddInstruction[cp, LIST[Str[]], [MC, $left]];

$bl => AddInstruction[cp, LIST[Str[]], flash];

$bs => AddInstruction[cp, LIST["\010"], [MC, $left]];

$cd => AddInstruction[cp, LIST[Str[]], [ClrTo, $eos]];

$ce => AddInstruction[cp, LIST[Str[]], [ClrTo, $eol]];

$ch => AddInstruction[cp, CMProg[Str[], FALSE, TRUE], [CM, $h]];

$cl => AddInstruction[cp, LIST[Str[]], clearScreen];

$cm => AddInstruction[cp, CMProg[Str[], TRUE, TRUE], [CM, $hv]];

$co => det.columns ¬ Int[];

$cr => AddInstruction[cp, LIST[Str[]], cr];

$cv => AddInstruction[cp, CMProg[Str[], TRUE, FALSE], [CM, $v]];

$dB, $dC, $dF, $dN, $dT => NULL--ignore delay specs--;

$dc => AddInstruction[cp, LIST[Str[]], deleteChar];

$dl => AddInstruction[cp, LIST[Str[]], [Line, $del]];

$dm => NULL--try ignoring delete mode shifts--;

$do => AddInstruction[cp, LIST[Str[]], [MC, $down]];

$ed => NULL--try ignoring delete mode shifts--;

$ei => AddInstruction[cp, LIST[Str[]], [SM, $insCharOff]];

$eo => NULL --always true--;

$ho => AddInstruction[cp, LIST[Str[]], home];

$hz => NULL --why not?--;

$ic => AddInstruction[cp, LIST[Str[]], insertSpace];

$if => NULL;

$im => AddInstruction[cp, LIST[Str[]], [SM, $insCharOn]];

$is => NULL;

$ff => AddInstruction[cp, LIST[Str[]], clearScreen];

$kl, $kr, $ku, $kd, $kh => NULL-- no keypad here--;

$kb, $kh, $kn => NULL;

$k0, $k1, $k2, $k3, $k4, $k5, $k6, $k7, $k8, $k9 => NULL--no fn keys--;

$l0, $l1, $l2, $l3, $l4, $l5, $l6, $l7, $l8, $l9 => NULL--no fn keys--;

$ko => NULL--who cares?--;

$le => AddInstruction[cp, LIST[Str[]], [MC, $left]];

$li => det.lines ¬ Int[];

$ma => NULL--ignore arrow map--;

$mi => NULL;

$ms => NULL--always true--;

$MT => NULL;

$nd => AddInstruction[cp, LIST[Str[]], [MC, $right]];

$nl => AddInstruction[cp, LIST[Str[]], [MC, $down]];

$pc => AddInstruction[cp, LIST[Str[]], null];

$pt => NULL;

$se => AddInstruction[cp, LIST[Str[]], [SM, $standoutOff]];

$so => AddInstruction[cp, LIST[Str[]], [SM, $standoutOn]];

$sr => AddInstruction[cp, LIST[Str[]], scrollBack];

$ta => tabStr ¬ Str[];

$uc => AddInstruction[cp, LIST[Str[]], uc];

$ue => AddInstruction[cp, LIST[Str[]], [SM, $underlineOff]];

$up => AddInstruction[cp, LIST[Str[]], [MC, $up]];

$us => AddInstruction[cp, LIST[Str[]], [SM, $underlineOn]];

$vb => AddInstruction[cp, LIST[Str[]], flash];

$xs => NULL;

$xt => tabDat ¬ $blanken;

ENDCASE => IF allowPartial

THEN unGrokked ¬ CONS[key, unGrokked]

ELSE Cant[IO.PutFR["Can't do feature: %g", IO.rope[cap.name]]];

};

cp ¬ NewControlProgram[];

det.autoMargins ¬ FALSE;

unGrokked ¬ NIL;

EnumerateCaps[term, PerCap];

IF tabStr.Length[] > 0 THEN AddInstruction[cp, LIST[tabStr], [Tab, tabDat]];

};

cr: Action ¬ [CR];

CR: PROC [dc: DisplayController, clientData: REF ANY] =

{dc.cd.class.CursorMove[dc.cd, 0, 0, FALSE, FALSE]};

home: Action ¬ [Home];

Home: PROC [dc: DisplayController, clientData: REF ANY] =

{dc.cd.class.CursorMove[dc.cd, 0, 0, FALSE]};

scrollBack: Action ¬ [ScrollBack];

ScrollBack: PROC [dc: DisplayController, clientData: REF ANY] = {

oldLine: INT ¬ dc.cd.line;

oldCol: INT ¬ dc.cd.col;

dc.cd.class.CursorMove[cd: dc.cd, line: dc.cd.det.lines-1, col: 0];

dc.cd.class.Line[dc.cd, FALSE];

dc.cd.class.CursorMove[cd: dc.cd, line: 0, col: 0];

dc.cd.class.Line[dc.cd, TRUE];

dc.cd.class.CursorMove[cd: dc.cd, line: oldLine, col: oldCol];

};

clearScreen: Action ¬ [ClearScreen];

ClearScreen: PROC [dc: DisplayController, clientData: REF ANY] = {

dc.cd.class.ClearAll[dc.cd];

dc.cd.class.CursorMove[dc.cd, 0, 0];

};

deleteChar: Action ¬ [DeleteChar];

DeleteChar: PROC [dc: DisplayController, clientData: REF ANY] =

{dc.cd.class.DeleteChar[dc.cd]};

uc: Action ¬ [UC];

UC: PROC [dc: DisplayController, clientData: REF ANY] = {

dc.cd.class.Emphasize[dc.cd, underline, TRUE];

dc.cd.class.CursorMove[dc.cd, 0, 1, TRUE];

};

ClrTo: PROC [dc: DisplayController, clientData: REF ANY] =

{where: Where;

SELECT clientData FROM

$eos => where ¬ EndOfScreen;

$eol => where ¬ EndOfLine;

ENDCASE => ERROR;

dc.cd.class.ClearTo[dc.cd, where]};

MC: PROC [dc: DisplayController, clientData: REF ANY] =

{dLine, dCol: INT ¬ 0;

SELECT clientData FROM

$down => dLine ¬ 1;

$up => dLine ¬ -1;

$right => dCol ¬ 1;

$left => dCol ¬ -1;

ENDCASE => ERROR;

dc.cd.class.CursorMove[dc.cd, dLine, dCol, TRUE]};

CMProg: PROC [r: ROPE, doLine, doCol: BOOL] RETURNS [sl: StepList] = {

tl: StepList ¬ NIL;

Append: PROC [s: Step] = {

this: StepList ¬ LIST[s];

IF tl = NIL THEN sl ¬ this ELSE tl.rest ¬ this;

tl ¬ this};

rs: IO.STREAM ¬ IO.RIS[r];

d: DecodeRep ¬ [line];

toDo: LIST OF RegID ¬ NIL;

Do: PROC = {

d.reg ¬ toDo.first;

Append[NEW [DecodeRep ¬ d]];

toDo ¬ toDo.rest;

};

IF doCol THEN toDo ¬ CONS[col, toDo];

IF doLine THEN toDo ¬ CONS[line, toDo];

WHILE NOT rs.EndOf[] DO

char: CHAR ¬ rs.GetChar[];

SELECT char FROM

'% => {

IF rs.EndOf[] THEN {Append[Rope.FromChar[char]]; EXIT};

char ¬ rs.GetChar[];

SELECT char FROM

'd => {d.base ¬ 10; d.org ¬ '0; d.len ¬ 0; Do[]};

'2 => {d.base ¬ 10; d.org ¬ '0; d.len ¬ 2; Do[]};

'3 => {d.base ¬ 10; d.org ¬ '0; d.len ¬ 3; Do[]};

'. => {d.base ¬ NumChars; d.org ¬ 0C; d.len ¬ 1; Do[]};

'r => {toDo ¬ CONS[toDo.rest.first, CONS[toDo.first, toDo.rest.rest]]};

'i => d.offset ¬ 1;

'% => Append[Rope.FromChar[char]];

'+ => {

IF rs.EndOf[] THEN {Append[Rope.FromChar[char]]; EXIT};

char ¬ rs.GetChar[];

d.base ¬ NumChars; d.org ¬ char; d.len ¬ 1; Do[];

};

ENDCASE => ERROR;

};

ENDCASE => Append[Rope.FromChar[char]];

ENDLOOP;

rs.Close[];

};

CM: PROC [dc: DisplayController, clientData: REF ANY] =

{doLine, doCol: BOOL ¬ TRUE;

SELECT clientData FROM

$h => doLine ¬ FALSE;

$v => doCol ¬ FALSE;

$hv => NULL;

ENDCASE => ERROR;

dc.cd.class.CursorMove[dc.cd, dc.cps.regs[line], dc.cps.regs[col], FALSE, doLine, doCol]};

Line: PROC [dc: DisplayController, clientData: REF ANY] = {

insert: BOOL ¬ SELECT clientData FROM

$ins => TRUE,

$del => FALSE,

ENDCASE => ERROR;

dc.cd.class.Line[dc.cd, insert]};

SM: PROC [dc: DisplayController, clientData: REF ANY] = {

mode: Mode;

on: BOOL;

SELECT clientData FROM

$insCharOn => {mode ¬ insertChar; on ¬ TRUE};

$insCharOff => {mode ¬ insertChar; on ¬ FALSE};

$underlineOn => {mode ¬ underline; on ¬ TRUE};

$underlineOff => {mode ¬ underline; on ¬ FALSE};

$standoutOn => {mode ¬ standout; on ¬ TRUE};

$standoutOff => {mode ¬ standout; on ¬ FALSE};

ENDCASE => ERROR;

dc.cd.class.SetMode[dc.cd, mode, on]};

insertSpace: Action ¬ [InsertSpace, NIL];

InsertSpace: PROC [dc: DisplayController, clientData: REF ANY] = {

news: BOOL ¬ PushMode[dc.cd, insertChar];

line: INT ¬ dc.cd.line;

col: INT ¬ dc.cd.col;

dc.cd.class.TakeChar[dc.cd, Ascii.SP];

PopMode[dc.cd, insertChar, news];

dc.cd.class.CursorMove[dc.cd, 0, -1, TRUE];

};

PushMode: PROC [cd: CharDisplay, mode: Mode] RETURNS [news: BOOL] =

{IF (news ¬ NOT cd.modes[mode]) THEN cd.class.SetMode[cd, mode, TRUE]};

PopMode: PROC [cd: CharDisplay, mode: Mode, news: BOOL] =

{IF news THEN cd.class.SetMode[cd, mode, FALSE]};

flash: Action ¬ [Flash];

Flash: PROC [dc: DisplayController, clientData: REF ANY] =

{dc.cd.class.Flash[dc.cd]};

null: Action ¬ [Naught];

Naught: PROC [dc: DisplayController, clientData: REF ANY] = {};

Tab: PROC [dc: DisplayController, clientData: REF ANY] = {

delta: INT ¬ (8 - (dc.cd.col MOD 8)) MOD 8;

SELECT clientData FROM

$blanken => {

FOR i: INT IN [0 .. delta) DO

dc.cd.class.TakeChar[dc.cd, Ascii.SP];

ENDLOOP;

};

$dontTouch => dc.cd.class.CursorMove[dc.cd, 0, delta, TRUE];

ENDCASE => ERROR;

};