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;
};

}.
’
EmTermCapImpl.Mesa
Copyright Σ 1992 by Xerox Corporation.  All rights reserved.
Last Edited by: Spreitzer, March 14, 1985 11:51:46 am PST
ΚD•NewlineDelimiter

–
(cedarcode) style™
codeš
œ™Kšœ
Οe
œ1™<J™9—K˜KšΟk	œWžœžœ(˜Ž
K˜šΠbx
œžœ
ž˜Kšžœžœ˜4Kšžœ
˜K˜Kšœžœ,˜4K˜Kšœ
žœ˜$K˜Kš	œžœ
žœžœžœ
˜&K˜Kšœ
žœžœ
žœžœ
žœ˜/K˜šΟnœžœ
žœžœžœžœC˜“
Kšœžœžœ
˜Kšœžœ˜š œžœžœžœ˜0š œžœ
žœžœ˜šžœ	žœ
ž˜Kšœžœ˜Kšžœ'˜.——š œžœ
žœžœ˜šžœ	žœ
ž˜Kšœ
žœ	˜Kšžœ&˜-——Kšœžœ˜$Kšœžœ
˜
šžœ	žœ
ž˜Kš	œžœžœ
žœ
žœ˜AKšžœ
˜—šžœž˜KšœžΟcœ
˜#Kšœžœ˜5Kšœžœ
˜Kšœž‘œ
˜#Kšœžœ
žœ
˜4Kšœžœ˜.Kšœžœžœ
˜5Kšœžœ˜6Kšœžœ˜6Kšœ(žœžœžœ˜@Kšœžœ˜4Kšœ(žœžœžœ˜@K˜Kšœžœ
˜+Kšœ(žœžœžœ˜@Kšœž‘œ
˜6Kšœžœ˜3Kšœžœ˜5Kšœž‘#œ
˜/Kšœžœ
žœ
˜4Kšœž‘#œ
˜/Kšœžœ
žœ˜:Kšœžœ
‘œ
˜Kšœžœ˜-Kšœžœ
‘œ
˜Kšœžœ˜4Kšœžœ
˜Kšœžœ
žœ˜9Kšœžœ
˜Kšœžœ˜4Kšœž‘œ
˜3Kšœžœ
˜Kšœ4ž‘œ
˜GKšœ4ž‘œ
˜GKšœž‘œ
˜Kšœžœ
žœ
˜4K˜Kšœž‘œ
˜ Kšœžœ
˜Kšœž‘œ
˜Kšœžœ
˜Kšœžœ
žœ˜5Kšœžœ
žœ
˜4Kšœžœ˜-Kšœžœ
˜Kšœžœ
žœ˜;Kšœžœ
žœ˜:Kšœžœ˜3K˜Kšœžœ
˜+Kšœžœ
žœ˜<Kšœžœ
žœ˜2Kšœžœ
žœ˜;Kšœžœ˜.Kšœžœ
˜K˜šžœžœ
˜Kšžœ
žœ˜%Kšžœžœžœ˜?——K˜—K˜Kšœžœ
˜Kšœžœ
˜Kš
œ˜Kšžœžœžœ˜LK˜—K˜Kšœžœ˜šžœžœ%žœ
žœ˜7Kšœ%žœžœ˜4—K˜K˜š œžœ%žœ
žœ˜9Kšœ%žœ˜-—K˜K˜"š 
œžœ%žœ
žœ˜AKšœ	žœ˜Kšœžœ
˜K˜CKšœžœ˜K˜3Kšœžœ˜K˜>K˜—K˜K˜$š œžœ%žœ
žœ˜BKš
œ˜K˜$Kš
œ˜—K˜K˜"š 
œžœ%žœ
žœ˜?Kš
œ ˜ —K˜Kšœžœ˜šžœžœ%žœ
žœ˜9Kšœ(žœ˜.Kšœ$žœ˜*Kš
œ˜—K˜š œžœ%žœ
žœ˜:Kš
œ˜šžœž˜K˜K˜Kšžœžœ
˜—Kš
œ#˜#—K˜šžœžœ%žœ
žœ˜7Kšœžœ˜šžœž˜K˜K˜K˜K˜Kšžœžœ
˜—Kšœ+žœ˜2—K˜š
 œžœžœžœžœ˜FKšœžœ
˜š œžœ˜Kšœžœ˜Kšžœžœ
žœžœ˜/K˜—Kš	œžœ
žœžœ
žœ˜K˜Kšœžœ
žœ	žœ
˜š œžœ˜K˜Kšœžœ˜K˜K˜—Kšžœžœžœ˜%Kšžœžœžœ
˜'šžœ
žœž˜Kšœžœ˜šžœž˜˜Kšžœžœžœ˜7K˜šžœž˜K˜1K˜1K˜1K˜7Kšœžœžœ˜GK˜Kš
œ"˜"˜Kšžœžœžœ˜7K˜K˜1K˜—Kšžœžœ
˜—K˜—Kšžœ ˜'—Kšžœ
˜—K˜K˜—K˜šžœžœ%žœ
žœ˜7Kšœžœžœ
˜šžœž˜Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜Kšžœžœ
˜—KšœCžœ˜Z—K˜š œžœ%žœ
žœ˜;šœžœžœž˜%Kšœžœ
˜
Kšœžœ
˜Kšžœžœ
˜—K˜!—K˜šžœžœ%žœ
žœ˜9Kš
œ˜Kšœžœ
˜	šžœž˜Kšœ'žœ˜-Kšœ(žœ˜/Kšœ(žœ˜.Kšœ)žœ˜0Kšœ&žœ˜,Kšœ'žœ˜.Kšžœžœ
˜—Kš
œ&˜&—K˜Kšœ$žœ˜)š œžœ%žœ
žœ˜BKšœžœ˜)Kšœžœ˜Kšœžœ
˜Kšœ"žœ˜&K˜!Kšœ%žœ˜+K˜—K˜š œžœžœžœ˜CKš	œ
žœ	žœžœžœ˜G—K˜š œžœ%žœ˜9Kšœ
žœžœžœ˜1—K˜K˜š œžœ%žœ
žœ˜:K˜—K˜K˜Kš œžœ%žœ
žœ˜?K˜š œžœ%žœ
žœ˜:Kšœžœžœžœ˜+šžœž˜˜
šžœžœ
žœž˜Kšœ"žœ˜&Kšžœ
˜—K˜—Kšœ6žœ˜<Kšžœžœ
˜—Kš
œ˜—K˜K˜——…—!΄-Š