SynEdit: PascalHighlighter, improve detecting hint modifiers

This commit is contained in:
Martin 2025-04-12 23:06:07 +02:00
parent e9538adea1
commit 439016e4f6
2 changed files with 59 additions and 30 deletions

View File

@ -2770,23 +2770,31 @@ begin
end; end;
function TSynPasSyn.Func85: TtkTokenKind; function TSynPasSyn.Func85: TtkTokenKind;
var
tfb: TPascalCodeFoldBlockType;
begin begin
tfb := TopPascalCodeFoldBlockType;
if (PasCodeFoldRange.BracketNestLevel = 0) and if (PasCodeFoldRange.BracketNestLevel = 0) and
(fRange * [rsInProcHeader, rsProperty, rsAfterEqualOrColon, rsWasInProcHeader] = [rsWasInProcHeader]) and (fRange * [rsInProcHeader, rsProperty, rsAfterEqualOrColon, rsWasInProcHeader] = [rsWasInProcHeader]) and
(TopPascalCodeFoldBlockType in ProcModifierAllowedNoVar-[cfbtClass, cfbtClassSection]) and (tfb in ProcModifierAllowedNoVar-[cfbtClass, cfbtClassSection]) and
KeyComp('Forward') KeyComp('Forward')
then begin then begin
Result := tkModifier; Result := tkModifier;
if TopPascalCodeFoldBlockType = cfbtProcedure then begin if tfb = cfbtProcedure then begin
EndPascalCodeFoldBlock(True); EndPascalCodeFoldBlock(True);
end; end;
end end
else else
if KeyComp('Library') then begin if KeyCompU('LIBRARY') then begin
fRange := fRange - [rsInterface] + [rsImplementation]; if IsHintModifier(tfb) then begin
if TopPascalCodeFoldBlockType=cfbtNone then Result := DoHintModifier;
StartPascalCodeFoldBlock(cfbtProgram); end
Result := tkKey else begin
fRange := fRange - [rsInterface] + [rsImplementation];
if tfb=cfbtNone then
StartPascalCodeFoldBlock(cfbtProgram);
Result := tkKey;
end;
end end
else else
Result := tkIdentifier; Result := tkIdentifier;
@ -3637,15 +3645,28 @@ begin
(PasCodeFoldRange.BracketNestLevel = 0) and (PasCodeFoldRange.BracketNestLevel = 0) and
( ( (tfb in cfbtVarConstType) and ( ( (tfb in cfbtVarConstType) and
(FTokenState <> tsAfterAbsolute) and (FTokenState <> tsAfterAbsolute) and
(fRange * [rsVarTypeInSpecification, rsAfterEqualOrColon] = [rsVarTypeInSpecification]) ) or ( (fRange * [rsVarTypeInSpecification, rsAfterEqualOrColon] = [rsVarTypeInSpecification]) or
( (tfb in [cfbtTypeBlock, cfbtLocalTypeBlock]) and
(rsWasInProcHeader in fRange) and
(FTokenState in [tsAtBeginOfStatement])
)
)
) or
( (tfb in [cfbtClass, cfbtClassSection, cfbtRecord, cfbtRecordCase, cfbtRecordCaseSection, cfbtClassConstBlock, cfbtClassTypeBlock]) and ( (tfb in [cfbtClass, cfbtClassSection, cfbtRecord, cfbtRecordCase, cfbtRecordCaseSection, cfbtClassConstBlock, cfbtClassTypeBlock]) and
( (fRange * [rsAfterClassMembers, rsInProcHeader] = [rsAfterClassMembers]) or ( (fRange * [rsAfterClassMembers, rsInProcHeader] = [rsAfterClassMembers]) or
(fRange * [rsAfterClassMembers, rsAfterEqualOrColon, rsVarTypeInSpecification] = [rsVarTypeInSpecification]) (fRange * [rsAfterClassMembers, rsAfterEqualOrColon, rsVarTypeInSpecification] = [rsVarTypeInSpecification]) or
) ) or ( (tfb = cfbtClassTypeBlock) and
(rsWasInProcHeader in fRange) and
(FTokenState in [tsAtBeginOfStatement])
)
)
) or
( (tfb in [cfbtUnitSection, cfbtProgram, cfbtProcedure]) and ( (tfb in [cfbtUnitSection, cfbtProgram, cfbtProcedure]) and
(fRange * [rsInProcHeader] = []) ) or (fRange * [rsInProcHeader] = [])
) or
( (tfb in [cfbtUnit, cfbtNone]) and ( (tfb in [cfbtUnit, cfbtNone]) and
(fRange * [rsInProcHeader] = []) and (FTokenState = tsAfterProcName) ) (fRange * [rsInProcHeader] = []) and (FTokenState = tsAfterProcName)
)
) )
then then
Result := True Result := True

View File

@ -1985,15 +1985,17 @@ procedure TTestHighlighterPas.TestContextForDeprecated;
s+'= array [1..2] of '+s+' '+s+';', // nameDEPRECATED=array of typeDEPRECATED deprecated; s+'= array [1..2] of '+s+' '+s+';', // nameDEPRECATED=array of typeDEPRECATED deprecated;
s+'= set of '+s+' '+s+';', // nameDEPRECATED=set of typeDEPRECATED deprecated; s+'= set of '+s+' '+s+';', // nameDEPRECATED=set of typeDEPRECATED deprecated;
s+'= class of '+s+' '+s+';', // nameDEPRECATED=class of typeDEPRECATED deprecated; s+'= class of '+s+' '+s+';', // nameDEPRECATED=class of typeDEPRECATED deprecated;
s+'= procedure '+s+';', s+'= procedure '+s+';', // 8
s+'= procedure of object '+s+';', 'f= procedure; '+s+';', // 9
s+'= procedure(a:'+s+') '+s+';', 'f= procedure '+s+';'+s+';', // 10
s+'= procedure(a:'+s+') of object '+s+';', 'f= procedure of object '+s+';',
s+'= function:'+s+' '+s+';', 'f= procedure(a:'+s+') '+s+';',
s+'= function:'+s+' of object '+s+';', 'f= procedure(a:'+s+') of object '+s+';',
s+'= function(a:'+s+'):'+s+' '+s+';', 'f= function:'+s+' '+s+';',
s+'= function(a:'+s+'):'+s+' of object '+s+';', 'f= function:'+s+' of object '+s+';',
s+'= record end '+s+';', // nameDEPRECATED=packed record deprecated; 'f= function(a:'+s+'):'+s+' '+s+';',
'f= function(a:'+s+'):'+s+' of object '+s+';',
'f= record end '+s+';', // nameDEPRECATED=packed record deprecated;
s+'= packed record end '+s+';', // nameDEPRECATED=packed record deprecated; s+'= packed record end '+s+';', // nameDEPRECATED=packed record deprecated;
'end', 'end',
'' ''
@ -2010,35 +2012,41 @@ procedure TTestHighlighterPas.TestContextForDeprecated;
[tkIdentifier, tkSymbol, tkSpace, tkKey, tkSpace, tkKey {"of"}, tkSpace, tkIdentifier, tkSpace, tkModifier {the one and only}, tkSymbol]); [tkIdentifier, tkSymbol, tkSpace, tkKey, tkSpace, tkKey {"of"}, tkSpace, tkIdentifier, tkSpace, tkModifier {the one and only}, tkSymbol]);
CheckTokensForLine('class of', 7, CheckTokensForLine('class of', 7,
[tkIdentifier, tkSymbol, tkSpace, tkKey, tkSpace, tkKey {"of"}, tkSpace, tkIdentifier, tkSpace, tkModifier {the one and only}, tkSymbol]); [tkIdentifier, tkSymbol, tkSpace, tkKey, tkSpace, tkKey {"of"}, tkSpace, tkIdentifier, tkSpace, tkModifier {the one and only}, tkSymbol]);
CheckTokensForLine('procedure ', 8, CheckTokensForLine('procedure ', 8,
[tkIdentifier, tkSymbol, tkSpace, tkKey, tkSpace, tkModifier {the one and only}, tkSymbol]); [tkIdentifier, tkSymbol, tkSpace, tkKey, tkSpace, tkModifier {the one and only}, tkSymbol]);
CheckTokensForLine('procedure of object ', 9, CheckTokensForLine('procedure ', 9,
[tkIdentifier, tkSymbol, tkSpace, tkKey, TK_Semi, tkSpace, tkModifier {the one and only}, tkSymbol]);
CheckTokensForLine('procedure ', 10,
[tkIdentifier, tkSymbol, tkSpace, tkKey, tkSpace, tkModifier, TK_Semi, tkModifier, tkSymbol]);
CheckTokensForLine('procedure of object ', 11,
[tkIdentifier, tkSymbol, tkSpace, tkKey, tkSpace, tkKey {"of"}, tkSpace, tkKey, tkSpace, tkModifier {the one and only}, tkSymbol]); [tkIdentifier, tkSymbol, tkSpace, tkKey, tkSpace, tkKey {"of"}, tkSpace, tkKey, tkSpace, tkModifier {the one and only}, tkSymbol]);
CheckTokensForLine('procedure(a:s) ', 10, CheckTokensForLine('procedure(a:s) ', 12,
[tkIdentifier, tkSymbol, tkSpace, tkKey, [tkIdentifier, tkSymbol, tkSpace, tkKey,
TK_Bracket, tkIdentifier, TK_Colon, tkIdentifier, TK_Bracket, TK_Bracket, tkIdentifier, TK_Colon, tkIdentifier, TK_Bracket,
tkSpace, tkModifier {the one and only}, tkSymbol]); tkSpace, tkModifier {the one and only}, tkSymbol]);
CheckTokensForLine('procedure(a:s) of object ', 11, CheckTokensForLine('procedure(a:s) of object ', 13,
[tkIdentifier, tkSymbol, tkSpace, tkKey, [tkIdentifier, tkSymbol, tkSpace, tkKey,
TK_Bracket, tkIdentifier, TK_Colon, tkIdentifier, TK_Bracket, TK_Bracket, tkIdentifier, TK_Colon, tkIdentifier, TK_Bracket,
tkSpace, tkKey {"of"}, tkSpace, tkKey, tkSpace, tkModifier {the one and only}, tkSymbol]); tkSpace, tkKey {"of"}, tkSpace, tkKey, tkSpace, tkModifier {the one and only}, tkSymbol]);
CheckTokensForLine('function', 12, CheckTokensForLine('function', 14,
[tkIdentifier, tkSymbol, tkSpace, tkKey, TK_Colon, tkIdentifier, tkSpace, tkModifier {the one and only}, tkSymbol]); [tkIdentifier, tkSymbol, tkSpace, tkKey, TK_Colon, tkIdentifier, tkSpace, tkModifier {the one and only}, tkSymbol]);
CheckTokensForLine('function of object ', 13, CheckTokensForLine('function of object ', 15,
[tkIdentifier, tkSymbol, tkSpace, tkKey, TK_Colon, tkIdentifier, tkSpace, tkKey {"of"}, tkSpace, tkKey, tkSpace, tkModifier {the one and only}, tkSymbol]); [tkIdentifier, tkSymbol, tkSpace, tkKey, TK_Colon, tkIdentifier, tkSpace, tkKey {"of"}, tkSpace, tkKey, tkSpace, tkModifier {the one and only}, tkSymbol]);
CheckTokensForLine('function(a:s)', 14, CheckTokensForLine('function(a:s)', 16,
[tkIdentifier, tkSymbol, tkSpace, tkKey, [tkIdentifier, tkSymbol, tkSpace, tkKey,
TK_Bracket, tkIdentifier, TK_Colon, tkIdentifier, TK_Bracket, TK_Bracket, tkIdentifier, TK_Colon, tkIdentifier, TK_Bracket,
TK_Colon, tkIdentifier, TK_Colon, tkIdentifier,
tkSpace, tkModifier {the one and only}, tkSymbol]); tkSpace, tkModifier {the one and only}, tkSymbol]);
CheckTokensForLine('function(a:s) of object ', 15, CheckTokensForLine('function(a:s) of object ', 17,
[tkIdentifier, tkSymbol, tkSpace, tkKey, [tkIdentifier, tkSymbol, tkSpace, tkKey,
TK_Bracket, tkIdentifier, TK_Colon, tkIdentifier, TK_Bracket, TK_Bracket, tkIdentifier, TK_Colon, tkIdentifier, TK_Bracket,
TK_Colon, tkIdentifier, TK_Colon, tkIdentifier,
tkSpace, tkKey {"of"}, tkSpace, tkKey, tkSpace, tkModifier {the one and only}, tkSymbol]); tkSpace, tkKey {"of"}, tkSpace, tkKey, tkSpace, tkModifier {the one and only}, tkSymbol]);
CheckTokensForLine('record end', 16, CheckTokensForLine('record end', 18,
[tkIdentifier, tkSymbol, tkSpace, tkKey, tkSpace, tkKey {"end"}, tkSpace, tkModifier {the one and only}, tkSymbol]); [tkIdentifier, tkSymbol, tkSpace, tkKey, tkSpace, tkKey {"end"}, tkSpace, tkModifier {the one and only}, tkSymbol]);
CheckTokensForLine('packed record end', 17, CheckTokensForLine('packed record end', 19,
[tkIdentifier, tkSymbol, tkSpace, tkKey, tkSpace, tkKey, tkSpace, tkKey {"end"}, tkSpace, tkModifier {the one and only}, tkSymbol]); [tkIdentifier, tkSymbol, tkSpace, tkKey, tkSpace, tkKey, tkSpace, tkKey {"end"}, tkSpace, tkModifier {the one and only}, tkSymbol]);
if (struct = 'record') or (struct = 'byte;') then if (struct = 'record') or (struct = 'byte;') then