mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-09 13:16:04 +02:00
SynEdit: PascalHighlighter, improve param/type attribs for anonymous procedures
This commit is contained in:
parent
be2125328e
commit
f32ec2f41b
@ -123,6 +123,7 @@ type
|
||||
// unit ____ // used for "deprecated" detection / check in tsAfterProcName
|
||||
// >>> after a procedure/function/... keyword, when the name is expected (not for types)
|
||||
// >>> renewed after dot "."
|
||||
tsAfterAnonProc, // [OPT] for rsInParamDeclaration
|
||||
tsAfterProcName, // procedure NAME
|
||||
// unit NAME // used for "deprecated" detection
|
||||
tsAfterIs, // maybe "is nested"
|
||||
@ -1881,6 +1882,8 @@ begin
|
||||
if TopPascalCodeFoldBlockType in [cfbtProcedure, cfbtAnonymousProcedure]
|
||||
then StartPascalCodeFoldBlock(cfbtLocalLabelBlock)
|
||||
else StartPascalCodeFoldBlock(cfbtLabelBlock);
|
||||
FTokenState := tsNone; // clear tsAfterProcName for undetected anon procedure
|
||||
fRange := fRange - [rsInProcHeader];
|
||||
end;
|
||||
Result := tkKey;
|
||||
end
|
||||
@ -1982,6 +1985,8 @@ begin
|
||||
// TODO: cfbtIfThen..cfbtWithDo => only if they are nested in one of the above
|
||||
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));
|
||||
end else
|
||||
if FExtendedKeywordsMode and KeyComp('Break') and
|
||||
@ -2071,7 +2076,9 @@ begin
|
||||
else
|
||||
if (tfb in [cfbtNone, cfbtProgram, cfbtUnit, cfbtUnitSection]) then
|
||||
StartPascalCodeFoldBlock(cfbtVarBlock);
|
||||
FTokenState := tsNone; // clear tsAfterProcName for anon undetected procedure
|
||||
FNextTokenState := tsAfterVarConstType;
|
||||
fRange := fRange - [rsInProcHeader];
|
||||
end;
|
||||
Result := tkKey;
|
||||
end
|
||||
@ -2476,7 +2483,9 @@ begin
|
||||
if tfb in [cfbtProcedure, cfbtAnonymousProcedure]
|
||||
then StartPascalCodeFoldBlock(cfbtLocalTypeBlock)
|
||||
else StartPascalCodeFoldBlock(cfbtTypeBlock);
|
||||
FTokenState := tsNone; // clear tsAfterProcName for undetected anon procedure
|
||||
FNextTokenState := tsAfterVarConstType;
|
||||
fRange := fRange - [rsInProcHeader];
|
||||
end;
|
||||
end;
|
||||
Result := tkKey;
|
||||
@ -2565,7 +2574,9 @@ begin
|
||||
if (tfb in [cfbtNone, cfbtProgram, cfbtUnit, cfbtUnitSection]) then
|
||||
StartPascalCodeFoldBlock(cfbtConstBlock);
|
||||
|
||||
FTokenState := tsNone; // clear tsAfterProcName for undetected anon procedure
|
||||
FNextTokenState := tsAfterVarConstType;
|
||||
fRange := fRange - [rsInProcHeader];
|
||||
end;
|
||||
Result := tkKey;
|
||||
end
|
||||
@ -3135,6 +3146,8 @@ begin
|
||||
if KeyComp('Function') then begin
|
||||
if (TopPascalCodeFoldBlockType in PascalStatementBlocks) and IsAnonymousFunc(8, True) then begin
|
||||
StartPascalCodeFoldBlock(cfbtAnonymousProcedure);
|
||||
PasCodeFoldRange.BracketNestLevel := 0; // Reset in case of partial code
|
||||
FNextTokenState := tsAfterAnonProc;
|
||||
end
|
||||
else begin
|
||||
if not(rsAfterEqualOrColon in fRange) or
|
||||
@ -3192,6 +3205,8 @@ begin
|
||||
if KeyComp('Procedure') then begin
|
||||
if (TopPascalCodeFoldBlockType in PascalStatementBlocks) and IsAnonymousFunc(9, False) then begin
|
||||
StartPascalCodeFoldBlock(cfbtAnonymousProcedure);
|
||||
PasCodeFoldRange.BracketNestLevel := 0; // Reset in case of partial code
|
||||
FNextTokenState := tsAfterAnonProc;
|
||||
end
|
||||
else begin
|
||||
if not(rsAfterEqualOrColon in fRange) or
|
||||
@ -4370,6 +4385,9 @@ begin
|
||||
else
|
||||
if tfb in PascalStatementBlocks then // goto label
|
||||
FNextTokenState := tsAtBeginOfStatement;
|
||||
|
||||
if FTokenState = tsAfterProcName then
|
||||
FTokenState := tsNone; // clear tsAfterProcName for undetected anon function
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -4615,8 +4633,11 @@ begin
|
||||
PasCodeFoldRange.BracketNestLevel := 0
|
||||
end
|
||||
else begin
|
||||
if (FTokenState = tsAfterProcName) and (rrsInParamDeclaration in FRequiredStates) and
|
||||
(PasCodeFoldRange.BracketNestLevel = 0)
|
||||
if (rrsInParamDeclaration in FRequiredStates) and
|
||||
( ( (FTokenState = tsAfterProcName) and (PasCodeFoldRange.BracketNestLevel = 0)
|
||||
) or
|
||||
( FTokenState = tsAfterAnonProc )
|
||||
)
|
||||
then
|
||||
fRange := fRange + [rsInParamDeclaration];
|
||||
|
||||
@ -4668,9 +4689,12 @@ begin
|
||||
end
|
||||
else begin
|
||||
if (rrsInParamDeclaration in FRequiredStates) and
|
||||
(PasCodeFoldRange.BracketNestLevel = 0) and
|
||||
( (FTokenState = tsAfterProcName) or
|
||||
(tfb in cfbtVarConstTypeExt)
|
||||
( ( (PasCodeFoldRange.BracketNestLevel = 0) and
|
||||
( (FTokenState = tsAfterProcName) or
|
||||
(tfb in cfbtVarConstTypeExt)
|
||||
)
|
||||
) or
|
||||
( FTokenState = tsAfterAnonProc )
|
||||
)
|
||||
then
|
||||
fRange := fRange + [rsInParamDeclaration];
|
||||
|
@ -84,6 +84,7 @@ type
|
||||
procedure TestModifierAttributesForProcedure;
|
||||
procedure TestModifierAttributesForProperty;
|
||||
procedure TestModifierAttributesForVarConstType;
|
||||
procedure TestModifierAttributesWithAnonProcedure;
|
||||
procedure TestModifierAttributesForLabel;
|
||||
procedure TestCaretAsString;
|
||||
procedure TestFoldNodeInfo;
|
||||
@ -3676,6 +3677,144 @@ begin
|
||||
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;
|
||||
var
|
||||
GotoLbl: TSynHighlighterAttributes;
|
||||
|
Loading…
Reference in New Issue
Block a user