mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-12 06:16:05 +02:00
SynEdit: Fixes to Folding (certain folds were mismatched since revision 19048 #10773be327 / Force-close "begin" at next "procedure"
git-svn-id: trunk@19056 -
This commit is contained in:
martin
parent
2f1f84b816
commit
019e7e3aa2
@ -158,9 +158,10 @@ type
|
||||
property Children: TSynCustomCodeFoldBlock read FChildren;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
function Compare(Block: TSynCustomCodeFoldBlock): integer; virtual;
|
||||
procedure WriteDebugReport;
|
||||
public
|
||||
property BlockType: Pointer read FBlockType write FBlockType;
|
||||
procedure InitRootBlockType(AType: Pointer);
|
||||
property BlockType: Pointer read FBlockType;
|
||||
property Parent: TSynCustomCodeFoldBlock read FParent;
|
||||
property Child[ABlockType: Pointer]: TSynCustomCodeFoldBlock read GetChild;
|
||||
end;
|
||||
@ -1524,15 +1525,26 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TSynCustomCodeFoldBlock.Compare(Block: TSynCustomCodeFoldBlock
|
||||
): integer;
|
||||
procedure TSynCustomCodeFoldBlock.WriteDebugReport;
|
||||
procedure debugout(n: TSynCustomCodeFoldBlock; s1, s: String; p: TSynCustomCodeFoldBlock);
|
||||
begin
|
||||
if n = nil then exit;
|
||||
if n.FParent <> p then
|
||||
DebugLn([s1, 'Wrong Parent for', ' (', PtrInt(n), ')']);
|
||||
DebugLn([s1, PtrUInt(n.BlockType), ' (', PtrInt(n), ')']);
|
||||
debugout(n.FLeft, s+'L: ', s+' ', p);
|
||||
debugout(n.FRight, s+'R: ', s+' ', p);
|
||||
debugout(n.FChildren, s+'C: ', s+' ', n);
|
||||
end;
|
||||
begin
|
||||
if BlockType>Block.BlockType then
|
||||
Result:=1
|
||||
else if BlockType<Block.BlockType then
|
||||
Result:=-1
|
||||
else
|
||||
Result:=0;
|
||||
debugout(self, '', '', nil);
|
||||
end;
|
||||
|
||||
procedure TSynCustomCodeFoldBlock.InitRootBlockType(AType: Pointer);
|
||||
begin
|
||||
if assigned(FParent) then
|
||||
raise Exception.Create('Attempt to modify a FoldBlock');
|
||||
FBlockType := AType;
|
||||
end;
|
||||
|
||||
{ TSynCustomHighlighterRange }
|
||||
@ -1559,8 +1571,12 @@ begin
|
||||
Result:=1
|
||||
else if RangeType>Range.RangeType then
|
||||
Result:=-1
|
||||
else if Pointer(FTop) < Pointer(Range.FTop) then
|
||||
Result:= -1
|
||||
else if Pointer(FTop) > Pointer(Range.FTop) then
|
||||
Result:= 1
|
||||
else
|
||||
Result := FTop.Compare(Range.FTop);
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TSynCustomHighlighterRange.Add(ABlockType: Pointer;
|
||||
@ -1609,7 +1625,8 @@ procedure TSynCustomHighlighterRange.WriteDebugReport;
|
||||
begin
|
||||
debugln('TSynCustomHighlighterRange.WriteDebugReport ',DbgSName(Self),
|
||||
' RangeType=',dbgs(RangeType),' StackSize=',dbgs(CodeFoldStackSize));
|
||||
debugln(' BlockType=',dbgs(FTop.BlockType));
|
||||
debugln(' Block=',dbgs(PtrInt(FTop)));
|
||||
FTop.WriteDebugReport;
|
||||
end;
|
||||
|
||||
{ TSynCustomHighlighterRanges }
|
||||
|
||||
@ -329,6 +329,7 @@ type
|
||||
function StartPascalCodeFoldBlock(ABlockType: TPascalCodeFoldBlockType;
|
||||
SubBlock: boolean = false): TSynCustomCodeFoldBlock;
|
||||
procedure EndCodeFoldBlock(DecreaseLevel: Boolean = True); override;
|
||||
procedure CloseBeginEndBlocks;
|
||||
function GetRangeClass: TSynCustomHighlighterRangeClass; override;
|
||||
{$ENDIF}
|
||||
procedure EndCodeFoldBlockLastLine;
|
||||
@ -1149,6 +1150,7 @@ begin
|
||||
if not(rsAfterEqual in fRange) and
|
||||
(fRange * [rsInterface, rsImplementation] = []) then
|
||||
begin
|
||||
CloseBeginEndBlocks;
|
||||
if TopPascalCodeFoldBlockType=cfbtVarType then EndCodeFoldBlockLastLine;
|
||||
if TopPascalCodeFoldBlockType=cfbtUnitSection then EndCodeFoldBlockLastLine;
|
||||
StartPascalCodeFoldBlock(cfbtUnitSection);
|
||||
@ -1286,6 +1288,7 @@ begin
|
||||
if KeyComp('Function') then begin
|
||||
if not(rsAfterEqual in fRange) then begin
|
||||
TSynPasSynRange(CodeFoldRange).BracketNestLevel := 0; // Reset in case of partial code
|
||||
CloseBeginEndBlocks;
|
||||
if TopPascalCodeFoldBlockType=cfbtVarType then EndCodeFoldBlockLastLine;
|
||||
if ((rsImplementation in fRange) and
|
||||
not(TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection]))
|
||||
@ -1307,6 +1310,7 @@ begin
|
||||
if KeyComp('Procedure') then begin
|
||||
if not(rsAfterEqual in fRange) then begin
|
||||
TSynPasSynRange(CodeFoldRange).BracketNestLevel := 0; // Reset in case of partial code
|
||||
CloseBeginEndBlocks;
|
||||
if TopPascalCodeFoldBlockType=cfbtVarType then EndCodeFoldBlockLastLine;
|
||||
if ((rsImplementation in fRange) and
|
||||
not(TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection]))
|
||||
@ -1405,6 +1409,7 @@ function TSynPasSyn.Func136: TtkTokenKind;
|
||||
begin
|
||||
if KeyComp('Finalization') then begin
|
||||
TSynPasSynRange(CodeFoldRange).BracketNestLevel := 0; // Reset in case of partial code
|
||||
CloseBeginEndBlocks;
|
||||
if TopPascalCodeFoldBlockType=cfbtVarType then EndCodeFoldBlockLastLine;
|
||||
if TopPascalCodeFoldBlockType=cfbtUnitSection then EndCodeFoldBlockLastLine;
|
||||
StartPascalCodeFoldBlock(cfbtUnitSection);
|
||||
@ -1429,6 +1434,7 @@ begin
|
||||
if not(rsAfterEqual in fRange) then
|
||||
begin
|
||||
TSynPasSynRange(CodeFoldRange).BracketNestLevel := 0; // Reset in case of partial code
|
||||
CloseBeginEndBlocks;
|
||||
if TopPascalCodeFoldBlockType = cfbtVarType then EndCodeFoldBlockLastLine;
|
||||
if ((rsImplementation in fRange) and
|
||||
not(TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection]))
|
||||
@ -1448,6 +1454,7 @@ begin
|
||||
if KeyComp('Constructor') then begin
|
||||
if not(rsAfterEqual in fRange) then begin
|
||||
TSynPasSynRange(CodeFoldRange).BracketNestLevel := 0; // Reset in case of partial code
|
||||
CloseBeginEndBlocks;
|
||||
if TopPascalCodeFoldBlockType=cfbtVarType then EndCodeFoldBlockLastLine;
|
||||
if ((rsImplementation in fRange) and
|
||||
not(TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection]))
|
||||
@ -1458,6 +1465,7 @@ begin
|
||||
end else
|
||||
if KeyComp('Implementation') then begin
|
||||
TSynPasSynRange(CodeFoldRange).BracketNestLevel := 0; // Reset in case of partial code
|
||||
CloseBeginEndBlocks;
|
||||
if TopPascalCodeFoldBlockType=cfbtVarType then EndCodeFoldBlockLastLine;
|
||||
if TopPascalCodeFoldBlockType=cfbtUnitSection then EndCodeFoldBlockLastLine;
|
||||
StartPascalCodeFoldBlock(cfbtUnitSection);
|
||||
@ -1477,6 +1485,7 @@ function TSynPasSyn.Func168: TtkTokenKind;
|
||||
begin
|
||||
if KeyComp('Initialization') then begin
|
||||
TSynPasSynRange(CodeFoldRange).BracketNestLevel := 0; // Reset in case of partial code
|
||||
CloseBeginEndBlocks;
|
||||
if TopPascalCodeFoldBlockType=cfbtVarType then EndCodeFoldBlockLastLine;
|
||||
if TopPascalCodeFoldBlockType=cfbtUnitSection then EndCodeFoldBlockLastLine;
|
||||
StartPascalCodeFoldBlock(cfbtUnitSection);
|
||||
@ -1631,7 +1640,7 @@ begin
|
||||
{$ENDIF}
|
||||
SetAttributesOnChange({$IFDEF FPC}@{$ENDIF}DefHighlightChange);
|
||||
if hcCodeFolding in Capabilities then
|
||||
RootCodeFoldBlock.BlockType := Pointer(PtrInt(cfbtNone));
|
||||
RootCodeFoldBlock.InitRootBlockType(Pointer(PtrInt(cfbtNone)));
|
||||
|
||||
InitIdent;
|
||||
MakeMethodTables;
|
||||
@ -2247,7 +2256,7 @@ var
|
||||
begin
|
||||
p := inherited TopCodeFoldBlockType;
|
||||
if p >= CountPascalCodeFoldBlockOffset then
|
||||
p := p - PtrInt(CountPascalCodeFoldBlockOffset);
|
||||
p := p - PtrUInt(CountPascalCodeFoldBlockOffset);
|
||||
Result := TPascalCodeFoldBlockType(PtrUInt(p));
|
||||
end;
|
||||
|
||||
@ -2455,6 +2464,16 @@ begin
|
||||
inherited EndCodeFoldBlock(DecreaseLevel);
|
||||
end;
|
||||
|
||||
procedure TSynPasSyn.CloseBeginEndBlocks;
|
||||
begin
|
||||
if TopPascalCodeFoldBlockType <> cfbtBeginEnd then
|
||||
exit;
|
||||
while TopPascalCodeFoldBlockType = cfbtBeginEnd do
|
||||
EndCodeFoldBlock;
|
||||
if TopPascalCodeFoldBlockType = cfbtProcedure then
|
||||
EndCodeFoldBlock; // This procedure did have a begin/end block, so it must end too
|
||||
end;
|
||||
|
||||
procedure TSynPasSyn.EndCodeFoldBlockLastLine;
|
||||
begin
|
||||
EndCodeFoldBlock;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user