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

SynEdit: PascalHighlighter, added "cvar", fixed "public","external" for variables.

Browse Source 
- Moved some enum from range-state to token-state. (avoid changing the storage for ranges / limited to 32 entries)
This commit is contained in:
Martin 2024-01-24 22:17:51 +01:00
parent b3ee25c175
commit 0ce675d692
2 changed files with 444 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

177
components/synedit/synhighlighterpas.pp
View File

@ -98,9 +98,6 @@ type
rsAfterIdentifierOrValueAdd, rsAfterIdentifierOrValueAdd,
rsAtCaseLabel, rsAtCaseLabel,
rsAtProcName, // after a procedure/function/... keyword, when the name is expected (not for types)
// also after "unit unitname" to detect "deprecated"
rsAfterProcName,
rsInProcHeader, // Declaration or implementation header of a Procedure, function, constructor... rsInProcHeader, // Declaration or implementation header of a Procedure, function, constructor...
rsWasInProcHeader, // after the semicolon that ended a "ProcHeader / proc-modifiers are possible rsWasInProcHeader, // after the semicolon that ended a "ProcHeader / proc-modifiers are possible
rsAfterClassMembers, // Encountered a procedure, function, property, constructor or destructor in a class rsAfterClassMembers, // Encountered a procedure, function, property, constructor or destructor in a class
@ -108,7 +105,8 @@ type
rsVarTypeInSpecification, // between ":"/"=" and ";" in a var or type section (or class members) rsVarTypeInSpecification, // between ":"/"=" and ";" in a var or type section (or class members)
// var a: Integer; type b = Int64; // var a: Integer; type b = Int64;
rsInTypeBlock, rsInTypeBlock,
rsAfterEqualThenType, // TFoo = type ... rsInConstBlock,
rsInTypedConst,
rsSkipAllPasBlocks // used for: class of ... ; rsSkipAllPasBlocks // used for: class of ... ;
); );
TRangeStates = set of TRangeState; TRangeStates = set of TRangeState;
@ -117,11 +115,26 @@ type
// Except, will be kept for: tkSpace, tkComment, tkIDEDirective, tkDirective, tkNull // maybe in future line break // Except, will be kept for: tkSpace, tkComment, tkIDEDirective, tkDirective, tkNull // maybe in future line break
TTokenState = ( TTokenState = (
tsNone, tsNone,
tsAfterExternal, // after public or external: "name" may follow tsAtProcName, // procedure ___
// procedure Foo; public name 'bar'; // unit ____ // used for "deprecated" detection / check in tsAfterProcName
// procedure Foo; external 'x' name 'bar'; // >>> after a procedure/function/... keyword, when the name is expected (not for types)
// var Foo; public name 'bar'; // >>> renewed after dot "."
tsAfterAbsolute //var x absolute y; tsAfterProcName, // procedure NAME
// unit NAME // used for "deprecated" detection
tsAfterEqualThenType, // TFoo = type
// >>> ONLY if type-helper enabled
tsAfterAbsolute, // var x absolute y;
tsAfterExternal, // procedure Foo; public name 'bar';
// procedure Foo; external 'x' name 'bar';
// var Foo; public name 'bar';
// after public, export or external: "name" may follow
// >>> KEPT until ONE AFTER the ";" => to prevent next token from being mistaken
// >>> Also SET BY "var"/"type"/"const" => to prevent next token from being mistaken
tsAfterCvar, // cvar;
// >>> KEPT until ONE AFTER the ";" => to prevent next token from being mistaken
tsAfterTypedConst // const foo: ___=___; public;
// >>> typed const can have modifiers
// Set AFTER ";"
); );
type type
@ -1194,8 +1207,9 @@ begin
tfb := TopPascalCodeFoldBlockType; tfb := TopPascalCodeFoldBlockType;
until not (tfb in [cfbtRecordCase, cfbtRecordCaseSection]); until not (tfb in [cfbtRecordCase, cfbtRecordCaseSection]);
fRange := fRange - [rsAtCaseLabel]; fRange := fRange - [rsAtCaseLabel];
if TopPascalCodeFoldBlockType = cfbtRecord then if TopPascalCodeFoldBlockType = cfbtRecord then begin
EndPascalCodeFoldBlock; EndPascalCodeFoldBlock;
end;
// After type declaration, allow "deprecated"? // After type declaration, allow "deprecated"?
if TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType, if TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType,
cfbtClass, cfbtClassSection, cfbtRecord, cfbtRecordCase, cfbtRecordCaseSection] cfbtClass, cfbtClassSection, cfbtRecord, cfbtRecordCase, cfbtRecordCaseSection]
@ -1210,6 +1224,9 @@ begin
cfbtClass, cfbtClassSection, cfbtRecord, cfbtRecordCase, cfbtRecordCaseSection] cfbtClass, cfbtClassSection, cfbtRecord, cfbtRecordCase, cfbtRecordCaseSection]
then then
fRange := fRange + [rsVarTypeInSpecification]; fRange := fRange + [rsVarTypeInSpecification];
if TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType, cfbtClass, cfbtClassSection, cfbtRecord]
then
fRange := fRange + [rsInTypeBlock];
end else if tfb = cfbtUnit then begin end else if tfb = cfbtUnit then begin
EndPascalCodeFoldBlock; EndPascalCodeFoldBlock;
end else if tfb = cfbtPackage then begin end else if tfb = cfbtPackage then begin
@ -1271,6 +1288,9 @@ begin
cfbtClass, cfbtClassSection, cfbtRecord, cfbtRecordCase, cfbtRecordCaseSection] cfbtClass, cfbtClassSection, cfbtRecord, cfbtRecordCase, cfbtRecordCaseSection]
then then
fRange := fRange + [rsVarTypeInSpecification]; fRange := fRange + [rsVarTypeInSpecification];
if TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType, cfbtClass, cfbtClassSection, cfbtRecord]
then
fRange := fRange + [rsInTypeBlock];
end; end;
end else begin end else begin
Result := tkKey; // @@end or @end label Result := tkKey; // @@end or @end label
@ -1398,13 +1418,13 @@ begin
end end
else else
if (FTokenState = tsAfterExternal) and if (FTokenState = tsAfterExternal) and
// (PasCodeFoldRange.BracketNestLevel = 0) and (PasCodeFoldRange.BracketNestLevel = 0) and
// (fRange * [rsInProcHeader, rsProperty, rsAfterEqualOrColon, rsWasInProcHeader] = [rsWasInProcHeader]) and (fRange * [rsAfterSemiColon, rsAfterEqualOrColon, rsAfterEqual] = []) and
// (TopPascalCodeFoldBlockType in ProcModifierAllowed) and
KeyComp('name') // procedure foo; public name 'abc'; KeyComp('name') // procedure foo; public name 'abc';
then then
begin begin
Result := tkKey; Result := tkKey;
FNextTokenState := tsAfterExternal; // external 'foo' name 'bar'
end end
else else
Result := tkIdentifier; Result := tkIdentifier;
@ -1538,6 +1558,7 @@ begin
end; end;
fRange := fRange + [rsAfterSemiColon]; fRange := fRange + [rsAfterSemiColon];
FOldRange := FOldRange - [rsAfterSemiColon]; FOldRange := FOldRange - [rsAfterSemiColon];
FNextTokenState := tsAfterExternal; // prevent a variable of name public/export/external to be highlighted
end; end;
Result := tkKey; Result := tkKey;
end end
@ -1573,6 +1594,19 @@ begin
Result := tkKey; Result := tkKey;
StartPascalCodeFoldBlock(cfbtPackage); StartPascalCodeFoldBlock(cfbtPackage);
end end
else
if (PasCodeFoldRange.BracketNestLevel = 0) and
( (FTokenState = tsAfterTypedConst) or
( not(FTokenState in [tsAfterExternal, tsAfterCvar]) and
(fRange * [rsAfterSemiColon, rsInProcHeader, rsWasInProcHeader, rsInTypeBlock, rsInConstBlock] = [rsAfterSemiColon])
) )
and
KeyComp('CVAR') and
(TopPascalCodeFoldBlockType() in [cfbtVarType, cfbtLocalVarType])
then begin
Result := tkKey;
FNextTokenState := tsAfterCvar;
end
else else
Result := tkIdentifier; Result := tkIdentifier;
end; end;
@ -1757,8 +1791,10 @@ begin
fRange := fRange + [rsAtPropertyOrReadWrite] - [rsVarTypeInSpecification]; fRange := fRange + [rsAtPropertyOrReadWrite] - [rsVarTypeInSpecification];
end end
else else
if KeyComp('Generic') then if KeyComp('Generic') then begin
Result := tkKey Result := tkKey;
fRange := fRange + [rsInTypeBlock]; // in case it was incorrectly removed
end
else else
Result := tkIdentifier; Result := tkIdentifier;
end; end;
@ -1783,8 +1819,16 @@ begin
else else
// outside class: procedure foo; public name 'abc'; // outside class: procedure foo; public name 'abc';
if (PasCodeFoldRange.BracketNestLevel = 0) and if (PasCodeFoldRange.BracketNestLevel = 0) and
(fRange * [rsInProcHeader, rsProperty, rsAfterEqualOrColon, rsWasInProcHeader] = [rsWasInProcHeader]) and ( (FTokenState in [tsAfterTypedConst, tsAfterCvar])
(tbf in ProcModifierAllowed - [cfbtClass, cfbtClassSection, cfbtRecord]) or
( (FTokenState <> tsAfterExternal) and
( ( (fRange * [rsInProcHeader, rsProperty, rsAfterEqualOrColon, rsWasInProcHeader] = [rsWasInProcHeader]) and
(tbf in ProcModifierAllowed - [cfbtClass, cfbtClassSection, cfbtRecord])
) or
( (fRange * [rsAfterSemiColon, rsInProcHeader, rsWasInProcHeader, rsInTypeBlock, rsInConstBlock] = [rsAfterSemiColon]) and
(tbf in [cfbtVarType, cfbtLocalVarType])
) ) )
)
then begin then begin
Result := tkKey; Result := tkKey;
FNextTokenState := tsAfterExternal; FNextTokenState := tsAfterExternal;
@ -1824,7 +1868,7 @@ begin
if KeyComp('Unit') then begin if KeyComp('Unit') then begin
if TopPascalCodeFoldBlockType=cfbtNone then StartPascalCodeFoldBlock(cfbtUnit); if TopPascalCodeFoldBlockType=cfbtNone then StartPascalCodeFoldBlock(cfbtUnit);
Result := tkKey; Result := tkKey;
fRange := fRange + [rsAtProcName]; FNextTokenState := tsAtProcName;
end end
else if KeyComp('Uses') then begin else if KeyComp('Uses') then begin
if (TopPascalCodeFoldBlockType in if (TopPascalCodeFoldBlockType in
@ -1841,7 +1885,7 @@ begin
fRange := fRange - [rsVarTypeInSpecification, rsAfterEqual] + [rsInTypeHelper]; fRange := fRange - [rsVarTypeInSpecification, rsAfterEqual] + [rsInTypeHelper];
end end
else else
if (rsAfterEqualThenType in fRange) and TypeHelpers then begin if (FTokenState = tsAfterEqualThenType) and TypeHelpers then begin
Result := tkKey; Result := tkKey;
fRange := fRange - [rsVarTypeInSpecification, rsAfterEqual] + [rsInTypeHelper]; fRange := fRange - [rsVarTypeInSpecification, rsAfterEqual] + [rsInTypeHelper];
StartPascalCodeFoldBlock(cfbtClass); // type helper StartPascalCodeFoldBlock(cfbtClass); // type helper
@ -1877,7 +1921,7 @@ begin
if (rsAfterEqualOrColon in fRange) then begin if (rsAfterEqualOrColon in fRange) then begin
FOldRange := FOldRange - [rsAfterEqualOrColon]; FOldRange := FOldRange - [rsAfterEqualOrColon];
if TypeHelpers then if TypeHelpers then
fRange := fRange + [rsAfterEqualThenType]; FNextTokenState := tsAfterEqualThenType;
end end
else begin else begin
if tfb in [cfbtVarType, cfbtLocalVarType] then begin if tfb in [cfbtVarType, cfbtLocalVarType] then begin
@ -1890,6 +1934,7 @@ begin
else StartPascalCodeFoldBlock(cfbtVarType); else StartPascalCodeFoldBlock(cfbtVarType);
fRange := fRange + [rsInTypeBlock, rsAfterSemiColon]; fRange := fRange + [rsInTypeBlock, rsAfterSemiColon];
FOldRange := FOldRange - [rsAfterSemiColon]; FOldRange := FOldRange - [rsAfterSemiColon];
FNextTokenState := tsAfterExternal; // prevent a type of name public/export/external to be highlighted
end; end;
end; end;
Result := tkKey; Result := tkKey;
@ -1956,8 +2001,9 @@ begin
then StartPascalCodeFoldBlock(cfbtLocalVarType) then StartPascalCodeFoldBlock(cfbtLocalVarType)
else StartPascalCodeFoldBlock(cfbtVarType); else StartPascalCodeFoldBlock(cfbtVarType);
end; end;
fRange := fRange + [rsAfterSemiColon]; fRange := fRange + [rsAfterSemiColon, rsInConstBlock];
FOldRange := FOldRange - [rsAfterSemiColon]; FOldRange := FOldRange - [rsAfterSemiColon];
FNextTokenState := tsAfterExternal; // prevent a variable of name public/export/external to be highlighted
end; end;
Result := tkKey; Result := tkKey;
end end
@ -2066,6 +2112,7 @@ begin
else if KeyComp('Deprecated') then begin else if KeyComp('Deprecated') then begin
tbf := TopPascalCodeFoldBlockType; tbf := TopPascalCodeFoldBlockType;
if ( ( (tbf in [cfbtVarType, cfbtLocalVarType]) and if ( ( (tbf in [cfbtVarType, cfbtLocalVarType]) and
(FTokenState <> tsAfterAbsolute) and
(fRange * [rsVarTypeInSpecification, rsAfterEqualOrColon] = [rsVarTypeInSpecification]) ) or (fRange * [rsVarTypeInSpecification, rsAfterEqualOrColon] = [rsVarTypeInSpecification]) ) or
( (tbf in [cfbtClass, cfbtClassSection, cfbtRecord, cfbtRecordCase, cfbtRecordCaseSection]) and ( (tbf in [cfbtClass, cfbtClassSection, cfbtRecord, cfbtRecordCase, cfbtRecordCaseSection]) and
( (fRange * [rsAfterClassMembers, rsInProcHeader] = [rsAfterClassMembers]) or ( (fRange * [rsAfterClassMembers, rsInProcHeader] = [rsAfterClassMembers]) or
@ -2074,7 +2121,7 @@ begin
( (tbf in [cfbtUnitSection, cfbtProgram, cfbtProcedure]) and ( (tbf in [cfbtUnitSection, cfbtProgram, cfbtProcedure]) and
(fRange * [rsInProcHeader] = []) ) or (fRange * [rsInProcHeader] = []) ) or
( (tbf in [cfbtUnit, cfbtNone]) and ( (tbf in [cfbtUnit, cfbtNone]) and
(fRange * [rsInProcHeader, rsAfterProcName] = [rsAfterProcName]) ) (fRange * [rsInProcHeader] = []) and (FTokenState = tsAfterProcName) )
) and ) and
( fRange *[rsAfterEqualOrColon, rsProperty] = [] ) and ( fRange *[rsAfterEqualOrColon, rsProperty] = [] ) and
(PasCodeFoldRange.BracketNestLevel = 0) (PasCodeFoldRange.BracketNestLevel = 0)
@ -2342,13 +2389,23 @@ begin
end; end;
function TSynPasSyn.Func98: TtkTokenKind; function TSynPasSyn.Func98: TtkTokenKind;
var
tbf: TPascalCodeFoldBlockType;
begin begin
tbf := TopPascalCodeFoldBlockType;
if (PasCodeFoldRange.BracketNestLevel in [0, 1]) and if (PasCodeFoldRange.BracketNestLevel in [0, 1]) and
(fRange * [rsInProcHeader, rsProperty, rsAfterEqualOrColon, rsWasInProcHeader] = [rsWasInProcHeader]) and (FTokenState <> tsAfterExternal) and
(TopPascalCodeFoldBlockType in ProcModifierAllowed) and ( ( (fRange * [rsInProcHeader, rsProperty, rsAfterEqualOrColon, rsWasInProcHeader] = [rsWasInProcHeader]) and
(tbf in ProcModifierAllowed)
) or
( (fRange * [rsAfterSemiColon, rsInProcHeader, rsWasInProcHeader, rsInTypeBlock, rsInConstBlock] = [rsAfterSemiColon]) and
(tbf in [cfbtVarType, cfbtLocalVarType])
)
) and
KeyComp('Export') KeyComp('Export')
then begin then begin
Result := tkKey; Result := tkKey;
FNextTokenState := tsAfterExternal;
end end
else else
if KeyComp('Nodefault') then if KeyComp('Nodefault') then
@ -2363,8 +2420,13 @@ var
begin begin
tbf := TopPascalCodeFoldBlockType; tbf := TopPascalCodeFoldBlockType;
if (PasCodeFoldRange.BracketNestLevel = 0) and if (PasCodeFoldRange.BracketNestLevel = 0) and
( (fRange * [rsInProcHeader, rsProperty, rsAfterEqualOrColon, rsWasInProcHeader] = [rsWasInProcHeader]) and (FTokenState <> tsAfterExternal) and
(tbf in ProcModifierAllowed) ( ( (fRange * [rsInProcHeader, rsProperty, rsAfterEqualOrColon, rsWasInProcHeader] = [rsWasInProcHeader]) and
(tbf in ProcModifierAllowed)
) or
( (fRange * [rsAfterSemiColon, rsInProcHeader, rsWasInProcHeader, rsInTypeBlock, rsInConstBlock] = [rsAfterSemiColon]) and
(tbf in [cfbtVarType, cfbtLocalVarType])
)
) and ) and
KeyComp('External') KeyComp('External')
then begin then begin
@ -2406,6 +2468,7 @@ begin
if KeyComp('Platform') then begin if KeyComp('Platform') then begin
tbf := TopPascalCodeFoldBlockType; tbf := TopPascalCodeFoldBlockType;
if ( ( (tbf in [cfbtVarType, cfbtLocalVarType]) and if ( ( (tbf in [cfbtVarType, cfbtLocalVarType]) and
(FTokenState <> tsAfterAbsolute) and
(fRange * [rsVarTypeInSpecification, rsAfterEqualOrColon] = [rsVarTypeInSpecification]) ) or (fRange * [rsVarTypeInSpecification, rsAfterEqualOrColon] = [rsVarTypeInSpecification]) ) or
( (tbf in [cfbtClass, cfbtClassSection, cfbtRecord, cfbtRecordCase, cfbtRecordCaseSection]) and ( (tbf in [cfbtClass, cfbtClassSection, cfbtRecord, cfbtRecordCase, cfbtRecordCaseSection]) and
( (fRange * [rsAfterClassMembers, rsInProcHeader] = [rsAfterClassMembers]) or ( (fRange * [rsAfterClassMembers, rsInProcHeader] = [rsAfterClassMembers]) or
@ -2414,7 +2477,7 @@ begin
( (tbf in [cfbtUnitSection, cfbtProgram, cfbtProcedure]) and ( (tbf in [cfbtUnitSection, cfbtProgram, cfbtProcedure]) and
(fRange * [rsInProcHeader] = []) ) or (fRange * [rsInProcHeader] = []) ) or
( (tbf in [cfbtUnit, cfbtNone]) and ( (tbf in [cfbtUnit, cfbtNone]) and
(fRange * [rsInProcHeader, rsAfterProcName] = [rsAfterProcName]) ) (fRange * [rsInProcHeader] = []) and (FTokenState = tsAfterProcName) )
) and ) and
( fRange *[rsAfterEqualOrColon, rsProperty] = [] ) and ( fRange *[rsAfterEqualOrColon, rsProperty] = [] ) and
(PasCodeFoldRange.BracketNestLevel = 0) (PasCodeFoldRange.BracketNestLevel = 0)
@ -2451,7 +2514,7 @@ begin
if InClass then if InClass then
fRange := fRange + [rsAfterClassMembers]; fRange := fRange + [rsAfterClassMembers];
fRange := fRange + [rsAtProcName]; FNextTokenState := tsAtProcName;
end; end;
end; end;
fRange := fRange + [rsInProcHeader]; fRange := fRange + [rsInProcHeader];
@ -2505,7 +2568,7 @@ begin
if InClass then if InClass then
fRange := fRange + [rsAfterClassMembers]; fRange := fRange + [rsAfterClassMembers];
fRange := fRange + [rsAtProcName]; FNextTokenState := tsAtProcName;
end; end;
end; end;
fRange := fRange + [rsInProcHeader]; fRange := fRange + [rsInProcHeader];
@ -2558,7 +2621,7 @@ begin
if InClass then if InClass then
fRange := fRange + [rsAfterClassMembers]; fRange := fRange + [rsAfterClassMembers];
//fRange := fRange + [rsAtProcName]; //FNextTokenState := tsAtProcName;
end; end;
fRange := fRange + [rsInProcHeader]; fRange := fRange + [rsInProcHeader];
Result := tkKey; Result := tkKey;
@ -2762,6 +2825,7 @@ begin
if KeyComp('Experimental') then begin if KeyComp('Experimental') then begin
tbf := TopPascalCodeFoldBlockType; tbf := TopPascalCodeFoldBlockType;
if ( ( (tbf in [cfbtVarType, cfbtLocalVarType]) and if ( ( (tbf in [cfbtVarType, cfbtLocalVarType]) and
(FTokenState <> tsAfterAbsolute) and
(fRange * [rsVarTypeInSpecification, rsAfterEqualOrColon] = [rsVarTypeInSpecification]) ) or (fRange * [rsVarTypeInSpecification, rsAfterEqualOrColon] = [rsVarTypeInSpecification]) ) or
( (tbf in [cfbtClass, cfbtClassSection, cfbtRecord, cfbtRecordCase, cfbtRecordCaseSection]) and ( (tbf in [cfbtClass, cfbtClassSection, cfbtRecord, cfbtRecordCase, cfbtRecordCaseSection]) and
( (fRange * [rsAfterClassMembers, rsInProcHeader] = [rsAfterClassMembers]) or ( (fRange * [rsAfterClassMembers, rsInProcHeader] = [rsAfterClassMembers]) or
@ -2770,7 +2834,7 @@ begin
( (tbf in [cfbtUnitSection, cfbtProgram, cfbtProcedure]) and ( (tbf in [cfbtUnitSection, cfbtProgram, cfbtProcedure]) and
(fRange * [rsInProcHeader] = []) ) or (fRange * [rsInProcHeader] = []) ) or
( (tbf in [cfbtUnit, cfbtNone]) and ( (tbf in [cfbtUnit, cfbtNone]) and
(fRange * [rsInProcHeader, rsAfterProcName] = [rsAfterProcName]) ) (fRange * [rsInProcHeader] = []) and (FTokenState = tsAfterProcName) )
) and ) and
( fRange *[rsAfterEqualOrColon, rsProperty] = [] ) and ( fRange *[rsAfterEqualOrColon, rsProperty] = [] ) and
(PasCodeFoldRange.BracketNestLevel = 0) (PasCodeFoldRange.BracketNestLevel = 0)
@ -2803,7 +2867,8 @@ begin
if InClass then if InClass then
fRange := fRange + [rsAfterClassMembers]; fRange := fRange + [rsAfterClassMembers];
fRange := fRange + [rsInProcHeader, rsAtProcName]; fRange := fRange + [rsInProcHeader];
FNextTokenState := tsAtProcName;
end; end;
Result := tkKey; Result := tkKey;
end else end else
@ -2842,6 +2907,7 @@ begin
tbf := TopPascalCodeFoldBlockType; tbf := TopPascalCodeFoldBlockType;
if KeyComp('Unimplemented') then begin if KeyComp('Unimplemented') then begin
if ( ( (tbf in [cfbtVarType, cfbtLocalVarType]) and if ( ( (tbf in [cfbtVarType, cfbtLocalVarType]) and
(FTokenState <> tsAfterAbsolute) and
(fRange * [rsVarTypeInSpecification, rsAfterEqualOrColon] = [rsVarTypeInSpecification]) ) or (fRange * [rsVarTypeInSpecification, rsAfterEqualOrColon] = [rsVarTypeInSpecification]) ) or
( (tbf in [cfbtClass, cfbtClassSection, cfbtRecord, cfbtRecordCase, cfbtRecordCaseSection]) and ( (tbf in [cfbtClass, cfbtClassSection, cfbtRecord, cfbtRecordCase, cfbtRecordCaseSection]) and
( (fRange * [rsAfterClassMembers, rsInProcHeader] = [rsAfterClassMembers]) or ( (fRange * [rsAfterClassMembers, rsInProcHeader] = [rsAfterClassMembers]) or
@ -2850,7 +2916,7 @@ begin
( (tbf in [cfbtUnitSection, cfbtProgram, cfbtProcedure]) and ( (tbf in [cfbtUnitSection, cfbtProgram, cfbtProcedure]) and
(fRange * [rsInProcHeader] = []) ) or (fRange * [rsInProcHeader] = []) ) or
( (tbf in [cfbtUnit, cfbtNone]) and ( (tbf in [cfbtUnit, cfbtNone]) and
(fRange * [rsInProcHeader, rsAfterProcName] = [rsAfterProcName]) ) (fRange * [rsInProcHeader] = []) and (FTokenState = tsAfterProcName) )
) and ) and
( fRange *[rsAfterEqualOrColon, rsProperty] = [] ) and ( fRange *[rsAfterEqualOrColon, rsProperty] = [] ) and
(PasCodeFoldRange.BracketNestLevel = 0) (PasCodeFoldRange.BracketNestLevel = 0)
@ -2889,7 +2955,8 @@ begin
if InClass then if InClass then
fRange := fRange + [rsAfterClassMembers]; fRange := fRange + [rsAfterClassMembers];
fRange := fRange + [rsInProcHeader, rsAtProcName]; fRange := fRange + [rsInProcHeader];
FNextTokenState := tsAtProcName;
end; end;
Result := tkKey; Result := tkKey;
end else end else
@ -3559,11 +3626,15 @@ begin
fRange := fRange + [rsVarTypeInSpecification]; fRange := fRange + [rsVarTypeInSpecification];
// modifiers "alias: 'foo';" // modifiers "alias: 'foo';"
if (PasCodeFoldRange.BracketNestLevel = 0) and if (PasCodeFoldRange.BracketNestLevel = 0) then begin
(fRange * [rsInProcHeader, rsProperty, rsAfterEqualOrColon, rsWasInProcHeader] = [rsInProcHeader]) and if (fRange * [rsInProcHeader, rsProperty, rsAfterEqualOrColon, rsWasInProcHeader] = [rsInProcHeader]) and
(TopPascalCodeFoldBlockType in ProcModifierAllowed) (TopPascalCodeFoldBlockType in ProcModifierAllowed)
then then
FRange := FRange + [rsInProcHeader]; FRange := FRange + [rsInProcHeader]
else
if rsInConstBlock in fRange then
fRange := fRange + [rsInTypedConst];
end;
end; end;
end; end;
@ -3720,10 +3791,10 @@ begin
fRange := fRange + [rsAtPropertyOrReadWrite]; fRange := fRange + [rsAtPropertyOrReadWrite];
FOldRange := FOldRange - [rsAtPropertyOrReadWrite]; FOldRange := FOldRange - [rsAtPropertyOrReadWrite];
end; end;
if fRange * [rsAfterProcName] = [rsAfterProcName] then begin if (FTokenState = tsAfterProcName) then begin
if rsInProcHeader in fRange then if rsInProcHeader in fRange then
FTokenFlags := FTokenFlags + [tfProcName]; FTokenFlags := FTokenFlags + [tfProcName];
fRange := fRange + [rsAtProcName]; FNextTokenState := tsAtProcName;
end; end;
end; end;
@ -3917,7 +3988,14 @@ begin
fRange := fRange + [rsWasInProcHeader]; fRange := fRange + [rsWasInProcHeader];
fRange := fRange - [rsProperty, rsInProcHeader]; fRange := fRange - [rsProperty, rsInProcHeader];
end; end;
fRange := fRange - [rsVarTypeInSpecification, rsAfterEqual] + [rsAfterSemiColon];
if FTokenState in [tsAfterExternal, tsAfterCvar] then
FNextTokenState := FTokenState
else
if rsInTypedConst in fRange then
FNextTokenState := tsAfterTypedConst;
fRange := fRange - [rsVarTypeInSpecification, rsAfterEqual, rsInTypedConst] + [rsAfterSemiColon];
FOldRange := FOldRange - [rsAfterSemiColon]; FOldRange := FOldRange - [rsAfterSemiColon];
end; end;
@ -4123,15 +4201,15 @@ begin
fProcTable[fLine[Run]]; fProcTable[fLine[Run]];
if not (FTokenID in [tkSpace, tkComment, tkIDEDirective, tkDirective, tkNull]) then if (FTokenID = tkIdentifier) and (FTokenState = tsAtProcName) then begin
FTokenState := FNextTokenState;
if (FTokenID = tkIdentifier) and (fRange * [rsAtProcName] = [rsAtProcName]) then begin
if rsInProcHeader in fRange then if rsInProcHeader in fRange then
FTokenFlags := FTokenFlags + [tfProcName]; FTokenFlags := FTokenFlags + [tfProcName];
fRange := fRange + [rsAfterProcName]; FNextTokenState := tsAfterProcName;
end; end;
if not (FTokenID in [tkSpace, tkComment, tkIDEDirective, tkDirective, tkNull]) then
FTokenState := FNextTokenState;
if (IsAtCaseLabel) and (rsAtCaseLabel in fRange) then begin if (IsAtCaseLabel) and (rsAtCaseLabel in fRange) then begin
FTokenIsCaseLabel := True; FTokenIsCaseLabel := True;
if (FTokenID = tkKey) then if (FTokenID = tkKey) then
@ -4151,8 +4229,7 @@ begin
fRange := fRange - fRange := fRange -
(FOldRange * [rsAfterEqualOrColon, rsAfterSemiColon, (FOldRange * [rsAfterEqualOrColon, rsAfterSemiColon,
rsAtPropertyOrReadWrite, rsAfterClassField, rsAtPropertyOrReadWrite, rsAfterClassField,
rsAfterIdentifierOrValue, rsAfterEqualThenType, rsAfterIdentifierOrValue, rsWasInProcHeader,
rsWasInProcHeader, rsAtProcName, rsAfterProcName,
rsInTypeHelper] rsInTypeHelper]
); );
@ -5082,7 +5159,7 @@ begin
Exclude(fRange, rsSkipAllPasBlocks); Exclude(fRange, rsSkipAllPasBlocks);
BlockType := TopPascalCodeFoldBlockType; BlockType := TopPascalCodeFoldBlockType;
if BlockType in [cfbtVarType, cfbtLocalVarType] then if BlockType in [cfbtVarType, cfbtLocalVarType] then
fRange := fRange - [rsInTypeBlock]; fRange := fRange - [rsInTypeBlock, rsInConstBlock];
fRange := fRange - [rsAfterEqual]; fRange := fRange - [rsAfterEqual];
DecreaseLevel := TopCodeFoldBlockType < CountPascalCodeFoldBlockOffset; DecreaseLevel := TopCodeFoldBlockType < CountPascalCodeFoldBlockOffset;
// TODO: let inherited call CollectNodeInfo // TODO: let inherited call CollectNodeInfo

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

@ -59,6 +59,7 @@ type
procedure TestContextForProcModifiers; procedure TestContextForProcModifiers;
procedure TestContextForProcModifiers2; procedure TestContextForProcModifiers2;
procedure TestContextForProcModifiersName; procedure TestContextForProcModifiersName;
procedure TestContextForVarModifiers;
procedure TestContextForProperties; procedure TestContextForProperties;
procedure TestContextForProcedure; procedure TestContextForProcedure;
procedure TestContextForProcedureNameAttr; procedure TestContextForProcedureNameAttr;
@ -834,6 +835,313 @@ begin
end; end;
end; end;
procedure TTestHighlighterPas.TestContextForVarModifiers;
var
n: String;
AFolds: TPascalCodeFoldBlockTypes;
i, j: Integer;
begin
ReCreateEdit;
for i := 0 to 7 do begin
case i of
0: n := 'name';
1: n := 'public';
2: n := 'external';
3: n := 'export';
4: n := 'cvar';
5: n := 'deprecated';
6: n := 'default';
7: n := 'absolute';
end;
SetLines
([ 'Unit A; interface',
'',
'var ',
// Line 3:
n+':'+n+'; public;',
n+':'+n+'; public name ''name'';',
n+':'+n+'; external;',
n+':'+n+'; external ''name'';',
n+':'+n+'; external name ''name'';',
n+':'+n+'; external ''name'' name ''name'';',
n+':'+n+'; export;',
n+':'+n+'; export name ''name'';',
'',
'',
// Line 13:
n+':'+n+';cvar; public;',
n+':'+n+';cvar; public name ''name'';',
n+':'+n+';cvar; external;',
n+':'+n+';cvar; external ''name'';',
'',//n+':'+n+';cvar; external name ''name'';',
'',//n+':'+n+';cvar; external ''name'' name ''name'';',
n+':'+n+';cvar; export;',
n+':'+n+';cvar; export name ''name'';',
n+':'+n+';cvar; cvar: cvar; name: name; var', // just another variable
'',
// Line 23:
n+':'+n+'=1; public;',
n+':'+n+'=1; public name ''name'';',
'',//n+':'+n+'=1; external;',
'',//n+':'+n+'=1; external ''name'';',
'',//n+':'+n+'=1; external name ''name'';',
'',//n+':'+n+'=1; external ''name'' name ''name'';',
n+':'+n+'=1; export;',
n+':'+n+'=1; export name ''name'';',
'',
'',
// Line 33:
n+':'+n+' deprecated; public;',
n+':'+n+' deprecated; public name ''name'';',
n+':'+n+' deprecated; external;',
n+':'+n+' deprecated; external ''name'';',
n+':'+n+' deprecated; external name ''name'';',
n+':'+n+' deprecated; external ''name'' name ''name'';',
n+':'+n+' deprecated; export;',
n+':'+n+' deprecated; export name ''name'';',
'',
'',
// Line 43:
n+':'+n+' absolute '+n+';',
'',
'',
'',
'type',
// Line 48:
n+'='+n+'; '+n+'='+n+';', // just another type
'const',
// Line 50:
n+'='+n+'; '+n+'='+n+';', // just another const
n+':'+n+'='+n+'; cvar;', // key CVAR
n+':'+n+'='+n+'; cvar; public;', // key CVAR
n+':'+n+'='+n+'; public;', // key public
n+':'+n+'='+n+'; public name ''name'';', // key public name
'',
'',
'',
'',
// NOT for "public"
'type TFoo = class ',
// Line 60:
n+':'+n+'; '+n+':'+n+'; public private', // just another field
n+':'+n+'; public '+n+':'+n+'; public private', // just another public field
'var '+n+':'+n+'; public '+n+':'+n+'; public private', // just another public field
'type '+n+':'+n+'; '+n+':'+n+'; public private', // just another type
'const '+n+':'+n+'='+n+'; '+n+':'+n+'='+n+'; public private', // just another const
'',
'end;',
''
]);
for j := 0 to $1F do begin
AFolds := [];
if (j and $10) = 0 then AFolds := [cfbtBeginEnd..cfbtNone] - [cfbtUnitSection, cfbtVarType, cfbtClass, cfbtClassSection];
if (j and $01) = 0 then AFolds := AFolds + [cfbtUnitSection];
if (j and $02) = 0 then AFolds := AFolds + [cfbtVarType];
if (j and $04) = 0 then AFolds := AFolds + [cfbtClass];
if (j and $08) = 0 then AFolds := AFolds + [cfbtClassSection];
EnableFolds(AFolds);
CheckTokensForLine(n+':'+n+'; public;', 3,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkSpace,
tkKey, TK_Semi
]);
CheckTokensForLine(n+':'+n+'; public name ''name'';', 4,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkSpace,
tkKey, tkSpace, tkKey, tkSpace, tkString, TK_Semi
]);
CheckTokensForLine(n+':'+n+'; external;', 5,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkSpace,
tkKey, TK_Semi
]);
CheckTokensForLine(n+':'+n+'; external ''name'';', 6,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkSpace,
tkKey, tkSpace, tkString, TK_Semi
]);
CheckTokensForLine(n+':'+n+'; external name ''name'';', 7,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkSpace,
tkKey, tkSpace, tkKey, tkSpace, tkString, TK_Semi
]);
CheckTokensForLine(n+':'+n+'; external ''name'' name ''name'';', 8,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkSpace,
tkKey, tkSpace, tkString, tkSpace, tkKey, tkSpace, tkString, TK_Semi
]);
CheckTokensForLine(n+':'+n+'; export;', 9,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkSpace,
tkKey, TK_Semi
]);
CheckTokensForLine(n+':'+n+'; export name ''name'';', 10,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkSpace,
tkKey, tkSpace, tkKey, tkSpace, tkString, TK_Semi
]);
CheckTokensForLine(n+':'+n+';cvar; public;', 13,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkKey {cvar}, TK_Semi, tkSpace,
tkKey, TK_Semi
]);
CheckTokensForLine(n+':'+n+';cvar; public name ''name'';', 14,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkKey {cvar}, TK_Semi, tkSpace,
tkKey, tkSpace, tkKey, tkSpace, tkString, TK_Semi
]);
CheckTokensForLine(n+':'+n+';cvar; external;', 15,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkKey {cvar}, TK_Semi, tkSpace,
tkKey, TK_Semi
]);
CheckTokensForLine(n+':'+n+';cvar; external ''name'';', 16,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkKey {cvar}, TK_Semi, tkSpace,
tkKey, tkSpace, tkString, TK_Semi
]);
// CheckTokensForLine(n+':'+n+';cvar; external name ''name'';', 17,
// tkKey, tkSpace, tkKey, tkSpace, tkString, TK_Semi
// [tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkSpace, tkKey {cvar}, TK_Semi, tkSpace,
// ]);
// CheckTokensForLine(n+':'+n+';cvar; external ''name'' name ''name'';', 18,
// [tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkSpace, tkKey {cvar}, TK_Semi, tkSpace,
// tkKey, tkSpace, tkString, tkSpace, tkKey, tkSpace, tkString, TK_Semi
// ]);
CheckTokensForLine(n+':'+n+';cvar; export;', 19,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkKey {cvar}, TK_Semi, tkSpace,
tkKey, TK_Semi
]);
CheckTokensForLine(n+':'+n+';cvar; export name ''name'';', 20,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkKey {cvar}, TK_Semi, tkSpace,
tkKey, tkSpace, tkKey, tkSpace, tkString, TK_Semi
]);
// just another var:
CheckTokensForLine(n+':'+n+';cvar; cvar: cvar; name: name; var', 21,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkKey {cvar}, TK_Semi, tkSpace,
tkIdentifier, TK_Colon, tkSpace, tkIdentifier, TK_Semi, tkSpace,
tkIdentifier, TK_Colon, tkSpace, tkIdentifier, TK_Semi,
tkSpace, tkKey
]);
CheckTokensForLine(n+':'+n+'=1; public;', 23,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Equal, tkNumber, TK_Semi, tkSpace,
tkKey, TK_Semi
]);
CheckTokensForLine(n+':'+n+'=1; public name ''name'';', 24,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Equal, tkNumber, TK_Semi, tkSpace,
tkKey, tkSpace, tkKey, tkSpace, tkString, TK_Semi
]);
// CheckTokensForLine(n+':'+n+'=1; external;', 25,
// [tkIdentifier, TK_Colon, tkIdentifier, TK_Equal, tkNumber, TK_Semi, tkSpace,
// tkKey, TK_Semi
// ]);
// CheckTokensForLine(n+':'+n+'=1; external ''name'';', 26,
// [tkIdentifier, TK_Colon, tkIdentifier, TK_Equal, tkNumber, TK_Semi, tkSpace,
// tkKey, tkSpace, tkString, TK_Semi
// ]);
// CheckTokensForLine(n+':'+n+'=1; external name ''name'';', 27,
// [tkIdentifier, TK_Colon, tkIdentifier, TK_Equal, tkNumber, TK_Semi, tkSpace,
// tkKey, tkSpace, tkKey, tkSpace, tkString, TK_Semi
// ]);
// CheckTokensForLine(n+':'+n+'=1; external ''name'' name ''name'';', 28,
// [tkIdentifier, TK_Colon, tkIdentifier, TK_Equal, tkNumber, TK_Semi, tkSpace,
// tkKey, tkSpace, tkString, tkSpace, tkKey, tkSpace, tkString, TK_Semi
// ]);
CheckTokensForLine(n+':'+n+'=1; export;', 29,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Equal, tkNumber, TK_Semi, tkSpace,
tkKey, TK_Semi
]);
CheckTokensForLine(n+':'+n+'=1; export name ''name'';', 30,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Equal, tkNumber, TK_Semi, tkSpace,
tkKey, tkSpace, tkKey, tkSpace, tkString, TK_Semi
]);
CheckTokensForLine(n+':'+n+' deprecated; public;', 33,
[tkIdentifier, TK_Colon, tkIdentifier, tkSpace, tkKey{depr}, TK_Semi, tkSpace,
tkKey, TK_Semi
]);
CheckTokensForLine(n+':'+n+' deprecated; public name ''name'';', 34,
[tkIdentifier, TK_Colon, tkIdentifier, tkSpace, tkKey{depr}, TK_Semi, tkSpace,
tkKey, tkSpace, tkKey, tkSpace, tkString, TK_Semi
]);
CheckTokensForLine(n+':'+n+' deprecated; external;', 35,
[tkIdentifier, TK_Colon, tkIdentifier, tkSpace, tkKey{depr}, TK_Semi, tkSpace,
tkKey, TK_Semi
]);
CheckTokensForLine(n+':'+n+' deprecated; external ''name'';', 36,
[tkIdentifier, TK_Colon, tkIdentifier, tkSpace, tkKey{depr}, TK_Semi, tkSpace,
tkKey, tkSpace, tkString, TK_Semi
]);
CheckTokensForLine(n+':'+n+' deprecated; external name ''name'';', 37,
[tkIdentifier, TK_Colon, tkIdentifier, tkSpace, tkKey{depr}, TK_Semi, tkSpace,
tkKey, tkSpace, tkKey, tkSpace, tkString, TK_Semi
]);
CheckTokensForLine(n+':'+n+' deprecated; external ''name'' name ''name'';', 38,
[tkIdentifier, TK_Colon, tkIdentifier, tkSpace, tkKey{depr}, TK_Semi, tkSpace,
tkKey, tkSpace, tkString, tkSpace, tkKey, tkSpace, tkString, TK_Semi
]);
CheckTokensForLine(n+':'+n+' deprecated; export;', 39,
[tkIdentifier, TK_Colon, tkIdentifier, tkSpace, tkKey{depr}, TK_Semi, tkSpace,
tkKey, TK_Semi
]);
CheckTokensForLine(n+':'+n+' deprecated; export name ''name'';', 40,
[tkIdentifier, TK_Colon, tkIdentifier, tkSpace, tkKey{depr}, TK_Semi, tkSpace,
tkKey, tkSpace, tkKey, tkSpace, tkString, TK_Semi
]);
CheckTokensForLine(n+':'+n+' absolute '+n+';', 43,
[tkIdentifier, TK_Colon, tkIdentifier, tkSpace, tkKey{absolute}, tkSpace, tkIdentifier, TK_Semi ]);
//TYPE / just another type
CheckTokensForLine(n+'='+n+'; '+n+'='+n+';', 48,
[tkIdentifier, TK_Equal, tkIdentifier, TK_Semi, tkSpace,
tkIdentifier, TK_Equal, tkIdentifier, TK_Semi]);
// const
CheckTokensForLine(n+'='+n+'; '+n+'='+n+';', 50, // just another const
[tkIdentifier, TK_Equal, tkIdentifier, TK_Semi, tkSpace,
tkIdentifier, TK_Equal, tkIdentifier, TK_Semi]);
CheckTokensForLine(n+':'+n+'='+n+'; cvar;', 51, // key CVAR
[tkIdentifier, TK_Colon, tkIdentifier, TK_Equal, tkIdentifier, TK_Semi, tkSpace,
tkKey, TK_Semi
]);
if copy(n,1,6) = 'public' then
continue;
// NOT for "public"
CheckTokensForLine(n+':'+n+'='+n+'; cvar; public;', 52, // key CVAR
[tkIdentifier, TK_Colon, tkIdentifier, TK_Equal, tkIdentifier, TK_Semi, tkSpace,
tkKey, TK_Semi, tkSpace, tkKey, TK_Semi
]);
CheckTokensForLine(n+':'+n+'='+n+'; public;', 53, // key public
[tkIdentifier, TK_Colon, tkIdentifier, TK_Equal, tkIdentifier, TK_Semi, tkSpace,
tkKey, TK_Semi
]);
CheckTokensForLine(n+':'+n+'='+n+'; public name ''name'';', 54, // key public name
[tkIdentifier, TK_Colon, tkIdentifier, TK_Equal, tkIdentifier, TK_Semi, tkSpace,
tkKey, tkSpace, tkKey, tkSpace, tkString, TK_Semi
]);
// NOT for "public"
CheckTokensForLine('#CLASS#'+ n+':'+n+'; '+n+':'+n+'; public private', 60,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkSpace,
tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkSpace, tkKey {public}, tkSpace, tkKey {private}
]);
CheckTokensForLine('#CLASS#'+n+':'+n+'; public '+n+':'+n+'; public private', 61,
[tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkSpace, tkKey {public}, tkSpace,
tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkSpace, tkKey {public}, tkSpace, tkKey {private}
]);
CheckTokensForLine('#CLASS#'+'var '+n+':'+n+'; public '+n+':'+n+'; public private', 62,
[tkKey{var}, tkSpace,
tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkSpace, tkKey {public}, tkSpace,
tkIdentifier, TK_Colon, tkIdentifier, TK_Semi, tkSpace, tkKey {public}, tkSpace, tkKey {private}
]);
CheckTokensForLine('#CLASS#'+'type '+n+'='+n+'; '+n+'='+n+'; public private', 63,
[tkKey{type}, tkSpace,
tkIdentifier, TK_Equal, tkIdentifier, TK_Semi, tkSpace,
tkIdentifier, TK_Equal, tkIdentifier, TK_Semi, tkSpace, tkKey {public}, tkSpace, tkKey {private}]);
CheckTokensForLine('#CLASS#'+'const '+n+':'+n+'='+n+'; '+n+':'+n+'='+n+'; public private', 64, // just another const
[tkKey{const}, tkSpace,
tkIdentifier, TK_Colon, tkIdentifier, TK_Equal, tkIdentifier, TK_Semi, tkSpace,
tkIdentifier, TK_Colon, tkIdentifier, TK_Equal, tkIdentifier, TK_Semi, tkSpace, tkKey {public}, tkSpace, tkKey {private}]);
end;
end;
end;
procedure TTestHighlighterPas.TestContextForProperties; procedure TTestHighlighterPas.TestContextForProperties;
var var
AFolds: TPascalCodeFoldBlockTypes; AFolds: TPascalCodeFoldBlockTypes;
@ -1549,6 +1857,7 @@ procedure TTestHighlighterPas.TestContextForDeprecated;
'foo, '+s+', bar: Integer '+s+';', 'foo, '+s+', bar: Integer '+s+';',
'type', 'type',
s+' = '+s+' '+s+';', // nameDEPRECATED = typeDEPRECATED deprecated; s+' = '+s+' '+s+';', // nameDEPRECATED = typeDEPRECATED deprecated;
s+' =type '+s+' '+s+';', // nameDEPRECATED = type typeDEPRECATED deprecated;
'procedure '+s+'('+s+': '+s+'); '+s+';', 'procedure '+s+'('+s+': '+s+'); '+s+';',
'var', 'var',
s+':procedure '+s+';', s+':procedure '+s+';',
@ -1561,11 +1870,13 @@ procedure TTestHighlighterPas.TestContextForDeprecated;
tkSpace, tkIdentifier, tkSpace, tkKey {the one and only}, tkSymbol]); tkSpace, tkIdentifier, tkSpace, tkKey {the one and only}, tkSymbol]);
CheckTokensForLine('type', 5, CheckTokensForLine('type', 5,
[tkIdentifier, tkSpace, tkSymbol, tkSpace, tkIdentifier, tkSpace, tkKey {the one and only}, tkSymbol]); [tkIdentifier, tkSpace, tkSymbol, tkSpace, tkIdentifier, tkSpace, tkKey {the one and only}, tkSymbol]);
CheckTokensForLine('procedure', 6, CheckTokensForLine('type', 6,
[tkIdentifier, tkSpace, tkSymbol, tkKey, tkSpace, tkIdentifier, tkSpace, tkKey {the one and only}, tkSymbol]);
CheckTokensForLine('procedure', 7,
[tkKey, tkSpace, tkIdentifier + FAttrProcName, tkSymbol { ( }, tkIdentifier, tkSymbol { : }, [tkKey, tkSpace, tkIdentifier + FAttrProcName, tkSymbol { ( }, tkIdentifier, tkSymbol { : },
tkSpace, tkIdentifier, tkSymbol { ) }, tkSymbol, tkSpace, tkKey {the one and only}, tkSymbol tkSpace, tkIdentifier, tkSymbol { ) }, tkSymbol, tkSpace, tkKey {the one and only}, tkSymbol
]); ]);
CheckTokensForLine('var a:procedure DEPRECATED;', 8, CheckTokensForLine('var a:procedure DEPRECATED;', 9,
[tkIdentifier, TK_Colon, tkKey, tkSpace, tkKey {the one and only}, TK_Semi]); [tkIdentifier, TK_Colon, tkKey, tkSpace, tkKey {the one and only}, TK_Semi]);
@ -1910,8 +2221,10 @@ begin
CheckTokensForLine('public:public;', 15, CheckTokensForLine('public:public;', 15,
[ sp1, tkIdentifier {public}, tkSymbol{:}, tkIdentifier, tkSymbol{;} ]); [ sp1, tkIdentifier {public}, tkSymbol{:}, tkIdentifier, tkSymbol{;} ]);
CheckTokensForLine('public:public;', 16, // public would be modifier
[ sp2, tkIdentifier {public}, tkSymbol{:}, tkIdentifier, tkSymbol{;} ]); if trim(v) <> 'public' then
CheckTokensForLine('public:public;', 16,
[ sp2, tkIdentifier {public}, tkSymbol{:}, tkIdentifier, tkSymbol{;} ]);
end; end;
end; end;