SynEdit: Fix markup fold color, after recent refactor

git-svn-id: trunk@58635 -
This commit is contained in:
martin 2018-07-26 01:42:22 +00:00
parent 41dc46374f
commit 8ca82403a0
4 changed files with 315 additions and 30 deletions

View File

@ -82,6 +82,8 @@ type
// //sfaSingleLineClosedByNext
sfaCloseForNextLine, // Fold closes this line, but keyword is on the next (e.g. "var" block)
sfaLastLineClose, // Fold is incomplete, and closed at last line of file
sfaCloseAndOpen, // This node has the same location/type as the neighbouring opposite node.
// eg an open node, matche exactly the previous node, which has to be a closing node of the same type and location (and vice versa for a closing node matching the next...)
sfaDefaultCollapsed,
sfaMarkup, // This node can be highlighted, by the matching Word-Pair Markup
@ -821,6 +823,17 @@ begin
end;
FNodeInfoList[FNodeCount] := AnInfo;
FNodeInfoList[FNodeCount].AllNodeIndex := FNodeCount;
If (FNodeCount > 0) and (sfaOpen in AnInfo.FoldAction) then begin
c := FNodeCount-1;
if (sfaClose in FNodeInfoList[c].FoldAction) and
//(AnInfo.FoldType = FNodeInfoList[c].FoldType) and // cfbtIfDef <> cfbtIfElse
(AnInfo.LogXStart = FNodeInfoList[c].LogXStart) and
(AnInfo.LogXEnd = FNodeInfoList[c].LogXEnd)
then begin
include(FNodeInfoList[FNodeCount].FoldAction, sfaCloseAndOpen);
include(FNodeInfoList[c].FoldAction, sfaCloseAndOpen);
end;
end;
inc(FNodeCount);
end;

View File

@ -74,7 +74,7 @@ type
PMarkupFoldColorInfo = ^TMarkupFoldColorInfo;
TMarkupFoldColorInfo = record
Row, PhysX, PhysX2, PhysCol: Integer;
PhysX, PhysX2, PhysCol: Integer;
ColorIdx: Integer;
Border : Boolean;
Ignore : Boolean; //no color no line
@ -585,7 +585,6 @@ var
with fFoldColorInfos[lCurIndex] do begin
SrcNode:= lCurNode; //needed by close node
PhysCol := lNodeCol;
Row := pRow;
PhysX := lNodeCol;
PhysX2 := PhysX + 1;
Border := PhysX < GetFirstCharacterColumn(lLineIdx); // use real one here not cache
@ -607,8 +606,6 @@ var
begin
ONodeFirstCol := FirstCharacterColumn[LineIdx];
FColumnCache[LineIdx] := ONodeFirstCol;
if ONodeFirstCol = 1 then
exit;
fNestList2.Line := LineIdx;
fNestList2.FoldGroup := FoldGroup;
@ -618,14 +615,15 @@ var
if sfaInvalid in LevelOpenNode.FoldAction then
exit; // try node before ??
if not (sfaOutlineKeepLevel in LevelOpenNode.FoldAction) then
exit;
if not FColumnCache.IsValidForLine[LevelOpenNode.LineIndex] then begin
InitColumnForKeepLvl(LevelOpenNode.LineIndex, FoldGroup);
if not FColumnCache.IsValidForLine[LevelOpenNode.LineIndex] then begin
if (LevelOpenNode.NestLvlStart < fHighlighter.FoldBlockEndLevel(LevelOpenNode.LineIndex-1, lCurNode.FoldGroup, [sfbIncludeDisabled])) and
(sfaCloseAndOpen in LevelOpenNode.FoldAction)
then
InitColumnForKeepLvl(LevelOpenNode.LineIndex, FoldGroup)
else
FColumnCache[LevelOpenNode.LineIndex] := FirstCharacterColumn[LevelOpenNode.LineIndex];
if not FColumnCache.IsValidForLine[LevelOpenNode.LineIndex] then
exit;
end;
end;
i := FColumnCache[LevelOpenNode.LineIndex];
FColumnCache[LineIdx] := min(i, ONodeFirstCol);
@ -671,10 +669,11 @@ begin
// DebugLn(' %s %s - %s %s', [FoldTypeToStr(fLastOpenNode.FoldType), IfThen(sfaOutlineKeepLevel in fLastOpenNode.FoldAction, '(Keep)', ''), FoldTypeToStr(lCurNode.FoldType), IfThen(sfaOutlineKeepLevel in lCurNode.FoldAction, '(Keep)', '')]);
{$ENDIF}
// find lastnode // first opening node on this line, that is = hl.line[-1].endnestlevel (-1)
if (lCurNode.NestLvlStart < fHighlighter.FoldBlockEndLevel(lCurNode.LineIndex-1, lCurNode.FoldGroup, [sfbIncludeDisabled])) and
(i < fNestList.Count - fNestList.OpeningOnLineCount) and
(not FColumnCache.IsValidForLine[lCurNode.LineIndex])
(sfaCloseAndOpen in lCurNode.FoldAction)
// // TODO: check that this is the FIRST sfaCloseAndOpen on this line
then
InitColumnForKeepLvl(lCurNode.LineIndex, lCurNode.FoldGroup);
@ -781,7 +780,6 @@ var
Ignore := False;
Border := False;
SrcNode:= lCurNode; //needed by close node
Row := pRow; //ToPos(lCurNode.LineIndex);
PhysX := lPhysX;
//if not FColumnCache.IsValidForLine[lCurNode.LineIndex] then
// FColumnCache[lCurNode.LineIndex] := FirstCharacterColumn[lCurNode.LineIndex];
@ -1002,21 +1000,6 @@ begin
{$ENDIF}
DoMarkupParentCloseFoldAtRow(pRow);
// update Col if last parent open node is closed and reopened on current line
for i := fFoldColorInfosCount - 1 downto 2 do begin
if (sfaOpen in fFoldColorInfos[i-2].SrcNode.FoldAction)
and (sfaClose in fFoldColorInfos[i-1].SrcNode.FoldAction)
and (sfaOpen in fFoldColorInfos[i].SrcNode.FoldAction)
and (fFoldColorInfos[i-2].SrcNode.FoldType = fFoldColorInfos[i-1].SrcNode.FoldType)
and (fFoldColorInfos[i-1].SrcNode.FoldType = fFoldColorInfos[i].SrcNode.FoldType)
and (fFoldColorInfos[i-1].PhysX = fFoldColorInfos[i].PhysX)
and (fFoldColorInfos[i-1].PhysX2 = fFoldColorInfos[i].PhysX2)
and (fFoldColorInfos[i-1].Row = pRow)
and (fFoldColorInfos[i].Row = pRow) then begin
FColumnCache[ToIdx(pRow)] := fFoldColorInfos[i-2].PhysCol;
end;
end;
// delete parents with bigger x
// to keep out mis indented blocks
lLastX := MaxInt;

View File

@ -1761,10 +1761,10 @@ begin
[sfaOpen, sfaOpenFold,sfaMarkup,sfaFold,sfaFoldFold, sfaMultiLine]);// try
CheckNode( 2, [], 0, 8, 72, 77, 2, 1, 2, 1,
cfbtIfDef, cfbtIfDef, FOLDGROUP_IFDEF,
[sfaClose, sfaMarkup,sfaOneLineClose, sfaSingleLine]); // {$ELSE}
[sfaClose, sfaMarkup,sfaOneLineClose, sfaSingleLine, sfaCloseAndOpen]); // {$ELSE}
CheckNode( 2, [], 0, 9, 72, 77, 1, 2, 1, 2,
cfbtIfDef, cfbtIfDef, FOLDGROUP_IFDEF,
[sfaMarkup,sfaOpen, sfaOpenFold,sfaFold,sfaFoldFold, sfaMultiLine]); // {$ELSE}
[sfaMarkup,sfaOpen, sfaOpenFold,sfaFold,sfaFoldFold, sfaMultiLine, sfaCloseAndOpen]); // {$ELSE}
// Line 3: //foo # pasminlvl=4 endlvl=4
CheckNode( 3, [], 0, 0, 2, 4, 4, 5, 4, 5,
cfbtSlashComment, cfbtSlashComment, FOLDGROUP_PASCAL,

View File

@ -9,6 +9,20 @@ uses
LCLProc, LCLType, SynEdit, SynHighlighterPas, SynEditMarkupFoldColoring,
SynEditMiscClasses, SynEditMarkup, SynEditHighlighterFoldBase;
type
TIntArray = array of integer;
TTestLineMarkupResult = record
aRow: Integer;
aExpColumns, aExpColors, aExpWords, aExpWordsColor: Array of Integer;
end;
TTestLineMarkupResults = array of TTestLineMarkupResult;
// build expectations
function ExpR(aExpColumns, aExpColors: Array of Integer): TTestLineMarkupResult;
function ExpR(aExpColumns, aExpColors, aExpWords, aExpWordsColor: Array of Integer): TTestLineMarkupResult;
type
{ TTestMarkupFoldColoring }
@ -24,6 +38,7 @@ type
procedure TestNoInvalidate(aName: string = '');
procedure TestInvalidate(aName: string; aExpFrom, aExpTo: Integer);
procedure TestBeginMarkup(aName: string = '');
procedure TestRowColumns(aName: string; aRow: Integer; aExp: TTestLineMarkupResult; aScrollOffs: Integer = 0); overload;
procedure TestRowColumns(aName: string; aRow: Integer;
aExpColumns, aExpColors: Array of Integer; aScrollOffs: Integer = 0); overload;
(* TestRowColumns( name, row,
@ -35,26 +50,56 @@ type
*)
procedure TestRowColumns(aName: string; aRow: Integer;
aExpColumns, aExpColors, aExpWords, aExpWordsColor: Array of Integer; aScrollOffs: Integer = 0); overload;
procedure TestLines(exp: TTestLineMarkupResults; backward: Boolean = false);
protected
procedure SetUp; override;
procedure TearDown; override;
procedure ReCreateEdit(AText: TStringArray = nil; AHeight: integer = 30; ATopLine: Integer = 1); reintroduce;
function TestText1: TStringArray;
function TestText2: TStringArray; // case indent
function TestTextEditIfThen(out ExpLines, ExpLinesEdited: TTestLineMarkupResults): TStringArray; // edit text => update if/else
function TestTextMultiLineIfIndent: TStringArray;
function TestTextInval1: TStringArray;
function TestTextScroll1: TStringArray;
function TestTextCaseScroll1(out ExpLines: TTestLineMarkupResults): TStringArray;
procedure EnableOutlines(AEnbledTypes: TPascalCodeFoldBlockTypes);
published
procedure TestColors;
procedure TestCaseLabelIndent; // issue https://bugs.freepascal.org/view.php?id=33154
procedure TestMultiLineIfIndent; // issue https://bugs.freepascal.org/view.php?id=32852
procedure TestEditIfThen;
procedure TestInvalidateIfElseChain;
procedure TestInvalidateScroll;
procedure TestCaseScroll;
end;
implementation
function CopyArray(a: array of Integer): TIntArray;
begin
SetLength(Result, Length(a));
if Length(a) > 0 then
move(a[0], Result[0], Length(a) * SizeOf(a[0]));
end;
function ExpR(aExpColumns, aExpColors: array of Integer): TTestLineMarkupResult;
begin
Result.aExpColumns := CopyArray(aExpColumns);
Result.aExpColors := CopyArray(aExpColors);
Result.aExpWords := nil;
Result.aExpWordsColor := nil;
end;
function ExpR(aExpColumns, aExpColors, aExpWords,
aExpWordsColor: array of Integer): TTestLineMarkupResult;
begin
Result.aExpColumns := CopyArray(aExpColumns);
Result.aExpColors := CopyArray(aExpColors);
Result.aExpWords := CopyArray(aExpWords);
Result.aExpWordsColor := CopyArray(aExpWordsColor);
end;
{ TTestMarkupFoldColoring }
procedure TTestMarkupFoldColoring.ClearInvalidatedLines;
@ -93,6 +138,12 @@ begin
TestNoInvalidate(aName);
end;
procedure TTestMarkupFoldColoring.TestRowColumns(aName: string; aRow: Integer;
aExp: TTestLineMarkupResult; aScrollOffs: Integer);
begin
TestRowColumns(aName, aRow, aExp.aExpColumns, aExp.aExpColors, aExp.aExpWords, aExp.aExpWordsColor, aScrollOffs);
end;
procedure TTestMarkupFoldColoring.TestRowColumns(aName: string; aRow: Integer;
aExpColumns, aExpColors: array of Integer; aScrollOffs: Integer);
begin
@ -108,6 +159,7 @@ var
startCol: TLazSynDisplayTokenBound;
gotColor: TSynSelectedColor;
begin
aName := aName + '; row=' + IntToStr(aRow);
if FOnlyTestVisibleRows then begin
srow := SynEdit.RowToScreenRow(aRow);
if (srow < 0) or (srow > SynEdit.LinesInWindow) then
@ -177,6 +229,21 @@ begin
PopBaseName;
end;
procedure TTestMarkupFoldColoring.TestLines(exp: TTestLineMarkupResults;
backward: Boolean);
var
i: LongInt;
begin
TestBeginMarkup('');
if backward then
for i := high(exp) downto low(exp) do
TestRowColumns('Line ', i+1, exp[i])
else
for i := low(exp) to high(exp) do
TestRowColumns('Line ', i+1, exp[i]);
Markup.EndMarkup;
end;
procedure TTestMarkupFoldColoring.SetUp;
begin
Markup := nil;
@ -265,6 +332,77 @@ begin
Result[18] := 'end;';
end;
function TTestMarkupFoldColoring.TestTextEditIfThen(out ExpLines,
ExpLinesEdited: TTestLineMarkupResults): TStringArray;
var
i: Integer;
begin
SetLength(Result, 29);
SetLength(ExpLines, 29);
SetLength(ExpLinesEdited, 18); // stop at bad line // HL may change....
Result[ 0] := 'program a;';
Result[ 1] := ' begin';
Result[ 2] := '';
Result[ 3] := '';
Result[ 4] := ' if a then';
Result[ 5] := '';
Result[ 6] := ' //(* remove the //'; // edit this line, remov //
Result[ 7] := '';
Result[ 8] := '';
Result[ 9] := ' if b then';
Result[10] := '';
Result[11] := ' //*)';
Result[12] := '';
Result[13] := '';
Result[14] := ' else // not updated below';
Result[15] := '';
Result[16] := '';
Result[17] := ' else'; // bad code after edit, depends on HL... // no ";" statement continues
Result[18] := ' begin';
Result[19] := '';
Result[20] := ' end';
Result[21] := ' ;';
Result[22] := '';
Result[23] := '';
Result[24] := '';
Result[25] := '';
Result[26] := '';
Result[27] := '';
Result[28] := ' end.';
ExpLines[ 0] := ExpR([], []);
ExpLines[ 1] := ExpR([], [], [3,8], [1]); // begin
for i := 2 to 3 do
ExpLines[ i] := ExpR([3], [1], [], []);
ExpLines[ 4] := ExpR([3], [1], [7,9, 12,16], [2, 2]); // if a then
for i := 5 to 8 do
ExpLines[ i] := ExpR([3, 7], [1, 2]);
ExpLines[ 9] := ExpR([3], [1], [6,8, 11,15], [ 3, 3]); // if b then (nested)
for i := 10 to 16 do
ExpLines[ i] := ExpR([3, 6], [1, 3]);
ExpLines[14] := ExpR([3, 6], [1, 3], [10,14], [ 3]); // else
ExpLines[17] := ExpR([3], [1], [5,9], [2]); // else
ExpLines[18] := ExpR([3, 5], [1, 2], [9,14], [2]); // begin (merged color)
ExpLines[19] := ExpR([3, 5], [1, 2]);
ExpLines[20] := ExpR([3, 5], [1, 2], [9,12], [2]); // end
ExpLines[21] := ExpR([3], [1]); //, [7,8], [2]); // the "end" ended the "else" should be the ";"
for i := 22 to 27 do
ExpLines[ i] := ExpR([3], [1], [], []);
ExpLines[28] := ExpR([], [], [3,6], [1]);
// after enabling the (* comment; removing the //
ExpLinesEdited[ 0] := ExpR([], []);
ExpLinesEdited[ 1] := ExpR([], [], [3,8], [1]); // begin
for i := 2 to 3 do
ExpLinesEdited[ i] := ExpR([3], [1], [], []);
ExpLinesEdited[ 4] := ExpR([3], [1], [7,9, 12,16], [2, 2]); // if a then
for i := 5 to 16 do
ExpLinesEdited[ i] := ExpR([3, 7], [1, 2], [], []);
ExpLinesEdited[ 9] := ExpR([3], [1], [], []); // (* if b then
ExpLinesEdited[14] := ExpR([3, 7], [1, 2], [10,14], [2]); // else
ExpLinesEdited[17] := ExpR([3], [1], [], []); // else // without if then
end;
function TTestMarkupFoldColoring.TestTextMultiLineIfIndent: TStringArray;
begin
SetLength(Result, 29);
@ -376,6 +514,105 @@ begin
Result[111] := 'end.';
end;
function TTestMarkupFoldColoring.TestTextCaseScroll1(out
ExpLines: TTestLineMarkupResults): TStringArray;
begin
SetLength(Result, 44+30);
SetLength(ExpLines, 44);
Result[ 0] := 'program a;';
Result[ 1] := 'begin';
Result[ 2] := ' case var1 of';
Result[ 3] := ' 1: begin';
Result[ 4] := ' code;';
Result[ 5] := ' end';
Result[ 6] := ' 2: begin';
Result[ 7] := ' code;';
Result[ 8] := ' end';
Result[ 9] := ' else';
Result[10] := ' begin';
Result[11] := ' code;';
Result[12] := ' end;';
Result[13] := ' end;';
Result[14] := '';
Result[15] := ' case';
Result[16] := ' var1 of';
Result[17] := ' 1: begin';
Result[18] := ' code;';
Result[19] := ' end';
Result[20] := ' 2: begin';
Result[21] := ' code;';
Result[22] := ' end';
Result[23] := ' else';
Result[24] := ' begin';
Result[25] := ' code;';
Result[26] := ' end;';
Result[27] := ' end;';
Result[28] := '';
Result[29] := ' case';
Result[30] := ' var1 of';
Result[31] := ' 1: begin';
Result[32] := ' code;';
Result[33] := ' end';
Result[34] := ' 2: begin';
Result[35] := ' code;';
Result[36] := ' end';
Result[37] := ' else';
Result[38] := ' begin';
Result[39] := ' code;';
Result[40] := ' end;';
Result[41] := ' end;';
Result[42] := '';
Result[43] := 'end.';
ExpLines[ 0] := ExpR([], []);
ExpLines[ 1] := ExpR([], [], [1,6], [1]); // begin
ExpLines[ 2] := ExpR([1], [1], [3,7, 13,15], [2,2]); // case var 1 of
ExpLines[ 3] := ExpR([1, 3], [1,2], [10,16], [3]); // 1: begin
ExpLines[ 4] := ExpR([1, 3, 7], [1,2,3]);
ExpLines[ 5] := ExpR([1, 3], [1,2], [ 7,10], [3]); // end
ExpLines[ 6] := ExpR([1, 3], [1,2], [10,16], [3]); // 2: begin
ExpLines[ 7] := ExpR([1, 3, 7], [1,2,3]);
ExpLines[ 8] := ExpR([1, 3], [1,2], [ 7,10], [3]); // end
ExpLines[ 9] := ExpR([1, 3], [1,2]);
ExpLines[10] := ExpR([1, 3], [1,2], [7,13], [3]); // begin
ExpLines[11] := ExpR([1, 3, 7], [1,2,3]);
ExpLines[12] := ExpR([1, 3], [1,2], [7,10], [3]); // end
ExpLines[13] := ExpR([1, 3], [1,2], [5,9], [2]); // end // case
ExpLines[14] := ExpR([1], [1]);
ExpLines[15] := ExpR([1], [1], [3,7], [2]); // case
ExpLines[16] := ExpR([1, 3], [1,2], [11,13], [2]); // var 1 of
ExpLines[17] := ExpR([1, 3], [1,2], [8,14], [3]); // 1: begin
ExpLines[18] := ExpR([1, 3, 5], [1,2,3]);
ExpLines[19] := ExpR([1, 3], [1,2], [5, 8], [3]); // end
ExpLines[20] := ExpR([1, 3], [1,2], [8,14], [3]); // 2: begin
ExpLines[21] := ExpR([1, 3, 5], [1,2,3]);
ExpLines[22] := ExpR([1, 3], [1,2], [5, 8], [3]); // end
ExpLines[23] := ExpR([1], [1]);
ExpLines[24] := ExpR([1, 3], [1,2], [5,11], [3]); // begin
ExpLines[25] := ExpR([1, 3, 5], [1,2,3]);
ExpLines[26] := ExpR([1, 3], [1,2], [5,8], [3]); // end
ExpLines[27] := ExpR([1], [1], [3,6], [2]); // end // case
ExpLines[28] := ExpR([1], [1]);
ExpLines[29] := ExpR([1], [1], [3,7], [2]); // case
ExpLines[30] := ExpR([1, 3], [1,2], [11,13], [2]); // var 1 of
ExpLines[31] := ExpR([1, 3], [1,2], [10,16], [3]); // 1: begin
ExpLines[32] := ExpR([1, 3, 7], [1,2,3]);
ExpLines[33] := ExpR([1, 3], [1,2], [ 7,10], [3]); // end
ExpLines[34] := ExpR([1, 3], [1,2], [10,16], [3]); // 2: begin
ExpLines[35] := ExpR([1, 3, 7], [1,2,3]);
ExpLines[36] := ExpR([1, 3], [1,2], [ 7,10], [3]); // end
ExpLines[37] := ExpR([1, 3], [1,2]);
ExpLines[38] := ExpR([1, 3], [1,2], [7,13], [3]); // begin
ExpLines[39] := ExpR([1, 3, 7], [1,2,3]);
ExpLines[40] := ExpR([1, 3], [1,2], [7,10], [3]); // end
ExpLines[41] := ExpR([1], [1], [3,7], [2]); // end // case
ExpLines[42] := ExpR([1], [1]);
ExpLines[43] := ExpR([], [], [1,3], [1]); // end.
end;
procedure TTestMarkupFoldColoring.EnableOutlines(AEnbledTypes: TPascalCodeFoldBlockTypes);
var
i: TPascalCodeFoldBlockType;
@ -504,6 +741,36 @@ begin
PopBaseName;
end;
procedure TTestMarkupFoldColoring.TestEditIfThen;
var
Lines: TStringArray;
ExpLines, ExpLinesAfter: TTestLineMarkupResults;
begin
Lines := TestTextEditIfThen(ExpLines, ExpLinesAfter);
ReCreateEdit(Lines);
EnableFolds([cfbtBeginEnd.. cfbtNone], [cfbtSlashComment]);
EnableOutlines([cfbtBeginEnd.. cfbtNone]);
PushBaseName('Before edit');
TestLines(ExpLines);
SynEdit.TestTypeText(11, 7, #8);
PopPushBaseName('After edit');
TestLines(ExpLinesAfter);
ReCreateEdit(Lines);
EnableFolds([cfbtBeginEnd.. cfbtNone], [cfbtSlashComment]);
EnableOutlines([cfbtBeginEnd.. cfbtNone]);
PopPushBaseName('backwards Before edit');
TestLines(ExpLines, True);
SynEdit.TestTypeText(11, 7, #8);
PopPushBaseName('backwards After edit');
TestLines(ExpLinesAfter, True);
end;
procedure TTestMarkupFoldColoring.TestInvalidateIfElseChain;
var
i: Integer;
@ -637,6 +904,28 @@ begin
PopBaseName;
end;
procedure TTestMarkupFoldColoring.TestCaseScroll;
var
Lines: TStringArray;
ExpLines: TTestLineMarkupResults;
i: Integer;
begin
Lines := TestTextCaseScroll1(ExpLines);
ReCreateEdit(Lines, 30, 43);
EnableFolds([cfbtBeginEnd.. cfbtNone], [cfbtSlashComment]);
EnableOutlines([cfbtBeginEnd.. cfbtNone]);
FOnlyTestVisibleRows := True;
PushBaseName('');
for i := 43 downto 1 do begin
SynEdit.TopLine := i;
PopPushBaseName('scroll '+IntToStr(i));
TestLines(ExpLines);
end;
end;
initialization
RegisterTest(TTestMarkupFoldColoring);