EmTermCapImpl.Mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
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;
};
}.