DIRECTORY
Ascii USING [CR, LF],
Atom USING [GetPropFromList, PropList, PutPropOnList],
Char USING [XCHAR, Widen],
Commander USING [CommandProc, Register],
CommanderOps USING [ArgumentVector, Failed, Parse],
Imager,
NodeStyle USING [GetInt, Style],
NodeStyleOps USING [Alloc, ApplyAll, Free, OfStyle],
PFS USING [Error, PathFromRope],
TiogaIO USING [FromFile],
Real USING [Round],
Rope USING [Concat, ROPE],
RopeReader,
Scaled USING [FromInt, Round, Value],
TEdit,
TEditFormat USING [Allocate, FormatLine, LineInfo, Paint, Release],
TextEdit,
TextNode,
Tioga,
Xl,
XTk,
XTkBitmapWidgets,
XTkContainers,
XTkFriends,
XTkScroller, 
XTkTioga,
XTkWidgets;

XTkTiogaImpl: CEDAR PROGRAM
IMPORTS Atom, Char, Commander, CommanderOps, Imager, NodeStyle, NodeStyleOps, PFS, Real, Rope, RopeReader, Scaled, TiogaIO, TEditFormat, TextEdit, TextNode, Xl, XTk, XTkBitmapWidgets, XTkContainers, XTkFriends, XTkScroller, XTkWidgets
EXPORTS XTkTioga
~ BEGIN OPEN TEdit;

ROPE: TYPE ~ Rope.ROPE;
Node: TYPE ~ Tioga.Node;
Doc: TYPE ~ TEdit.Doc;
View: TYPE ~ TEdit.View;
CreateDoc: PROC [fileName: ROPE] RETURNS [Doc] ~ {
root: Node ~ TiogaIO.FromFile[PFS.PathFromRope[fileName]].root;
doc: Doc ~ NEW[TEdit.DocRep ¬ [root: root]];
FOR id: TEdit.SelectionId IN TEdit.SelectionId DO
doc.selection[id] ¬ NEW[TEdit.SelectionRep ¬ []];
ENDLOOP;
RETURN[doc];
};

CreateView: PROC [doc: Doc] RETURNS [View] ~ {
view: View ~ NEW[TEdit.ViewRep ¬ [doc: doc]];
doc.views ¬ CONS[view, doc.views];
view.scrollLoc ¬ [TextNode.FirstChild[doc.root], 0];
RETURN[view];
};

commentTest: ARRAY TEdit.CommentFilter OF ARRAY BOOL--node.comment-- OF BOOL ~ [
includeComments: [FALSE: TRUE, TRUE: TRUE],
excludeComments: [FALSE: TRUE, TRUE: FALSE],
onlyComments: [FALSE: FALSE, TRUE: TRUE]
];

Level: PROC [node: Node, level: INTEGER ¬ 0] RETURNS [INTEGER] ~ --INLINE?-- {
RETURN[IF level>0 THEN level ELSE TextNode.Level[node]];
};

NodeIsViewable: PROC [view: View, node: Node, level: INTEGER ¬ 0] RETURNS [BOOL] ~ {
RETURN[commentTest[view.commentFilter][node.comment] 
AND Level[node, level]<=view.clipLevel];
};

FirstViewableNode: PROC [view: View, start: Node, startLevel: INTEGER ¬ 0] 
RETURNS [node: Node, level: INTEGER] ~ {
level ¬ Level[(node ¬ start), startLevel];
UNTIL node=NIL OR NodeIsViewable[view, node, level] DO
[node, level] ¬ TextNode.ForwardClipped[node: node, 
maxLevel: view.clipLevel, nodeLevel: level];
ENDLOOP;
};

FirstPosInView: PROC [view: View, start: TextNode.Location, startLevel: INTEGER ¬ 0] 
RETURNS [node: Node ¬ NIL, where: INT ¬ 0, level: INTEGER ¬ 0] ~ {
level ¬ Level[(node ¬ start.node), startLevel];
WHILE level>view.clipLevel DO
node ¬ TextNode.Parent[node]; level ¬ level-1;
ENDLOOP;
[node, level] ¬ FirstViewableNode[view, node, level];
where ¬ IF node=start.node THEN start.where ELSE 0;
IF view.firstLinesOnly THEN where ¬ 0;
};

NextNodeInView: PROC [view: View, start: Node, startLevel: INTEGER ¬ 0] 
RETURNS [node: Node, level: INTEGER] ~ {
[node, level] ¬ TextNode.ForwardClipped[node: start, 
maxLevel: view.clipLevel, nodeLevel: startLevel];
RETURN FirstViewableNode[view, node, level];
};

PrevNodeInView: PROC [view: View, start: Node, 
startParent: Node ¬ NIL, startLevel: INTEGER ¬ 0
] RETURNS [node: Node, parent: Node, level: INTEGER] ~ {
[node, parent, level] ¬ TextNode.BackwardClipped[node: start, 
maxLevel: view.clipLevel, parent: startParent, nodeLevel: startLevel];
UNTIL parent=NIL OR NodeIsViewable[view, node, level] DO
[node, parent, level] ¬ TextNode.BackwardClipped[node: node, 
maxLevel: view.clipLevel, parent: parent, nodeLevel: level];
ENDLOOP;
};

NextPosInView: PROC [view: View, line: TEdit.Line, lineLevel: INTEGER ¬ 0] 
RETURNS [node: Node ¬ NIL, where: INT ¬ 0, level: INTEGER ¬ 0] ~ {
level ¬ Level[(node ¬ line.info.startPos.node), lineLevel];
IF line.info.break=eon OR view.firstLinesOnly
THEN [node, level] ¬ NextNodeInView[view, node, level]
ELSE where ¬ line.info.startPos.where+line.info.nChars;
};

GetLine: PROC [view: View, index: NAT] RETURNS [TEdit.Line] ~ {
size: NAT ~ IF view.lines=NIL THEN 0 ELSE view.lines.size;
IF NOT index<size THEN { -- need a bigger line table
newSize: NAT ~ size+(size/2)+1;
newLines: TEdit.LineArray ~ NEW[TEdit.LineArrayRep[newSize]];
FOR i: NAT IN[0..size) DO newLines[i] ¬ view.lines[i] ENDLOOP;
view.lines ¬ newLines;
};
IF view.lines[index]=NIL THEN { -- need a new line
lineInfo: TEditFormat.LineInfo ~ TEditFormat.Allocate[];
view.lines[index] ¬ NEW[TEdit.LineRep ¬ [info: lineInfo]];
};
RETURN[view.lines[index]];
};

FormatView: PROC [view: View, paint: BOOL ¬ TRUE] ~ {
lineWidth: Scaled.Value ~ Scaled.FromInt[view.cw];
cachedStyle: NodeStyle.Style ~ NodeStyleOps.Alloc[];
cachedStyleNode: Node ¬ NIL;
ComputeStyle: PROC [node: Node] RETURNS [NodeStyle.Style] ~ {
NodeStyleOps.ApplyAll[cachedStyle, node, view.styleKind];
cachedStyleNode ¬ node; RETURN[cachedStyle];
};
GetStyle: PROC [node: Node] RETURNS [NodeStyle.Style] ~ INLINE {
RETURN[IF node=cachedStyleNode THEN cachedStyle ELSE ComputeStyle[node]];
};
line: TEdit.Line ¬ NIL; -- current line
nLines: NAT ¬ 0;
node: Node ¬ NIL; where: INT ¬ 0;
level, maxLevel: INTEGER ¬ 0;
[node, where, level] ¬ FirstPosInView[view, view.scrollLoc];
UNTIL node=NIL DO
prev: TEdit.Line ~ line;
baselinePrev, bottomPrev, baseline, leading, minLineGap: INT ¬ 0;
IF prev=NIL THEN { -- first line of view
baselinePrev ¬ bottomPrev ¬ 0;
leading ¬ NodeStyle.GetInt[GetStyle[node], topIndent]; -- treat as top of a page
}
ELSE { -- other lines of view
baselinePrev ¬ prev.baseline; bottomPrev ¬ baselinePrev-prev.info.ymin;
IF where=0 THEN { -- first line of node
nodePrev: Node ~ prev.info.startPos.node;
bottomLeadingPrev: INT ~ NodeStyle.GetInt[GetStyle[nodePrev], bottomLeading];
topLeading: INT ~ NodeStyle.GetInt[GetStyle[node], topLeading];
leading ¬ MAX[bottomLeadingPrev, topLeading];
}
ELSE leading ¬ NodeStyle.GetInt[GetStyle[node], leading]; -- other lines of node
};
baseline ¬ baselinePrev+leading;
IF prev#NIL THEN { -- if not the first line, test for off bottom
yTest: INT ~ IF node.hasArtwork THEN bottomPrev ELSE baseline;
IF yTest >= view.ch THEN EXIT; -- off bottom
};
line ¬ GetLine[view, nLines];
TEditFormat.FormatLine[lineInfo: line.info, node: node, startOffset: where, 
nodeStyle: GetStyle[node], lineWidth: lineWidth];
minLineGap ¬ NodeStyle.GetInt[GetStyle[node], minLineGap];
IF (bottomPrev+minLineGap)>(baseline-line.info.ymax) THEN {
baseline ¬ bottomPrev+minLineGap+line.info.ymax;
IF (NOT node.hasArtwork) AND (baseline >= view.ch) THEN EXIT; -- now off bottom
};
line.baseline ¬ baseline;
nLines ¬ nLines+1; -- add the line
IF level>maxLevel THEN maxLevel ¬ level;
[node, where, level] ¬ NextPosInView[view, line, level];
ENDLOOP;
view.nLines ¬ nLines;
NodeStyleOps.Free[cachedStyle];
view.stopLoc ¬ [node, where];
view.maxLevel ¬ maxLevel;
ComputeLineResolveValues[view];
SetScroll[view.window, (view.range ¬ ComputeVisibleRange[view])];
IF paint THEN PaintView[view, TRUE];
};

ComputeVisibleRange: PROC [view: View] RETURNS [VisibleRange] ~ {
IF view.nLines>0 THEN { ENABLE TextNode.BadArgs => CONTINUE;
root: Node ~ view.doc.root;
stop: TextNode.Location ~ view.stopLoc;
pos0: TextNode.Location ~ [TextNode.FirstChild[root], 0]; -- first loc in doc
pos3: TextNode.Location ~ TextNode.LastLocWithin[root]; -- last loc in doc
pos1: TextNode.Location ~ view.lines[0].info.startPos; -- first loc in view
pos2: TextNode.Location ~ IF stop.node#NIL THEN stop ELSE pos3; -- loc after view
c1: INT ~ TextNode.LocOffset[pos0, pos1]; -- to top of view
c2: INT ~ c1+TextNode.LocOffset[pos1, pos2]; -- to bottom of view
c3: INT ~ c2+TextNode.LocOffset[pos2, pos3]; -- to end of document
divisor: REAL ~ c3;
RETURN[[c1/divisor, c2/divisor]];
};
RETURN[[0, 1]];
};

ComputeLineResolveValues: PROC [view: View] ~ {
prev: TEdit.Line ¬ NIL;
FOR i: NAT IN[0..view.nLines) DO
line: TEdit.Line ~ view.lines[i];
top: INTEGER ~ line.baseline-line.info.ymax;
bot: INTEGER ~ line.baseline-line.info.ymin;
line.resolve ¬ bot;
IF prev#NIL THEN {
mid: INTEGER ~ (prev.resolve+top)/2;
prev.resolve ¬ MAX[prev.baseline, MIN[mid, line.baseline]];
};
prev ¬ line;
ENDLOOP;
};

PaintView: PROC [view: View, clear: BOOL ¬ FALSE] ~ {
action: PROC [context: Imager.Context] ~ {
IF clear THEN {
Imager.SetGray[context, 0];
Imager.MaskRectangleI[context, 0, 0, view.cw, view.ch];
Imager.SetGray[context, 1];
};
FOR i: NAT IN[0..view.nLines) DO
line: TEdit.Line ~ view.lines[i];
Imager.SetXYI[context, Scaled.Round[line.info.xOffset], view.ch-line.baseline];
TEditFormat.Paint[line.info, context];
IF view.firstLinesOnly AND line.info.break#eon THEN Imager.ShowRope[context, "..."];
ENDLOOP;
};
Paint[view.window, action];
};

ResolveToLine: PROC [view: View, y: INTEGER] 
RETURNS [line: Line ¬ NIL, belowLine: BOOL ¬ FALSE] ~ {
FOR i: NAT IN[0..view.nLines) DO
line ¬ view.lines[i];
IF y<line.resolve THEN RETURN;
ENDLOOP;
belowLine ¬ TRUE;
};

xCR: Char.XCHAR ~ Char.Widen[Ascii.CR];
xLF: Char.XCHAR ~ Char.Widen[Ascii.LF];

StartOfLineContaining: PROC [view: View, loc: TextNode.Location] 
RETURNS [TextNode.Location] ~ {
style: NodeStyle.Style ~ NodeStyleOps.Alloc[];
lineInfo: TEditFormat.LineInfo ~ TEditFormat.Allocate[];
kind: StyleKind ~ view.styleKind;
node: Node ~ loc.node;
where: INT ~ loc.where;
start, next: INT ¬ where;
maxFetches: INT ~ 1000; -- limit how far back to search for CR's
THROUGH [0..maxFetches) WHILE start>0 DO
SELECT TextEdit.FetchChar[node, start-1] FROM
xCR, xLF => EXIT;
ENDCASE => start ¬ start - 1;
ENDLOOP;
NodeStyleOps.ApplyAll[style, node, kind];
DO -- find the line containing [node, where]
TEditFormat.FormatLine[lineInfo: lineInfo, node: node, startOffset: start, nodeStyle: style, lineWidth: Scaled.FromInt[view.cw]];
next ¬ lineInfo.startPos.where+lineInfo.nChars;
IF where<next OR lineInfo.break=eon THEN EXIT ELSE start ¬ next;
ENDLOOP;
TEditFormat.Release[lineInfo];
NodeStyleOps.Free[style];
RETURN[[node, start]];
};

BackUp: PROC [view: View, pos: TextNode.Location, goal: INTEGER] RETURNS [newPos: TextNode.Location, lines, totalLeading, topIndent: INTEGER] = {
kind: NodeStyleOps.OfStyle ~ view.styleKind;
rdr: RopeReader.Ref ¬ RopeReader.GetRopeReader[];
style: NodeStyle.Style ¬ NodeStyleOps.Alloc[];
styleNode: Node ¬ NIL;
remainder: INTEGER ¬ goal;
dy: INTEGER ¬ LAST[INTEGER];
topLeading: INTEGER ¬ 0;
parent: Node ¬ NIL;
level: INTEGER ¬ 0;
IncrBackUp: PROC [pos: TextNode.Location, goal, prevTopLeading: INTEGER] RETURNS [prev: TextNode.Location, totalLeading, lines, topIndent, topLeading: INTEGER] = {
tPos: TextNode.Location;
leading, bottomLeading: INTEGER;
lastBreak: INT;
breakList: LIST OF INT; -- breaks between first and last
node: Node ¬ NIL;
where, endOffset, size: INT;
lineInfo: TEditFormat.LineInfo;
IF pos.where=0
THEN {
[node, parent, level] ¬ PrevNodeInView[view, pos.node, parent, level];
IF node=NIL OR parent=NIL THEN RETURN[pos, 0, 0, 0, 0];
size ¬ endOffset ¬ where ¬ TextEdit.Size[node];
}
ELSE {
node ¬ pos.node;
size ¬ TextEdit.Size[node];
endOffset ¬ where ¬ pos.where-1;
};
IF where < 4*MAX[12,goal] OR view.firstLinesOnly
THEN where ¬ 0 -- don't bother to search backwards for CR
ELSE {
stop: INT ¬ MAX[0, where-5000]; -- limit reading to 5000 characters
RopeReader.SetPosition[rdr, node.rope, where];
UNTIL (where ¬ where-1)<=stop DO
SELECT RopeReader.Backwards[rdr] FROM
Ascii.CR, Ascii.LF => {where ¬ where+1; EXIT};
ENDCASE;
ENDLOOP 
};
IF styleNode#node THEN NodeStyleOps.ApplyAll[style, styleNode ¬ node, kind];
leading ¬ NodeStyle.GetInt[style, leading];
topLeading ¬ IF where=0 THEN NodeStyle.GetInt[style, topLeading] ELSE leading;
bottomLeading ¬ totalLeading ¬ IF pos.node = node
THEN leading
ELSE MAX[prevTopLeading, NodeStyle.GetInt[style, bottomLeading]];
topIndent ¬ NodeStyle.GetInt[style, topIndent]; -- in case this line appears at top of viewer
IF where=size THEN {
lines ¬ 1; prev ¬ [node, where]; RETURN 
};
tPos ¬ [node, where];
lines ¬ 0;
lineInfo ¬ TEditFormat.Allocate[];
DO
lastBreak ¬ tPos.where;
TEditFormat.FormatLine[lineInfo: lineInfo, node: tPos.node, startOffset: tPos.where, nodeStyle: style, lineWidth: Scaled.FromInt[view.cw]];
tPos ¬ lineInfo.nextPos;
IF lines > 0 THEN totalLeading ¬ totalLeading+leading;
lines ¬ lines+1;
IF tPos.node#node OR tPos.where>=endOffset OR view.firstLinesOnly THEN EXIT;
IF lastBreak#where THEN breakList ¬ CONS[lastBreak, breakList];
ENDLOOP;
lineInfo.Release[]; lineInfo ¬ NIL;
IF totalLeading+topIndent >= goal AND leading > 0 THEN {
discardLines: INTEGER ¬ (totalLeading+topIndent-goal)/leading; -- too many lines
SELECT discardLines FROM
<= 0 => {}; -- don't discard any
>= lines-1 => { -- discard all but one
where ¬ lastBreak;
lines ¬ 1;
totalLeading ¬ bottomLeading ;
};
ENDCASE => {
count: INTEGER; -- how far to go on list to find the break
lines ¬ lines-discardLines;
count ¬ lines-1; -- subtract 1 because lastBreak is not on list
totalLeading ¬ totalLeading-discardLines*leading;
FOR list: LIST OF INT ¬ breakList, list.rest DO
IF (count ¬ count-1) = 0 THEN { where ¬ list.first; EXIT };
ENDLOOP;
};
};
prev ¬ [node, where];
};

IF pos.where=0 THEN {
NodeStyleOps.ApplyAll[style, pos.node, kind];
topLeading ¬ NodeStyle.GetInt[style, topLeading];
};
newPos ¬ pos;
lines ¬ totalLeading ¬ topIndent ¬ 0;
UNTIL remainder<=0 DO
leading, newLines, newTopIndent: INTEGER;
[newPos, leading, newLines, newTopIndent, topLeading] ¬
IncrBackUp[newPos, remainder, topLeading];
IF newLines <= 0 THEN EXIT; -- didn't get anything that time.  at start of document.
totalLeading ¬ totalLeading+leading;
lines ¬ lines+newLines;
topIndent ¬ newTopIndent;
IF totalLeading+topIndent >= goal THEN EXIT; -- don't need to back up any farther
remainder ¬ remainder - leading;
ENDLOOP;
NodeStyleOps.Free[style];
RopeReader.FreeRopeReader[rdr];
};
Thumb: PROC [view: View, value: REAL] ~ {
root: Node ~ view.doc.root;
size: INT ~ TextNode.LocNumber[TextNode.LastLocWithin[root]]-1; -- -1 for root node?
count: INT ~ Real.Round[value*size];
loc: TextNode.Location ~ TextNode.LocWithin[root, count];
view.scrollLoc ¬ StartOfLineContaining[view, loc];
FormatView[view];
};

ScrollUp: PROC [view: View, d: INTEGER] ~ {
loc: TextNode.Location ¬ [NIL, 0];
SELECT view.nLines FROM
0 => NULL;
1 => { -- if only one line, scroll to next line
[loc.node, loc.where] ¬ NextPosInView[view, view.lines[0]];
};
ENDCASE => { -- move indicated line to top
FOR i: NAT IN[0..view.nLines) DO
line: Line ~ view.lines[i];
loc ¬ line.info.startPos;
IF d<line.resolve THEN EXIT;
ENDLOOP;
};
IF loc.node#NIL THEN { view.scrollLoc ¬ loc; FormatView[view] };
};

ScrollDown: PROC [view: View, d: INTEGER] ~ {
loc: TextNode.Location ¬ [NIL, 0];
IF view.nLines>0 THEN {
startPos: TextNode.Location ~ view.lines[0].info.startPos;
loc ¬ BackUp[view, startPos, d].newPos;
};
IF loc.node#NIL THEN { view.scrollLoc ¬ loc; FormatView[view] };
};

CommentOp: TYPE ~ TEdit.CommentFilter;

SetCommentFilter: PROC [view: View, op: CommentOp] ~ {
view.commentFilter ¬ op;
FormatView[view];
};

LevelsOp: TYPE ~ {first, more, fewer, all};

SetLevelClipping: PROC [view: View, op: LevelsOp] ~ {
level: NestingLevel ~ SELECT op FROM
first => 1,
more => view.maxLevel+1,
fewer => (IF view.maxLevel>1 THEN view.maxLevel-1 ELSE 1),
ENDCASE => NestingLevel.LAST;
IF view.clipLevel#level THEN {
view.clipLevel ¬ level;
FormatView[view];
};
};

StyleOp: TYPE ~ TEdit.StyleKind;

SetStyleKind: PROC [view: View, op: StyleOp] ~ {
view.styleKind ¬ op;
FormatView[view];
};

LinesOp: TYPE ~ {all, first};

SetLines: PROC [view: View, op: LinesOp] ~ {
view.firstLinesOnly ¬ (op=first);
FormatView[view];
};

SetViewSize: PROC [view: View, width, height: INT, paint: BOOL] ~ {
view.cw ¬ width;
view.ch ¬ height;
FormatView[view, paint];
};

Notify: PROC [view: View, data: REF] ~ {
WITH data SELECT FROM
data: REF CommentOp => SetCommentFilter[view, data­];
data: REF LevelsOp => SetLevelClipping[view, data­];
data: REF StyleOp => SetStyleKind[view, data­];
data: REF LinesOp => SetLines[view, data­];
ENDCASE;
};

tiogaWidgetClass: PUBLIC XTk.Class ~ XTkFriends.CreateClass[[super: XTkContainers.yStack, key: $Tioga, initInstPart: TiogaWidgetInitInstPart, configureLR: TiogaWidgetConfigure, destroyWidget: TiogaWidgetDestruction, wDataNum: 1]];
inheritedConfigureLR: XTk.ConfigureProc ~ XTkFriends.InheritedConfigureLRProc[tiogaWidgetClass.super];


ToolData: TYPE ~ REF ToolDataRep;
ToolDataRep: TYPE ~ RECORD [
view: View,
context: Imager.Context ¬ NIL, -- context for painting into inner
inner: XTk.Widget ¬ NIL, -- innermost widget, for document contents
scroller: XTk.Widget ¬ NIL -- scrollbar widget, if any
];

HandleButton: XTk.WidgetNotifyProc ~ {
data: ToolData ~ NARROW[registerData];
view: View ~ data.view;
IF view#NIL THEN Notify[view, callData];
};

HandleScroll: XTkScroller.ScrollProc ~ {
data: ToolData ~ NARROW[clientData];
view: View ~ data.view;
IF view#NIL THEN {
height: INT ~ scroller.actual.size.height;
d: INT ~ Real.Round[value*height];
SELECT action FROM
forward => ScrollUp[view, d];
backward => ScrollDown[view, d];
thumb => {
min: INT ~ MIN[5, height/2];
max: INT ~ height-min;
IF d<min THEN value ¬ 0 ELSE IF d>max THEN value ¬ 1;
Thumb[view, value];
};
ENDCASE;
};
};

GetTiogaWidgetData: PROC [widget: XTk.Widget] RETURNS [ToolData] = INLINE {
RETURN [NARROW[XTkFriends.InstPart[widget, tiogaWidgetClass]]];
};

TiogaWidgetInitInstPart: XTk.InitInstancePartProc = {
addScrollbar: BOOL ¬ Atom.GetPropFromList[arguments, $scrollbar]#NIL;
addMenu: BOOL ¬ Atom.GetPropFromList[arguments, $menu]#NIL;
data: ToolData ~ NEW[ToolDataRep ¬ []];
tq: Xl.TQ ¬ Xl.CreateTQ[];
bottomPart: XTk.Widget ~ XTkWidgets.CreateXStack[[geometry: XTk.G[w: 300, h: 400]]];
data.inner ¬ XTkBitmapWidgets.CreateBitmapWidget[data: data];
IF addScrollbar THEN {
data.scroller ¬ XTkScroller.CreateScroller[];
XTkScroller.InteractiveRegistrations[data.scroller, HandleScroll, data, tq];
XTkWidgets.AppendChild[bottomPart, data.scroller, FALSE];
};
XTkWidgets.AppendChild[bottomPart, data.inner];
IF addMenu THEN {
MakeButton: PROC [name: ROPE, callData: REF] RETURNS [XTk.Widget] ~ {
RETURN[XTkWidgets.CreateButton[text: Rope.Concat[name, " "],
hitProc: HandleButton, registerData: data, callData: callData, tq: tq]];
};
filterChoices: XTkWidgets.ChoiceList ~ LIST[
[text: "includeComments", callData: NEW[CommentOp ¬ includeComments]],
[text: "excludeComments", callData: NEW[CommentOp ¬ excludeComments]],
[text: "onlyComments", callData: NEW[CommentOp ¬ onlyComments]]
];
filterToggle: XTk.Widget ~ XTkWidgets.CreateToggle[choices: filterChoices, 
hitProc: HandleButton, registerData: data, tq: tq];
styleChoices: XTkWidgets.ChoiceList ~ LIST[
[text: "screenStyle", callData: NEW[StyleOp ¬ screen]],
[text: "printStyle", callData: NEW[StyleOp ¬ print]]
];
styleToggle: XTk.Widget ~ XTkWidgets.CreateToggle[choices: styleChoices, 
hitProc: HandleButton, registerData: data, tq: tq];
linesChoices: XTkWidgets.ChoiceList ~ LIST[
[text: "allLines", callData: NEW[LinesOp ¬ all]],
[text: "firstLineOnly", callData: NEW[LinesOp ¬ first]]
];
linesToggle: XTk.Widget ~ XTkWidgets.CreateToggle[choices: linesChoices, 
hitProc: HandleButton, registerData: data, tq: tq];
menu1: XTk.Widget ~ XTkWidgets.CreateXStack[stack: LIST[filterToggle, styleToggle, linesToggle]];
menu2: XTk.Widget ~ XTkWidgets.CreateXStack[stack: LIST[
XTkWidgets.CreateLabel[text: "Levels: "],
MakeButton["First", NEW[LevelsOp ¬ first]],
MakeButton["More", NEW[LevelsOp ¬ more]],
MakeButton["Fewer", NEW[LevelsOp ¬ fewer]],
MakeButton["All", NEW[LevelsOp ¬ all]]
]];
rule: XTk.Widget ~ XTkWidgets.CreateRuler[widgetSpec: [geometry: XTk.G[h: 1]]];
header: XTk.Widget ~ XTkWidgets.CreateYStack[stack: LIST[menu1, menu2, rule]];
XTkWidgets.Choose[filterToggle, filterChoices.first];
XTkWidgets.AppendChild[widget, header, FALSE];
};
XTkWidgets.AppendChild[widget, bottomPart, FALSE];
XTkContainers.SetVaryingSize[widget];
XTkFriends.AssignInstPart[widget, tiogaWidgetClass, data];
};

TiogaWidgetDestruction: XTk.WidgetProc = {
data: ToolData ~ GetTiogaWidgetData[widget];
};

TiogaWidgetConfigure: XTk.ConfigureProc = {
NoteNewSize: PROC [data: ToolData, paint: BOOL] ~ {
w: XTk.Widget ~ data.inner;--
view: View ~ data.view;
size: Xl.Size ~ w.actual.size;
IF size.width<5 AND size.height<2 THEN RETURN;
XTkBitmapWidgets.CreateAndSetBitmap[widget: w, size: [f: size.width, s: size.height]];
data.context ¬ XTkBitmapWidgets.CreateContext[w];
IF view#NIL THEN SetViewSize[view, size.width, size.height, paint];
};
existW: BOOL ~ widget.actualMapping<unconfigured;
createW: BOOL ~ mapping<unconfigured AND ~existW;
data: ToolData ~ GetTiogaWidgetData[widget];
inheritedConfigureLR[widget, geometry, mapping, reConsiderChildren];
IF existW OR createW THEN NoteNewSize[data: data, paint: TRUE]
};

CreateTiogaWidget: PUBLIC PROC [widgetSpec: XTk.WidgetSpec ¬ [], doc: Doc ¬ NIL, scrollbar, menu: BOOL ¬ TRUE] RETURNS [tiogaWidget: XTk.Widget] ~ {
arguments: Atom.PropList ¬ NIL;
IF scrollbar THEN arguments ¬ Atom.PutPropOnList[arguments, $scrollbar, $scrollbar];
IF menu THEN arguments ¬ Atom.PutPropOnList[arguments, $menu, $menu];
tiogaWidget ¬ XTk.CreateWidget[widgetSpec, tiogaWidgetClass, arguments];
IF doc#NIL THEN SetDocument[tiogaWidget, doc];
RETURN [tiogaWidget];
};

SetDocument: PUBLIC PROC [tiogaWidget: XTk.Widget, doc: Doc] = {
data: ToolData ~ GetTiogaWidgetData[tiogaWidget];
view: View ~ CreateView[doc]; --@@@@@ Locking?
view.window ¬ CreateWindow[data];
IF data.view#NIL THEN ERROR; --@@@@@ I do not know how to destroy the old view
data.view ¬ view;
};
XWindowPaint: PROC [self: Window, action: PROC [Imager.Context]] ~ {
WITH self.data SELECT FROM
data: ToolData => {
proc: PROC ~ { action[data.context] };
Imager.DoSaveAll[data.context, proc];
};
ENDCASE;
};

XWindowSetScroll: PROC [self: Window, range: VisibleRange] ~ {
WITH self.data SELECT FROM
data: ToolData => {
scroller: XTk.Widget ~ data.scroller;
IF scroller#NIL THEN XTkScroller.SetState[data.scroller, [range.top, range.bot]];
};
ENDCASE;
};

windowClass: WindowClass ~ NEW[WindowClassRep ¬ [
Paint: XWindowPaint,
SetScroll: XWindowSetScroll
]];

CreateWindow: PROC [data: ToolData] RETURNS [Window] ~ {
RETURN[NEW[WindowRep ¬ [class: windowClass, data: data]]];
};

Paint: PROC [window: Window, action: PROC [Imager.Context]]  ~ {
class: WindowClass ~ window.class;
IF class.Paint#NIL THEN class.Paint[window, action];
};

SetScroll: PROC [window: Window, range: VisibleRange]  ~ {
class: WindowClass ~ window.class;
IF class.SetScroll#NIL THEN class.SetScroll[window, range];
};

OpenTiogaWindow: PROC [name: ROPE] ~ {
doc: Doc ~ CreateDoc[name];
contents: XTk.Widget ~ CreateTiogaWidget[
widgetSpec: [geometry: XTk.G[w: 600, h: 800]], doc: doc
];
shell: XTk.Widget ~ XTkWidgets.CreateShell[
child: contents, windowHeader: name, standardMigration: TRUE, className: $Tioga
];
XTkWidgets.RealizeShell[shell];
};

XOpenCommand: Commander.CommandProc ~ {
ENABLE { PFS.Error => ERROR CommanderOps.Failed[error.explanation]; };
argv: CommanderOps.ArgumentVector ~ CommanderOps.Parse[cmd];
FOR i: NAT IN [1..argv.argc) DO
name: ROPE ~ argv[i];
OpenTiogaWindow[name];
ENDLOOP;
};

Commander.Register["XOpen", XOpenCommand, "Open an X window browser on a tioga document."];

END.

ͺXTkTiogaImpl.mesa
Copyright Σ 1991, 1992 by Xerox Corporation.  All rights reserved.
Christian Jacobi, April 29, 1992 12:10 pm PDT
Doug Wyatt, April 1, 1992 6:30 pm PST

Tioga Formatting / Painting
Do this first, hoping that the style for nodePrev is still cached.
Show artwork if any of it is visible, text only if the baseline is visible.
PreviousLineStart: PROC [view: View, loc: TextNode.Location] 
RETURNS [TextNode.Location] ~ {
node: Node ~ loc.node;
where: INT ~ MAX[0, MIN[loc.where, TextEdit.Size[node]-1]];
start, next: INT _ where;
backStop: INT ~ MAX[0, where-300]; -- limit looking back too far when searching for CR's
WHILE start>backStop DO
SELECT TextEdit.FetchChar[node, start-1].char FROM
Ascii.CR, Ascii.LF => EXIT;
ENDCASE => start _ start - 1;
ENDLOOP;
};

pos is the current top line in the viewer; goal is the distance to back up.
algorithm works by incrementally formatting lines prior to pos until it reaches goal height.
The incremental backup procedure preserves the following invariants:
newPos is the current line start
totalLeading is the leading from the baseline of newPos to the baseline of pos
topIndent is the distance from the viewer top to baseline of newPos if newPos goes at top
topLeading is the style value for topLeading corresponding to newPos
no more characters in the node.  shows as blank line
format lines from tPos to starting pos
When reach here, have found all the line breaks from [node, where] to initial pos.
where holds the offset for the first one
lastBreak holds the offset for the last one
breakList holds the offsets for the previous ones 
have enough.  find correct line
use breakList to find correct break
need to get topLeading for pos.node
Once implement minGaps between lines, will also need topAscent for this line.  Should be able to get that from the line table.  (Except if continue to use this for top offset in ScrollToPosition... perhaps can just change that to back up a fixed number of lines.)

This could be more clever it the width hasn't changed.
X window class
@@@@@ Eventually we should watch whether widget is visible or not and free the bitmap when not visible.  Or when not used for 5 minutes, or, ...
@@@@@ Even better: We should switch back to use ImagerX11.  I have used BitmapWidgets to be able to use Tioga widgets independent of the maintenace state of ImagerX11.  (And also because the time used for initial font caching did drive me nuts).
@@@@@ fill in removal of view from doc 
@@@@@ Note that this is not a garbage collection finalizer but active widget destruction 
w#tiogaWidget !  This is called after calling the inherited ConfigureProc; therefore w has already been configured and its size is accurate.
Window object
Commands
Κ–
(cedarcode) style•NewlineDelimiter

˜
codeš
œ™Kšœ
Οe
œ7™BK™-K™%K™—š
Οk	˜	Kšœžœžœžœ˜Kšœžœ,˜6Kšœžœžœ	˜Kšœ
žœ˜(Kšœ
žœ!˜3Kš
œ˜Kšœ
žœ˜ Kšœ
žœ"˜4Kšžœ
žœ˜ Kšœžœ˜Kšœžœ	˜Kšœžœ
žœ˜Kš
œ˜Kšœžœ˜%Kš
œ˜Kšœžœ2˜CKš
œ	˜	Kš
œ	˜	K˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ
˜
Kš
œ	˜	Kš
œ˜K˜—KšΟnœžœ
ž˜KšžœGžœ™
˜κ
Kšžœ	˜šœžœ
žœ˜K˜Kšžœžœžœ
˜Kšœžœ˜Kšœžœ
˜Kšœžœ˜—
head™šŸ	œžœžœžœ
˜2K˜?Kšœžœ˜,šžœžœž˜1Kšœžœ˜1Kšžœ
˜—Kšžœ˜K˜K˜—šŸ
œžœžœ˜.Kšœ
žœ˜-Kšœžœ˜"K˜4Kšžœ˜
K˜K˜—šœ
žœžœ
žœ
žΟcœ
žœ
žœ˜PKš	œžœžœžœžœ˜+Kš	œžœžœžœžœ˜,Kš	œžœžœžœžœ
˜(K˜K˜—šŸœžœžœžœžœ œ˜NKšžœ
žœ	žœžœ˜8K˜K˜—š
Ÿœžœ!žœžœžœ˜TKšžœ/žœ%˜^K˜K˜—š
Ÿœžœ'žœžœžœ˜tK˜*šžœžœ
žœ#ž˜6K˜aKšžœ
˜—K˜K˜—šŸœžœ4žœžœžœ	žœ
žœ	˜˜
K˜/šžœž˜K˜.Kšžœ
˜—K˜5Kšœžœžœ
žœ˜3Kšžœžœ˜&K˜K˜—š
Ÿœžœ'žœžœžœ˜qK˜gKšžœ&˜,K˜K˜—šŸœžœ0žœžœžœ#žœ˜™
K˜…
šžœžœ
žœ#ž˜8K˜zKšžœ
˜—K˜K˜—šŸ
œžœ+žœžœžœ	žœ
žœ	˜Ž
K˜;šžœžœ˜-Kšžœ2˜6Kšžœ3˜7—K˜K˜—šŸœžœžœžœ˜?Kšœžœžœžœ
žœžœ˜:šžœ
žœžœ ˜4Kšœ	žœ˜Kšœžœ˜=Kš
žœžœ
žœ
žœžœ
˜>K˜K˜—šžœžœ
žœ ˜2Kš
œ8˜8Kšœžœ#˜:K˜—Kšžœ˜K˜K˜—šŸ
œžœžœžœ˜5Kš
œ2˜2K˜4Kšœžœ
˜šŸœžœžœ˜=Kš
œ9˜9Kšœžœ˜,K˜—šŸœžœžœžœ˜@Kšžœ
žœžœ
žœ˜IK˜—Kšœžœ ˜'Kšœžœ˜Kšœ
žœ	žœ˜!Kšœžœ˜K˜<šžœžœ
ž˜Kš
œ˜Kšœ9žœ˜Ašžœžœ
žœ ˜(Kšœž
œ˜Kšœ7 ˜PK˜
—šžœ ˜K˜Gšžœ	žœ ˜'Kš
œ)˜)šœžœ7˜MK™B—Kšœžœ0˜?Kšœ
žœ ˜-K˜
—Kšžœ6 ˜PK˜—K˜ šžœžœ
žœ -˜@K™KKš	œžœžœžœžœ
˜>Kšžœžœ
žœ 
˜,K˜—K˜K˜~K˜:šžœ3žœ˜;K˜0Kšžœžœžœžœ
žœ ˜OK˜—K˜Kšœ ˜"Kšžœžœ˜(K˜8Kšžœ
˜—K˜Kš
œ˜K˜K˜Kš
œ˜K˜AKšžœžœžœ˜$K˜K˜—šŸœžœžœ˜Ašžœžœžœžœ
˜<Kš
œ˜Kš
œ'˜'Kšœ: ˜MKšœ8 ˜JKšœ7 ˜KKš
œžœžœ
žœžœ ˜QKšœžœ# ˜;Kšœžœ& ˜AKšœžœ& ˜BKšœ	žœ˜Kšžœ˜!K˜—Kšžœ	˜K˜K˜—šŸœžœ˜/Kšœžœ
˜šžœžœ
žœž˜ Kš
œ!˜!Kšœžœ ˜,Kšœžœ ˜,K˜šžœžœ
žœ˜Kšœžœ˜$Kšœžœžœ˜;K˜—K˜Kšžœ
˜—K˜K˜—šŸ	œžœžœžœ˜5šœžœ˜*šžœžœ˜K˜K˜7K˜K˜—šžœžœ
žœž˜ K˜!Kš
œO˜OK˜&Kšžœžœžœ!˜TKšžœ
˜—K˜—K˜K˜K˜—šŸ
œžœžœžœžœ
žœžœ˜ešžœžœ
žœž˜ K˜Kšžœžœ
žœ
˜Kšžœ
˜—Kšœžœ
˜K˜K˜—šŸœžœ'žœ™]Kš
œ™Kšœžœžœžœ$™;Kšœ
žœ	™Kšœ
žœžœ 5™Xšžœž™šžœ(ž™2Kšœžœžœžœ
™Kšžœ™—Kšžœ
™—K™K™—Kšœ
žœžœ˜'šœ
žœžœ˜'K˜—šŸœžœ&žœ˜aK˜.K˜8K˜!Kš
œ˜Kšœžœ
˜Kšœ
žœ	˜Kšœžœ	 (˜@šžœžœ	ž˜(šžœ#ž˜-Kšœžœ
˜Kšžœ˜—Kšžœ
˜—Kš
œ)˜)šžœ
 )˜,K˜
K˜/Kš
žœžœžœ
žœ
žœ˜@Kšžœ
˜—Kš
œ˜Kš
œ˜Kšžœ˜K˜K˜—š
Ÿœžœ,žœ
žœ=žœ˜‘
Kš
œK™KKš
œ\™\š
œD™DKš
œ ™ Kš
œN™NKš
œY™YKš
œD™D—Kš
œ,˜,K˜1K˜.Kšœžœ
˜Kšœžœ˜Kšœžœžœ
žœ˜Kšœžœ˜Kšœžœ
˜Kšœžœ˜š
Ÿ
œžœ0žœ
žœGžœ˜£
K˜Kšœžœ
˜ Kšœžœ
˜Kšœžœ
žœ
žœ  ˜8Kšœ
žœ
˜Kšœžœ
˜K˜šžœ˜šžœ˜K˜FKšžœžœ
žœžœ
žœ
žœ˜7K˜/K˜
—šžœ˜K˜K˜K˜ K˜——šžœžœ
žœ˜0Kšžœ *˜9šžœ˜Kšœžœžœ #˜CK˜.šžœž˜ šžœž˜%Kšœžœžœžœ˜.Kšžœ
˜—Kšžœ
˜—K˜——Kšžœžœ6˜LK˜+Kšœ
žœ	žœ%žœ	˜NKš	œžœžœ	žœ
žœ9˜€
Kšœ0 -˜]šžœžœ˜Kš
œ4™4Kšœ!žœ
˜(K˜—K˜K˜
K˜"š
ž˜Kš
œ&™&K˜K˜‹
K˜Kšžœžœ%˜6K˜Kš
žœžœžœžœ
žœ
˜LKšžœžœ
žœ˜?Kšžœ
˜—Kšœžœ
˜#Kš
œR™RKš
œ(™(Kš
œ+™+Kš
œ2™2šžœ žœ
žœ˜8Kš
œ™Kšœžœ* ˜Pšžœž˜Kšœ ˜ šœ ˜&K˜K˜
K˜K˜—šžœ˜Kš
œ#™#Kšœžœ *˜:K˜Kšœ .˜?K˜1š	žœžœ
žœ
žœž˜/Kšžœžœžœ˜;Kšžœ
˜—K˜——K˜—K˜K˜K˜—šžœ
žœ˜Kš
œ#™#Kš
œ-˜-K˜1Kš
œ‡™‡K˜—K˜
K˜%šžœž˜Kšœ!žœ
˜)˜7K˜*—Kšžœžœ
žœ 8˜TK˜$K˜K˜Kšžœ žœ
žœ $˜QK˜ Kšžœ
˜—Kš
œ˜K˜K˜K™—šŸœžœžœ˜)Kš
œ˜Kšœžœ7 ˜TKšœžœ˜$Kš
œ9˜9K˜2K˜K˜K˜—šŸœžœžœ˜+Kšœžœ˜"šžœ
ž˜Kšœžœ
˜
šœ (˜/K˜;K˜—šžœ ˜*šžœžœ
žœž˜ K˜K˜Kšžœžœ
žœ
˜Kšžœ
˜—K˜——Kšžœ
žœ
žœ,˜@K˜K˜—šŸ
œžœžœ˜-Kšœžœ˜"šžœžœ˜K˜:K˜'K˜—Kšžœ
žœ
žœ,˜@K˜K˜—šœžœ˜&K˜—šŸœžœ ˜6K˜K˜K˜K˜—šœ
žœ˜+K˜—šŸœžœ˜5šœžœž˜$Kš
œ˜Kš
œ˜Kšœ
žœžœžœ˜:Kšžœžœ
˜—šžœžœ˜K˜K˜K˜—K˜K˜—šœ	žœ˜ K˜—šŸœžœ˜0K˜K˜K˜K˜—šœ	žœ˜K˜—šŸœžœ˜,K˜!K˜K˜K˜—šŸœžœžœ	žœ˜CK˜K˜K™6K˜K˜K˜—šŸœžœžœ˜(šžœžœ
ž˜Kšœžœ,˜5Kšœžœ+˜4Kšœžœ&˜/Kšœžœ"˜+Kšžœ
˜—K˜K˜——™KšœžœΞ
˜ζ
Kš
œf˜fK˜K™
K™υ
K˜Kšœ
žœžœ
˜!šœ
žœžœ˜Kš
œ˜Kšœžœ "˜AKšœžœ *˜CKšœžœ
 ˜6K˜K˜—šŸœ˜&Kšœžœ˜&K˜Kšžœžœ
žœ˜(Kš
œ˜K˜—šŸœ˜(Kšœžœ
˜$Kš
œ˜šžœžœ
žœ˜Kšœžœ˜*Kšœžœ˜"šžœž˜K˜K˜ ˜
Kšœžœžœ˜Kšœžœ˜Kš
žœžœžœ
žœžœ˜5Kš
œ˜K˜—Kšžœ
˜—K˜—Kš
œ˜K˜—šŸœžœžœžœ˜KKšžœžœ1˜?K˜K˜—šŸœ˜5Kšœžœ/žœ
˜EKšœ	žœ*žœ
˜;Kšœžœ˜'Kšœžœ˜Kš
œT˜TKšœž
œž
œ
ž
œ0˜=šžœžœ˜K˜-Kš
œL˜LKšœ2žœ˜9Kš
œ˜—Kšœ'ž
œ˜/šžœ	žœ˜š
Ÿ
œžœžœžœžœ˜EKšžœ˜…
K˜—šœ'žœ
˜,Kšœ$žœ˜FKšœ$žœ˜FKšœ!žœ˜?Kš
œ˜—Kš
œ˜šœ&žœ
˜+Kšœ žœ˜7Kšœžœ˜4Kš
œ˜—Kš
œ}˜}šœ&žœ
˜+Kšœžœ˜1Kšœ"žœ˜7Kš
œ˜—Kš
œ}˜}Kšœ3žœ*˜ašœ3žœ
˜8Kš
œ)˜)Kšœžœ˜+Kšœžœ˜)Kšœžœ˜+Kšœžœ˜&Kš
œ˜—Kš
œO˜OKšœ4žœ˜NKš
œ5˜5Kšœ'žœ˜.K˜—Kšœ+žœ˜2K˜%Kš
œ:˜:K˜—K˜šŸœ˜*Kš
œ,˜,K™'K™YKš
œ˜——˜šŸœ˜+šŸœžœžœ˜3Kš
œŒ
™Œ
Kš
œ˜Kš
œ˜Kš
œ˜Kšžœžœžœ
žœ
˜.Kš
œV˜VK˜1Kšžœžœ
žœ3˜CK˜—Kšœžœ%˜1Kšœ	žœžœ	˜1Kš
œ,˜,Kš
œD˜DKšžœžœ	žœ žœ
˜>Kš
œ˜—K˜šŸœžœ
žœ.žœžœžœžœ˜”
Kšœžœ
˜KšžœžœC˜TKšžœžœ9˜EK˜HKšžœžœ
žœ˜.Kšžœ˜Kš
œ˜—K˜šŸœžœ(˜@Kš
œ1˜1Kšœ Πbc˜.K˜!Kš	žœžœ
žœ
žœ 1˜NK˜Kš
œ˜——™
šŸœžœžœ˜Dšžœžœ
ž˜š
œ˜Kšœžœ˜&K˜%K˜—Kšžœ
˜—K˜K˜—šŸœžœ(˜>šžœžœ
ž˜š
œ˜Kš
œ%˜%Kšžœ
žœ
žœ=˜QK˜—Kšžœ
˜—K˜K˜—šœžœ˜1KšŸœ˜KšŸ	œ˜Kš
œ˜K˜—šŸœžœžœ
˜8Kšžœ
žœ0˜:K˜K˜—šŸœžœžœ˜@K˜"Kšžœ
žœ
žœ˜4K˜K˜—šŸ	œžœ+˜:K˜"Kšžœžœ
žœ ˜;K˜K˜——™šŸœžœžœ˜&Kš
œ˜š
œ)˜)Kš
œ7˜7Kš
œ˜—š
œ+˜+Kšœ8žœ˜OKš
œ˜—Kš
œ˜Kš
œ˜K˜—šŸœ˜'Kšžœžœ
žœ+˜FKš
œ<˜<šžœžœ
žœž˜Kšœžœ˜Kš
œ˜Kšžœ
˜—Kš
œ˜K˜—Kš
œ[˜[—K˜Kšžœ
˜—…—Zf~!