mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-09 05:56:05 +02:00
SynEdit, Pas Highlighter: show ^x as string
git-svn-id: trunk@47509 -
This commit is contained in:
martin
parent
7b55299f5d
commit
652c828a0a
@ -78,6 +78,7 @@ type
|
||||
// we need to detect: type TFoo = procedure; // must not fold
|
||||
// var foo: procedure; // must not fold
|
||||
rsAfterEqualOrColon, // very first word after "=" or ":"
|
||||
rsAfterEqual, // between "=" and ";" (or block end) // a ^ means ctrl-char, not pointer to type
|
||||
|
||||
// Detect if class/object is type TFoo = class; // forward declaration
|
||||
// TBar = class of TFoo;
|
||||
@ -91,8 +92,9 @@ type
|
||||
rsInProcHeader, // Declaration or implementation header of a Procedure, function, constructor...
|
||||
rsAfterClassMembers, // Encountered a procedure, function, property, constructor or destructor in a class
|
||||
rsAfterClassField, // after ";" of a field (static needs highlight)
|
||||
rsVarTypeInSpecification // between ":"/"=" and ";" in a var or type section (or class members)
|
||||
// var a: Integer; type b = Int64;
|
||||
rsVarTypeInSpecification, // between ":"/"=" and ";" in a var or type section (or class members)
|
||||
// var a: Integer; type b = Int64;
|
||||
rsInTypeBlock
|
||||
);
|
||||
TRangeStates = set of TRangeState;
|
||||
|
||||
@ -450,6 +452,7 @@ type
|
||||
procedure OctalProc;
|
||||
procedure LFProc;
|
||||
procedure LowerProc;
|
||||
procedure CaretProc;
|
||||
procedure NullProc;
|
||||
procedure NumberProc;
|
||||
procedure PointProc;
|
||||
@ -1374,6 +1377,7 @@ begin
|
||||
if TopPascalCodeFoldBlockType in [cfbtProcedure]
|
||||
then StartPascalCodeFoldBlock(cfbtLocalVarType)
|
||||
else StartPascalCodeFoldBlock(cfbtVarType);
|
||||
fRange := fRange + [rsInTypeBlock];
|
||||
end;
|
||||
Result := tkKey;
|
||||
end
|
||||
@ -2283,8 +2287,9 @@ begin
|
||||
'0'..'9': fProcTable[I] := @NumberProc;
|
||||
'A'..'Z', 'a'..'z', '_':
|
||||
fProcTable[I] := @IdentProc;
|
||||
'^': fProcTable[I] := @CaretProc;
|
||||
'{': fProcTable[I] := @BraceOpenProc;
|
||||
'}', '!', '"', '('..'/', ':'..'@', '['..'^', '`', '~':
|
||||
'}', '!', '"', '('..'/', ':'..'@', '[', ']', '\', '`', '~':
|
||||
begin
|
||||
case I of
|
||||
'(': fProcTable[I] := @RoundOpenProc;
|
||||
@ -2737,6 +2742,26 @@ begin
|
||||
if fLine[Run] in ['=', '>'] then inc(Run);
|
||||
end;
|
||||
|
||||
procedure TSynPasSyn.CaretProc;
|
||||
var
|
||||
t: TPascalCodeFoldBlockType;
|
||||
begin
|
||||
inc(Run);
|
||||
fTokenID := tkSymbol;
|
||||
|
||||
t := TopPascalCodeFoldBlockType;
|
||||
if (t in PascalStatementBlocks - [cfbtAsm]) or //cfbtClass, cfbtClassSection,
|
||||
( ( (t in [cfbtVarType, cfbtLocalVarType]) or
|
||||
((t in [cfbtProcedure]) and (PasCodeFoldRange.BracketNestLevel > 0))
|
||||
) and
|
||||
(fRange * [rsInTypeBlock, rsAfterEqual] = [rsAfterEqual]) )
|
||||
then begin
|
||||
if Run<fLineLen then
|
||||
inc(Run);
|
||||
fTokenID := tkString;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSynPasSyn.NullProc;
|
||||
begin
|
||||
if (Run = 0) and (rsSlash in fRange) then begin
|
||||
@ -2868,7 +2893,7 @@ procedure TSynPasSyn.EqualSignProc;
|
||||
begin
|
||||
inc(Run);
|
||||
fTokenID := tkSymbol;
|
||||
fRange := fRange + [rsAfterEqualOrColon];
|
||||
fRange := fRange + [rsAfterEqualOrColon, rsAfterEqual];
|
||||
if (TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType, cfbtClass, cfbtClassSection, cfbtRecord]) and
|
||||
not(rsAfterClassMembers in fRange)
|
||||
then
|
||||
@ -2906,7 +2931,7 @@ begin
|
||||
(PasCodeFoldRange.BracketNestLevel = 0)
|
||||
then
|
||||
fRange := fRange - [rsProperty, rsInProcHeader];
|
||||
fRange := fRange - [rsVarTypeInSpecification];
|
||||
fRange := fRange - [rsVarTypeInSpecification, rsAfterEqual];
|
||||
end;
|
||||
|
||||
procedure TSynPasSyn.SlashProc;
|
||||
@ -3034,13 +3059,11 @@ begin
|
||||
not(rsAtClosingBracket in fRange)
|
||||
then
|
||||
fRange := fRange - [rsAfterClass];
|
||||
if rsAfterEqualOrColon in FOldRange then
|
||||
fRange := fRange - [rsAfterEqualOrColon];
|
||||
if rsAtPropertyOrReadWrite in FOldRange then
|
||||
fRange := fRange - [rsAtPropertyOrReadWrite];
|
||||
fRange := fRange - [rsAtClosingBracket];
|
||||
if rsAfterClassField in FOldRange then
|
||||
fRange := fRange - [rsAfterClassField];
|
||||
|
||||
fRange := fRange -
|
||||
(FOldRange * [rsAfterEqualOrColon, rsAtPropertyOrReadWrite, rsAfterClassField]) -
|
||||
[rsAtClosingBracket];
|
||||
|
||||
if rsAtClass in fRange then begin
|
||||
if FOldRange * [rsAtClass, rsAfterClass] <> [] then
|
||||
fRange := fRange + [rsAfterClass] - [rsAtClass]
|
||||
@ -3745,6 +3768,9 @@ var
|
||||
nd: TSynFoldNodeInfo;
|
||||
begin
|
||||
BlockType := TopPascalCodeFoldBlockType;
|
||||
if BlockType in [cfbtVarType, cfbtLocalVarType] then
|
||||
fRange := fRange - [rsInTypeBlock];
|
||||
fRange := fRange - [rsAfterEqual];
|
||||
DecreaseLevel := TopCodeFoldBlockType < CountPascalCodeFoldBlockOffset;
|
||||
if FCatchNodeInfo then begin // exclude subblocks, because they do not increase the foldlevel yet
|
||||
BlockEnabled := FFoldConfig[ord(BlockType)].Enabled;
|
||||
|
||||
@ -58,6 +58,7 @@ type
|
||||
procedure TestContextForClassHelper;
|
||||
procedure TestContextForRecordHelper;
|
||||
procedure TestContextForStatic;
|
||||
procedure TestCaretAsString;
|
||||
procedure TestFoldNodeInfo;
|
||||
end;
|
||||
|
||||
@ -1076,6 +1077,51 @@ begin
|
||||
]);
|
||||
end;
|
||||
|
||||
procedure TTestHighlighterPas.TestCaretAsString;
|
||||
begin
|
||||
ReCreateEdit;
|
||||
SetLines
|
||||
([ 'Unit A; interface', // 0
|
||||
'var',
|
||||
'a:char=^o;',
|
||||
'b:^char=nil;',
|
||||
'type',
|
||||
'c=^char;', // 5
|
||||
'implementation',
|
||||
'function x(f:^char=^k):^v;', // actually the compiler does not allow ^ as pointer for result
|
||||
'var',
|
||||
'a:char=^o;',
|
||||
'b:^char=nil;', // 10
|
||||
'type',
|
||||
'c=^char;',
|
||||
'begin',
|
||||
'i:=^f;',
|
||||
'end;', // 15
|
||||
''
|
||||
]);
|
||||
|
||||
CheckTokensForLine('a:char=^o;', 2,
|
||||
[tkIdentifier, tkSymbol, tkIdentifier, tkSymbol, tkString, tkSymbol]);
|
||||
CheckTokensForLine('b:^char=nil;', 3,
|
||||
[tkIdentifier, tkSymbol, tkSymbol, tkIdentifier, tkSymbol, tkKey, tkSymbol]);
|
||||
CheckTokensForLine('c=^char;', 5,
|
||||
[tkIdentifier, tkSymbol, tkSymbol, tkIdentifier, tkSymbol]);
|
||||
|
||||
CheckTokensForLine('function x(f:^char=^k):^v;', 7,
|
||||
[tkKey, tkSpace, tkIdentifier, tkSymbol, tkIdentifier, // function x(f
|
||||
tkSymbol, tkSymbol, tkIdentifier, tkSymbol, tkString, // :^char=^k
|
||||
tkSymbol, tkSymbol, tkSymbol, tkIdentifier, tkSymbol]); // ):^v;
|
||||
CheckTokensForLine('LOCAL a:char=^o;', 9,
|
||||
[tkIdentifier, tkSymbol, tkIdentifier, tkSymbol, tkString, tkSymbol]);
|
||||
CheckTokensForLine('LOCAL b:^char=nil;', 10,
|
||||
[tkIdentifier, tkSymbol, tkSymbol, tkIdentifier, tkSymbol, tkKey, tkSymbol]);
|
||||
CheckTokensForLine('LOCAL c=^char;', 12,
|
||||
[tkIdentifier, tkSymbol, tkSymbol, tkIdentifier, tkSymbol]);
|
||||
CheckTokensForLine('i:=^f', 14,
|
||||
[tkIdentifier, tkSymbol, tkString, tkSymbol]);
|
||||
|
||||
end;
|
||||
|
||||
procedure TTestHighlighterPas.TestFoldNodeInfo;
|
||||
Procedure CheckNode(ALine: TLineIdx; AFilter: TSynFoldActions; AFoldGroup: Integer;
|
||||
AColumn: integer;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user