DIRECTORY Ascii, Atom, CharDisplays, EditedStream, IO, IOClasses, List, Rope, ViewerClasses, ViewerIO;

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

}.
๘
CharDisplaysImpl.Mesa
Copyright ำ 1992 by Xerox Corporation.  All rights reserved.
Last Edited by: Spreitzer, January 11, 1986 3:48:39 pm PST
Last tweaked by Mike Spreitzer on April 4, 1990 9:54:27 am PDT
Willie-s, June 12, 1992 1:28 pm PDT
ส
ป–
(cedarcode) style•NewlineDelimiter

™
code™Kšœ
ฯe
œ1™<K™:K™>K™#—K˜Kšฯk	œ*žœ1˜fK˜šะbxœžœ
ž˜Kšžœžœ!˜?Kšžœ
˜K˜Kšœžœ˜K˜Kšžœžœžœ
žœ
˜K˜Kšะblœžœ
žœžœ
˜8K˜Kšœžœ
žœ"žœ˜OK˜šฯnœžœ'žœžœ
˜LKšœžœžœ˜—K˜Kšœžœ
˜K˜š
กœžœ
žœžœžœ˜FKšœžœ˜Kšœžœ%˜1Kšžœžœ
žœ
žœžœ
žœ
˜3K˜—K˜šกœžœ
žœ˜1Kšœžœ˜"K˜:K˜—K˜š
กœžœ
žœกœžœ˜Dšžœ#žœžœ
ž˜5Kšœžœ˜-Kš
œ
˜
Kšžœ
˜—Kšžœ˜—K˜šกœžœ
žœ?žœžœ&žœ
žœžœžœ˜ฎ
Kšœžœe˜mK˜K˜—K˜šœ%žœ˜AK˜K˜K˜Kš
œ˜K˜K˜Kš
œ˜Kš
œ˜K˜Kš
œ˜Kš
œ˜K˜Kš
œ˜Kš
œ˜—K˜Kšœžœžœ˜1šœžœžœ˜$Kšœžœ
žœžœ
˜Kšœ
žœ˜K˜—K˜šกœžœžœ
žœ˜4Kšœžœ˜6K˜KšœOžœ˜VK˜K˜3Kšœžœ˜$K˜—K˜šกœžœ
žœ+˜DKšžœžœžœ
žœ
˜GKšžœ6žœ.žœ
žœ
˜sšžœ&žœ˜.Kšžœ
žœžœ
žœ
˜-K˜&—šžœžœ˜&Kšžœ
žœžœ
žœ
˜)K˜—K˜—K˜šกœžœ˜'Kšœžœ˜4Kš
œ
žœ
žœ
žœžœžœ
žœ˜]K˜K˜K˜—K˜š
ก	œžœžœ
žœžœ˜GKšœžœ˜4Kš
œ
žœ
žœ
žœžœžœ
žœ˜]Kšžœžœ(˜6šžœž˜Kšžœžœ
žœ.˜GKšžœžœ ˜C—Kš	œžœžœžœžœ˜/K˜—K˜šกœžœžœžœžœžœžœ˜iKšœ5žœ˜<—K˜š
กœžœžœ#žœžœ˜fKšœžœ˜4Kš
œ
žœ
žœ
žœžœžœ
žœ˜]šžœžœ˜Kš	œžœžœ
žœ
žœ˜5Kšœžœžœ
žœžœžœ˜JKšœžœžœ
žœžœžœ˜HK˜K˜K˜K˜—Kšžœ
žœ-˜=Kšžœ
žœžœ˜"Kšžœ
žœžœ˜šžœžœ˜Kšœžœ˜K˜K˜ Kšžœ	žœ-žœ
˜EK˜
—Kšžœžœ
žœ˜.Kšžœ
žœ
˜Kš
žœžœžœžœ
žœ˜ZK˜K˜
K˜—K˜šกœžœžœ˜/Kšœžœ˜4Kš
œ
žœ
žœ
žœžœžœ
žœ˜]Kš	œžœžœžœžœ˜@K˜K˜K˜—K˜šกœžœ$˜2Kšœžœ˜4Kš
œ
žœ
žœ
žœžœžœ
žœ˜]šœžœžœž˜Kš
œ˜Kš
œ˜Kšžœžœ
˜—K˜K˜K˜—K˜šก	œžœ˜%Kšœžœ˜4Kš
œ
žœ
žœ
žœžœžœ
žœ˜]K˜K˜K˜—K˜šกœžœ#žœ˜:Kšœžœ˜4Kš
œ
žœ
žœ
žœžœžœ
žœ˜]Kš	œžœžœžœžœ˜GK˜K˜K˜—K˜šก
œžœ#žœ˜<Kšœžœ˜4Kš
œ
žœ
žœ
žœžœžœ
žœ˜]Kš	œžœžœžœžœ˜HK˜K˜K˜—K˜šกœžœžœ˜0Kšœžœ˜4Kš
œ
žœ
žœ
žœžœžœ
žœ˜]Kšœžœžœžœ
˜2K˜K˜K˜—K˜šกœžœ˜!Kšœžœ˜4Kš
œ
žœ
žœ
žœžœžœ
žœ˜]K˜K˜K˜—K˜šก
œžœžœžœ˜8Kšœžœ˜4K˜K˜—K˜šœžœžœ
žœ˜!Kš
œ˜Kš
œ
˜
Kš
œ˜Kš
œ˜—K˜Kšœžœ˜K˜šก	œžœžœ˜3K˜%šžœžœ˜%K˜K˜—K˜—K˜šกœžœ
žœ,žœžœžœ˜fK˜GK˜—K˜šœžœ˜;K˜K˜K˜K˜K˜—K˜šกœžœžœ
žœ˜4Kšœžœ˜&K˜Kšœžœ
˜šžœžœžœ
ž˜"šœžœž˜(Kšžœ˜KšžœE˜I—Kšžœ
˜—K˜—K˜š
ก	œžœžœ
žœžœ˜GKšœžœ˜2šžœžœžœ
ž˜"K˜.K˜-Kšžœ˜	——K˜šกœžœžœžœžœžœžœ˜kKšœžœ˜2šžœžœžœ
ž˜"Kš
œF˜FK˜-Kšžœ˜	——K˜šก	œžœ˜%Kšœžœ˜2šžœžœžœ
ž˜"Kš
œ ˜ K˜-Kšžœ˜	——K˜Kš
œ˜Kš
œ˜K˜K˜——…—"6-้