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;
Tioga Formatting / Painting
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];
Do this first, hoping that the style for nodePrev is still cached.
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
Show artwork if any of it is visible, text only if the baseline is visible.
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;
};
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;
};
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] = {
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
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 {
no more characters in the node. shows as blank line
lines ¬ 1; prev ¬ [node, where]; RETURN
};
tPos ¬ [node, where];
lines ¬ 0;
lineInfo ¬ TEditFormat.Allocate[];
DO
format lines from tPos to starting pos
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;
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
IF totalLeading+topIndent >= goal
AND leading > 0
THEN {
have enough. find correct line
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 => {
use breakList to find correct break
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 {
need to get topLeading for pos.node
NodeStyleOps.ApplyAll[style, pos.node, kind];
topLeading ¬ NodeStyle.GetInt[style, topLeading];
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.)
};
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;
This could be more clever it the width hasn't changed.
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;
};
X window class
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];
@@@@@ 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).
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];
@@@@@ fill in removal of view from doc
@@@@@ Note that this is not a garbage collection finalizer but active widget destruction
};
TiogaWidgetConfigure: XTk.ConfigureProc = {
NoteNewSize:
PROC [data: ToolData, paint:
BOOL] ~ {
w#tiogaWidget ! This is called after calling the inherited ConfigureProc; therefore w has already been configured and its size is accurate.
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;
};