CharDisplaysImpl:
CEDAR
PROGRAM
IMPORTS Atom, EditedStream, IO, IOClasses, List, Rope, ViewerIO
EXPORTS CharDisplays
= {OPEN CharDisplays;
REFTEXT: TYPE = REF TEXT;
DisplayDestroyed: PUBLIC ERROR [cd: CharDisplay] = CODE;
unchangeableClient: PUBLIC Client ¬ NEW [ClientRep ¬ [DontChangeDetails, NIL]];
DontChangeDetails:
PROC [Client, CharDisplay, DisplayDetails]
RETURNS [
BOOL]
~ {RETURN [FALSE]};
classes: List.AList ¬ NIL;
GetClass:
PUBLIC
PROC [name:
ROPE]
RETURNS [cdc: CharDisplayClass] = {
a: ATOM ¬ Atom.MakeAtom[name];
cdc ¬ NARROW[List.Assoc[key: a, aList: classes]];
IF cdc#NIL AND NOT name.Equal[cdc.name] THEN ERROR;
};
RegClass:
PUBLIC
PROC [cdc: CharDisplayClass] = {
a: ATOM ¬ Atom.MakeAtom[cdc.name];
classes ¬ List.PutAssoc[key: a, val: cdc, aList: classes];
};
EnumerateClasses:
PUBLIC
PROC [
Consume:
PROC [CharDisplayClass]] ~ {
FOR cl: List.AList ¬ classes, cl.rest
WHILE cl#
NIL
DO
cdc: CharDisplayClass ~ NARROW[cl.first.val];
Consume[cdc];
ENDLOOP;
RETURN};
Create:
PUBLIC
PROC [class: CharDisplayClass, client: Client, name, tipTableName:
ROPE ¬
NIL, det: DisplayDetails ¬ [], initData:
REF
ANY ¬
NIL]
RETURNS [cd: CharDisplay] = {
cd ¬ NEW [CharDisplayRep ¬ [class: class, client: client, name: name, tipTableName: tipTableName, det: det]];
class.Init[cd, initData];
};
debuggingDisplay: CharDisplayClass ¬
NEW [CharDisplayClassRep ¬ [
name: "Debug",
Init: DInit,
ChangeDetails: SimplyChange,
DeleteChar: DDeleteChar,
TakeChar: DTakeChar,
CursorMove: DCursorMove,
Line: DLine,
ClearTo: DClearTo,
ClearAll: DClearAll,
SetEmph: DSetEmph,
Emphasize: DEmphasize,
SetFont: DSetFont,
Beep: DBeep,
Destroyed: DDestroyed]];
DebuggingDisplay: TYPE = REF DebuggingDisplayRep;
DebuggingDisplayRep:
TYPE =
RECORD [
fromD, toD: IO.STREAM ¬ NIL,
charsOnLine: NAT ¬ 0
];
DInit:
PROC [cd: CharDisplay, initData:
REF
ANY] = {
dd: DebuggingDisplay ¬ NEW [DebuggingDisplayRep ¬ []];
cd.otherInstanceData ¬ dd;
[dd.fromD, dd.toD] ¬ ViewerIO.CreateViewerStreams[name: cd.name, editedStream: FALSE];
cd.fromDisplay ¬ dd.fromD;
cd.viewer ¬ ViewerIO.GetViewerFromStream[dd.fromD];
EditedStream.SetEcho[dd.fromD, NIL];
};
SimplyChange:
PUBLIC
PROC [cd: CharDisplay, new: DisplayDetails] = {
IF new.lines # cd.det.lines OR new.columns # cd.det.columns THEN ERROR;
IF new.autoMarginsVariable # cd.det.autoMarginsVariable OR new.scrollsVariable # cd.det.scrollsVariable THEN ERROR;
IF new.autoMargins # cd.det.autoMargins
THEN {
IF NOT cd.det.autoMarginsVariable THEN ERROR;
cd.det.autoMargins ¬ new.autoMargins};
IF new.scrolls # cd.det.scrolls
THEN {
IF NOT cd.det.scrollsVariable THEN ERROR;
cd.det.scrolls ¬ new.scrolls};
};
DDeleteChar:
PROC [cd: CharDisplay] = {
dd: DebuggingDisplay = NARROW[cd.otherInstanceData];
{ENABLE IO.Error => IF ec = StreamClosed AND stream = dd.toD THEN ERROR DisplayDestroyed[cd];
dd.toD.PutRope["<dc>"];
NoteDelta[dd, 4];
}};
DTakeChar:
PROC [cd: CharDisplay, char:
CHAR, insert:
BOOL ¬
FALSE] = {
dd: DebuggingDisplay = NARROW[cd.otherInstanceData];
{ENABLE IO.Error => IF ec = StreamClosed AND stream = dd.toD THEN ERROR DisplayDestroyed[cd];
IF insert THEN {dd.toD.PutChar['←]; NoteDelta[dd, 1]};
SELECT char
FROM
IN [Ascii.SP .. Ascii.DEL) => {dd.toD.PutChar[char]; NoteDelta[dd, 1]};
ENDCASE => {dd.toD.PutF1["<%h>", IO.char[char]]; NoteDelta[dd, 4]};
MoveDCursor[cd, 0, 1, TRUE, TRUE, TRUE, FALSE];
}};
DCursorMove:
PROC [cd: CharDisplay, line, col:
INT, relative:
BOOL ¬
FALSE, doLine, doCol:
BOOL ¬
TRUE] =
{MoveDCursor[cd, line, col, relative, doLine, doCol, TRUE]};
MoveDCursor:
PROC [cd: CharDisplay, line, col:
INT, relative, doLine, doCol, report:
BOOL ¬
FALSE] = {
dd: DebuggingDisplay = NARROW[cd.otherInstanceData];
{ENABLE IO.Error => IF ec = StreamClosed AND stream = dd.toD THEN ERROR DisplayDestroyed[cd];
IF report
THEN {
msg: ROPE ¬ IF relative THEN "<cm + " ELSE "<cm to ";
msg ¬ msg.Concat[IF doLine THEN IO.PutFR1["%g,", IO.int[line]] ELSE ".,"];
msg ¬ msg.Concat[IF doCol THEN IO.PutFR1["%g>", IO.int[col]] ELSE ".>"];
dd.toD.PutRope[msg];
dd.toD.PutRope["\n"];
dd.charsOnLine ¬ 0;
};
IF relative THEN {line ¬ line + cd.line; col ¬ col + cd.col};
IF NOT doLine THEN line ¬ cd.line;
IF NOT doCol THEN col ¬ cd.col;
IF cd.det.autoMargins
THEN {
dl: INT ¬ col / cd.det.columns;
line ¬ line + dl;
col ¬ col - dl * cd.det.columns;
WHILE col < 0 DO col ¬ col + cd.det.columns; line ¬ line - 1 ENDLOOP;
}
ELSE col ¬ MAX[MIN[col, cd.det.columns-1], 0];
IF line < 0 THEN line ¬ 0;
IF cd.det.scrolls THEN line ¬ MIN[line, cd.det.lines-1] ELSE line ¬ line MOD cd.det.lines;
cd.line ¬ line;
cd.col ¬ col;
}};
DLine:
PROC [cd: CharDisplay, insert:
BOOL] = {
dd: DebuggingDisplay = NARROW[cd.otherInstanceData];
{ENABLE IO.Error => IF ec = StreamClosed AND stream = dd.toD THEN ERROR DisplayDestroyed[cd];
msg: ROPE ¬ IF insert THEN "<insert line>" ELSE "<delete line>";
dd.toD.PutRope[msg];
NoteDelta[dd, msg.Length[]];
}};
DClearTo:
PROC [cd: CharDisplay, where: Where] = {
dd: DebuggingDisplay = NARROW[cd.otherInstanceData];
{ENABLE IO.Error => IF ec = StreamClosed AND stream = dd.toD THEN ERROR DisplayDestroyed[cd];
msg:
ROPE ¬
SELECT where
FROM
EndOfLine => "<clr eol>",
EndOfScreen => "<clr eos>",
ENDCASE => ERROR;
dd.toD.PutRope[msg];
NoteDelta[dd, msg.Length[]];
}};
DClearAll:
PROC [cd: CharDisplay] = {
dd: DebuggingDisplay = NARROW[cd.otherInstanceData];
{ENABLE IO.Error => IF ec = StreamClosed AND stream = dd.toD THEN ERROR DisplayDestroyed[cd];
dd.toD.PutRope["<clear all>"];
NoteDelta[dd, 11];
}};
DSetEmph:
PROC [cd: CharDisplay, emph: Emph, on:
BOOL] = {
dd: DebuggingDisplay = NARROW[cd.otherInstanceData];
{ENABLE IO.Error => IF ec = StreamClosed AND stream = dd.toD THEN ERROR DisplayDestroyed[cd];
msg: ROPE ¬ IO.PutFR["<%g %g>", IO.rope[EmphNames[emph]], IO.bool[on]];
dd.toD.PutRope[msg];
NoteDelta[dd, msg.Length[]];
}};
DEmphasize:
PROC [cd: CharDisplay, emph: Emph, on:
BOOL] = {
dd: DebuggingDisplay = NARROW[cd.otherInstanceData];
{ENABLE IO.Error => IF ec = StreamClosed AND stream = dd.toD THEN ERROR DisplayDestroyed[cd];
msg: ROPE ¬ IO.PutFR["<%g %g@>", IO.rope[EmphNames[emph]], IO.bool[on]];
dd.toD.PutRope[msg];
NoteDelta[dd, msg.Length[]];
}};
DSetFont:
PROC [cd: CharDisplay, font:
ROPE] = {
dd: DebuggingDisplay = NARROW[cd.otherInstanceData];
{ENABLE IO.Error => IF ec = StreamClosed AND stream = dd.toD THEN ERROR DisplayDestroyed[cd];
msg: ROPE ¬ IO.PutFR1["<font %g>", IO.rope[font]];
dd.toD.PutRope[msg];
NoteDelta[dd, msg.Length[]];
}};
DBeep:
PROC [cd: CharDisplay] = {
dd: DebuggingDisplay = NARROW[cd.otherInstanceData];
{ENABLE IO.Error => IF ec = StreamClosed AND stream = dd.toD THEN ERROR DisplayDestroyed[cd];
dd.toD.PutRope["<beep>"];
NoteDelta[dd, 7];
}};
DDestroyed:
PROC [cd: CharDisplay]
RETURNS [b:
BOOL] = {
dd: DebuggingDisplay = NARROW[cd.otherInstanceData];
b ¬ cd.viewer.destroyed;
};
EmphNames:
ARRAY Emph
OF
ROPE ¬ [
underline: "underline",
bold: "bold",
italic: "italic",
inverse: "inverse"];
lineLength: NAT ¬ 95;
NoteDelta:
PROC [dd: DebuggingDisplay, dc:
INT] = {
dd.charsOnLine ¬ dd.charsOnLine + dc;
IF dd.charsOnLine > lineLength
THEN {
dd.toD.PutRope["\n"];
dd.charsOnLine ¬ 0};
};
Split:
PUBLIC
PROC [l: CharDisplayList, client: Client, name:
ROPE ¬
NIL]
RETURNS [s: CharDisplay] = {
s ¬ Create[class: splitClass, client: client, name: name, initData: l];
};
splitClass: CharDisplayClass ¬
NEW [CharDisplayClassRep ¬ [
name: "Split",
Init: SInit,
TakeChar: STakeChar,
CursorMove: SCursorMove,
ClearAll: SClearAll]];
SInit:
PROC [cd: CharDisplay, initData:
REF
ANY] = {
l: CharDisplayList ¬ NARROW[initData];
cd.otherInstanceData ¬ l;
cd.fromDisplay ¬ NIL;
FOR l ¬ l, l.rest
WHILE l #
NIL
DO
cd.fromDisplay ¬
IF cd.fromDisplay =
NIL
THEN l.first.fromDisplay
ELSE IOClasses.CreateCatInputStream[cd.fromDisplay, l.first.fromDisplay];
ENDLOOP;
};
STakeChar:
PROC [cd: CharDisplay, char:
CHAR, insert:
BOOL ¬
FALSE] = {
l: CharDisplayList ¬ NARROW[cd.otherInstanceData];
FOR l ¬ l, l.rest
WHILE l #
NIL
DO
l.first.class.TakeChar[l.first, char, insert];
cd.line ¬ l.first.line; cd.col ¬ l.first.col;
ENDLOOP};
SCursorMove:
PROC [cd: CharDisplay, line, col:
INT, relative:
BOOL ¬
FALSE, doLine, doCol:
BOOL ¬
TRUE] = {
l: CharDisplayList ¬ NARROW[cd.otherInstanceData];
FOR l ¬ l, l.rest
WHILE l #
NIL
DO
l.first.class.CursorMove[l.first, line, col, relative, doLine, doCol];
cd.line ¬ l.first.line; cd.col ¬ l.first.col;
ENDLOOP};
SClearAll:
PROC [cd: CharDisplay] = {
l: CharDisplayList ¬ NARROW[cd.otherInstanceData];
FOR l ¬ l, l.rest
WHILE l #
NIL
DO
l.first.class.ClearAll[l.first];
cd.line ¬ l.first.line; cd.col ¬ l.first.col;
ENDLOOP};
RegClass[debuggingDisplay];
RegClass[splitClass];
}.