paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-14 14:39:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

SynEdit: PascalHighlighter, improve param/type attribs for anonymous procedures

Browse Source
This commit is contained in:
Martin 2025-03-13 11:14:25 +01:00
parent be2125328e
commit f32ec2f41b
2 changed files with 168 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
components/synedit/synhighlighterpas.pp
View File

@ -123,6 +123,7 @@ type
// unit ____ // used for "deprecated" detection / check in tsAfterProcName // unit ____ // used for "deprecated" detection / check in tsAfterProcName
// >>> after a procedure/function/... keyword, when the name is expected (not for types) // >>> after a procedure/function/... keyword, when the name is expected (not for types)
// >>> renewed after dot "." // >>> renewed after dot "."
tsAfterAnonProc, // [OPT] for rsInParamDeclaration
tsAfterProcName, // procedure NAME tsAfterProcName, // procedure NAME
// unit NAME // used for "deprecated" detection // unit NAME // used for "deprecated" detection
tsAfterIs, // maybe "is nested" tsAfterIs, // maybe "is nested"
@ -1881,6 +1882,8 @@ begin
if TopPascalCodeFoldBlockType in [cfbtProcedure, cfbtAnonymousProcedure] if TopPascalCodeFoldBlockType in [cfbtProcedure, cfbtAnonymousProcedure]
then StartPascalCodeFoldBlock(cfbtLocalLabelBlock) then StartPascalCodeFoldBlock(cfbtLocalLabelBlock)
else StartPascalCodeFoldBlock(cfbtLabelBlock); else StartPascalCodeFoldBlock(cfbtLabelBlock);
FTokenState := tsNone; // clear tsAfterProcName for undetected anon procedure
fRange := fRange - [rsInProcHeader];
end; end;
Result := tkKey; Result := tkKey;
end end
@ -1982,6 +1985,8 @@ begin
// TODO: cfbtIfThen..cfbtWithDo => only if they are nested in one of the above // TODO: cfbtIfThen..cfbtWithDo => only if they are nested in one of the above
cfbtIfThen, cfbtIfElse, cfbtForDo, cfbtWhileDo, cfbtWithDo cfbtIfThen, cfbtIfElse, cfbtForDo, cfbtWhileDo, cfbtWithDo
]); ]);
FTokenState := tsNone; // clear tsAfterProcName for undetected anon procedure
fRange := fRange - [rsInProcHeader];
//debugln('TSynPasSyn.Func37 BEGIN ',dbgs(ord(TopPascalCodeFoldBlockType)),' LineNumber=',dbgs(fLineNumber),' ',dbgs(MinimumNestFoldBlockLevel),' ',dbgs(CurrentCodeFoldBlockLevel)); //debugln('TSynPasSyn.Func37 BEGIN ',dbgs(ord(TopPascalCodeFoldBlockType)),' LineNumber=',dbgs(fLineNumber),' ',dbgs(MinimumNestFoldBlockLevel),' ',dbgs(CurrentCodeFoldBlockLevel));
end else end else
if FExtendedKeywordsMode and KeyComp('Break') and if FExtendedKeywordsMode and KeyComp('Break') and
@ -2071,7 +2076,9 @@ begin
else else
if (tfb in [cfbtNone, cfbtProgram, cfbtUnit, cfbtUnitSection]) then if (tfb in [cfbtNone, cfbtProgram, cfbtUnit, cfbtUnitSection]) then
StartPascalCodeFoldBlock(cfbtVarBlock); StartPascalCodeFoldBlock(cfbtVarBlock);
FTokenState := tsNone; // clear tsAfterProcName for anon undetected procedure
FNextTokenState := tsAfterVarConstType; FNextTokenState := tsAfterVarConstType;
fRange := fRange - [rsInProcHeader];
end; end;
Result := tkKey; Result := tkKey;
end end
@ -2476,7 +2483,9 @@ begin
if tfb in [cfbtProcedure, cfbtAnonymousProcedure] if tfb in [cfbtProcedure, cfbtAnonymousProcedure]
then StartPascalCodeFoldBlock(cfbtLocalTypeBlock) then StartPascalCodeFoldBlock(cfbtLocalTypeBlock)
else StartPascalCodeFoldBlock(cfbtTypeBlock); else StartPascalCodeFoldBlock(cfbtTypeBlock);
FTokenState := tsNone; // clear tsAfterProcName for undetected anon procedure
FNextTokenState := tsAfterVarConstType; FNextTokenState := tsAfterVarConstType;
fRange := fRange - [rsInProcHeader];
end; end;
end; end;
Result := tkKey; Result := tkKey;
@ -2565,7 +2574,9 @@ begin
if (tfb in [cfbtNone, cfbtProgram, cfbtUnit, cfbtUnitSection]) then if (tfb in [cfbtNone, cfbtProgram, cfbtUnit, cfbtUnitSection]) then
StartPascalCodeFoldBlock(cfbtConstBlock); StartPascalCodeFoldBlock(cfbtConstBlock);
FTokenState := tsNone; // clear tsAfterProcName for undetected anon procedure
FNextTokenState := tsAfterVarConstType; FNextTokenState := tsAfterVarConstType;
fRange := fRange - [rsInProcHeader];
end; end;
Result := tkKey; Result := tkKey;
end end
@ -3135,6 +3146,8 @@ begin
if KeyComp('Function') then begin if KeyComp('Function') then begin
if (TopPascalCodeFoldBlockType in PascalStatementBlocks) and IsAnonymousFunc(8, True) then begin if (TopPascalCodeFoldBlockType in PascalStatementBlocks) and IsAnonymousFunc(8, True) then begin
StartPascalCodeFoldBlock(cfbtAnonymousProcedure); StartPascalCodeFoldBlock(cfbtAnonymousProcedure);
PasCodeFoldRange.BracketNestLevel := 0; // Reset in case of partial code
FNextTokenState := tsAfterAnonProc;
end end
else begin else begin
if not(rsAfterEqualOrColon in fRange) or if not(rsAfterEqualOrColon in fRange) or
@ -3192,6 +3205,8 @@ begin
if KeyComp('Procedure') then begin if KeyComp('Procedure') then begin
if (TopPascalCodeFoldBlockType in PascalStatementBlocks) and IsAnonymousFunc(9, False) then begin if (TopPascalCodeFoldBlockType in PascalStatementBlocks) and IsAnonymousFunc(9, False) then begin
StartPascalCodeFoldBlock(cfbtAnonymousProcedure); StartPascalCodeFoldBlock(cfbtAnonymousProcedure);
PasCodeFoldRange.BracketNestLevel := 0; // Reset in case of partial code
FNextTokenState := tsAfterAnonProc;
end end
else begin else begin
if not(rsAfterEqualOrColon in fRange) or if not(rsAfterEqualOrColon in fRange) or
@ -4370,6 +4385,9 @@ begin
else else
if tfb in PascalStatementBlocks then // goto label if tfb in PascalStatementBlocks then // goto label
FNextTokenState := tsAtBeginOfStatement; FNextTokenState := tsAtBeginOfStatement;
if FTokenState = tsAfterProcName then
FTokenState := tsNone; // clear tsAfterProcName for undetected anon function
end; end;
end; end;
end; end;
@ -4615,8 +4633,11 @@ begin
PasCodeFoldRange.BracketNestLevel := 0 PasCodeFoldRange.BracketNestLevel := 0
end end
else begin else begin
if (FTokenState = tsAfterProcName) and (rrsInParamDeclaration in FRequiredStates) and if (rrsInParamDeclaration in FRequiredStates) and
(PasCodeFoldRange.BracketNestLevel = 0) ( ( (FTokenState = tsAfterProcName) and (PasCodeFoldRange.BracketNestLevel = 0)
) or
( FTokenState = tsAfterAnonProc )
)
then then
fRange := fRange + [rsInParamDeclaration]; fRange := fRange + [rsInParamDeclaration];
@ -4668,9 +4689,12 @@ begin
end end
else begin else begin
if (rrsInParamDeclaration in FRequiredStates) and if (rrsInParamDeclaration in FRequiredStates) and
(PasCodeFoldRange.BracketNestLevel = 0) and ( ( (PasCodeFoldRange.BracketNestLevel = 0) and
( (FTokenState = tsAfterProcName) or ( (FTokenState = tsAfterProcName) or
(tfb in cfbtVarConstTypeExt) (tfb in cfbtVarConstTypeExt)
)
) or
( FTokenState = tsAfterAnonProc )
) )
then then
fRange := fRange + [rsInParamDeclaration]; fRange := fRange + [rsInParamDeclaration];

139
components/synedit/test/testhighlightpas.pas
View File

@ -84,6 +84,7 @@ type
procedure TestModifierAttributesForProcedure; procedure TestModifierAttributesForProcedure;
procedure TestModifierAttributesForProperty; procedure TestModifierAttributesForProperty;
procedure TestModifierAttributesForVarConstType; procedure TestModifierAttributesForVarConstType;
procedure TestModifierAttributesWithAnonProcedure;
procedure TestModifierAttributesForLabel; procedure TestModifierAttributesForLabel;
procedure TestCaretAsString; procedure TestCaretAsString;
procedure TestFoldNodeInfo; procedure TestFoldNodeInfo;
@ -3676,6 +3677,144 @@ begin
end; end;
end; end;
procedure TTestHighlighterPas.TestModifierAttributesWithAnonProcedure;
var
DeclVarName, DeclTypeName, DeclType, DeclVal, ProcName,
ProcParam, ProcType, ProcVal, ProcRes: TSynHighlighterAttributesModifier;
x: String;
begin
x := 'end; procedure test; begin'; // in case the anon function closed the named function
FKeepAllModifierAttribs := True;
ReCreateEdit;
EnableFolds([cfbtBeginEnd..cfbtNone]);
SetLines
(['program foo;{$mode objfpc}{$modeswitch anonymousfunctions}{$modeswitch functionreferences}',
'type t= reference to procedure;',
'var a: t; procedure test;',
'begin',
'a :=(', // 4
'procedure',
'var',
' n: word;', // 7
'begin',
' n := 1;',
'end',
');',
x+'',
'a :=', // 13
'procedure',
'var',
' n: word;', // 16
'begin',
' n := 1;',
'end;',
'',
x+ '',
'a :=(', // 22
'procedure(var t:byte; var t2:byte)',
'var',
' n: word;', // 25
'begin',
' n := 1;',
'end',
');',
'',
x+'',
'a :=', // 32
'procedure(var t:byte; var t2:byte)',
'var',
' n: word;', // 35
'begin',
' n := 1;',
'end;',
'',
'',
x+ '',
'a :=(', // 42
'procedure',
'(var t:byte; var t2:byte)',
'var',
' n: word;', // 46
'begin',
' n := 1;',
'end',
');',
x+'',
'a :=', // 52
'procedure',
'(var t:byte; var t2:byte)',
'var',
' n: word;', // 56
'begin',
' n := 1;',
'end;',
'',
x+ '',
'end.'
]);
// NOT extra attribs...
AssertEquals('Len procedure', 5, PasHighLighter.FoldLineLength(5,0));
AssertEquals('Len var', 1, PasHighLighter.FoldLineLength(6,0));
AssertEquals('Len begin', 2, PasHighLighter.FoldLineLength(8,0));
AssertEquals('Len procedure', 5, PasHighLighter.FoldLineLength(14,0));
AssertEquals('Len var', 1, PasHighLighter.FoldLineLength(15,0));
AssertEquals('Len begin', 2, PasHighLighter.FoldLineLength(17,0));
AssertEquals('Len procedure', 5, PasHighLighter.FoldLineLength(23,0));
AssertEquals('Len var', 1, PasHighLighter.FoldLineLength(24,0));
AssertEquals('Len begin', 2, PasHighLighter.FoldLineLength(26,0));
AssertEquals('Len procedure', 5, PasHighLighter.FoldLineLength(33,0));
AssertEquals('Len var', 1, PasHighLighter.FoldLineLength(34,0));
AssertEquals('Len begin', 2, PasHighLighter.FoldLineLength(36,0));
AssertEquals('Len procedure', 6, PasHighLighter.FoldLineLength(43,0));
AssertEquals('Len var', 1, PasHighLighter.FoldLineLength(45,0));
AssertEquals('Len begin', 2, PasHighLighter.FoldLineLength(47,0));
AssertEquals('Len procedure', 6, PasHighLighter.FoldLineLength(53,0));
AssertEquals('Len var', 1, PasHighLighter.FoldLineLength(55,0));
AssertEquals('Len begin', 2, PasHighLighter.FoldLineLength(57,0));
DeclVarName := PasHighLighter.DeclarationVarConstNameAttr;
DeclTypeName := PasHighLighter.DeclarationTypeNameAttr;
DeclType := PasHighLighter.DeclarationTypeAttr;
DeclVal := PasHighLighter.DeclarationValueAttr;
ProcName := PasHighLighter.ProcedureHeaderName;
ProcParam := PasHighLighter.ProcedureHeaderParamAttr;
ProcType := PasHighLighter.ProcedureHeaderTypeAttr;
ProcVal := PasHighLighter.ProcedureHeaderValueAttr;
ProcRes := PasHighLighter.ProcedureHeaderResultAttr;
CheckTokensForLine('procedure', 5, [tkKey ]);
CheckTokensForLine('var', 6, [tkKey ]);
CheckTokensForLine(' n: word;', 7,
[tkSpace, tkIdentifier+DeclVarName, TK_Colon, tkSpace, tkIdentifier+DeclType, TK_Semi ]);
CheckTokensForLine('procedure', 14, [tkKey ]);
CheckTokensForLine('var', 15, [tkKey ]);
CheckTokensForLine(' n: word;', 16,
[tkSpace, tkIdentifier+DeclVarName, TK_Colon, tkSpace, tkIdentifier+DeclType, TK_Semi ]);
CheckTokensForLine('procedure(var t:byte; var t2:byte)', 23,
[tkKey, TK_Bracket,
tkKey, tkSpace, tkIdentifier+ProcParam, TK_Colon, tkIdentifier+ProcType, TK_Semi, tkSpace,
tkKey, tkSpace, tkIdentifier+ProcParam, TK_Colon, tkIdentifier+ProcType, TK_Bracket
]);
CheckTokensForLine('var', 24, [tkKey ]);
CheckTokensForLine(' n: word;', 25,
[tkSpace, tkIdentifier+DeclVarName, TK_Colon, tkSpace, tkIdentifier+DeclType, TK_Semi ]);
CheckTokensForLine('procedure(var t:byte; var t2:byte)', 33,
[tkKey, TK_Bracket,
tkKey, tkSpace, tkIdentifier+ProcParam, TK_Colon, tkIdentifier+ProcType, TK_Semi, tkSpace,
tkKey, tkSpace, tkIdentifier+ProcParam, TK_Colon, tkIdentifier+ProcType, TK_Bracket
]);
CheckTokensForLine('var', 34, [tkKey ]);
CheckTokensForLine(' n: word;', 35,
[tkSpace, tkIdentifier+DeclVarName, TK_Colon, tkSpace, tkIdentifier+DeclType, TK_Semi ]);
end;
procedure TTestHighlighterPas.TestModifierAttributesForLabel; procedure TTestHighlighterPas.TestModifierAttributesForLabel;
var var
GotoLbl: TSynHighlighterAttributes; GotoLbl: TSynHighlighterAttributes;