mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-22 13:59:31 +02:00
SynEdit, Highlighter: added highlight of case-labels
git-svn-id: trunk@25432 -
This commit is contained in:
martin
parent
99c23d89c7
commit
82018af2fb
@ -84,12 +84,16 @@ type
|
||||
property NeedsReScanEndIndex: Integer read FNeedsReScanEndIndex;
|
||||
end;
|
||||
|
||||
TSynHighlighterAttrFeature = (hafStyleMask);
|
||||
TSynHighlighterAttrFeatures = set of TSynHighlighterAttrFeature;
|
||||
{ TSynHighlighterAttributes }
|
||||
|
||||
TSynHighlighterAttributes = class(TPersistent)
|
||||
private
|
||||
fBackground: TColor;
|
||||
fBackgroundDefault: TColor; //mh 2000-10-08
|
||||
FFeature: TSynHighlighterAttrFeatures;
|
||||
FFeatures: TSynHighlighterAttrFeatures;
|
||||
fForeground: TColor;
|
||||
fForegroundDefault: TColor; //mh 2000-10-08
|
||||
FFrameColor: TColor;
|
||||
@ -140,6 +144,7 @@ type
|
||||
property Name: string read fName;
|
||||
property StoredName: string read FStoredName write FStoredName;
|
||||
property OnChange: TNotifyEvent read fOnChange write fOnChange;
|
||||
property Features: TSynHighlighterAttrFeatures read FFeatures write FFeature;
|
||||
published
|
||||
property Background: TColor read fBackground write SetBackground
|
||||
stored GetBackgroundColorStored; //mh 2000-10-08
|
||||
|
||||
@ -133,6 +133,7 @@ resourcestring
|
||||
SYNS_AttrSQLPlus = 'SQL*Plus command';
|
||||
SYNS_AttrString = 'String';
|
||||
SYNS_AttrSymbol = 'Symbol';
|
||||
SYNS_AttrCaseLabel = 'Case label';
|
||||
SYNS_AttrSyntaxError = 'SyntaxError';
|
||||
SYNS_AttrSystem = 'System functions and variables';
|
||||
SYNS_AttrSystemValue = 'System value';
|
||||
@ -240,6 +241,7 @@ const
|
||||
SYNS_XML_AttrSQLPlus :String = SYNS_AttrSQLPlus; // 'SQL*Plus command';
|
||||
SYNS_XML_AttrString :String = SYNS_AttrString; // 'String';
|
||||
SYNS_XML_AttrSymbol :String = SYNS_AttrSymbol; // 'Symbol';
|
||||
SYNS_XML_AttrCaseLabel :String = SYNS_AttrCaseLabel; // 'Case label';
|
||||
SYNS_XML_AttrSyntaxError :String = SYNS_AttrSyntaxError; // 'SyntaxError';
|
||||
SYNS_XML_AttrSystem :String = SYNS_AttrSystem; // 'System functions and variables';
|
||||
SYNS_XML_AttrSystemValue :String = SYNS_AttrSystemValue; // 'System value';
|
||||
|
||||
@ -83,7 +83,8 @@ type
|
||||
// Detect if class/object is ended by ";" or "end;"
|
||||
rsAtClass,
|
||||
rsAfterClass,
|
||||
rsAtClosingBracket // ')'
|
||||
rsAtClosingBracket, // ')'
|
||||
rsAtCaseLabel
|
||||
);
|
||||
TRangeStates = set of TRangeState;
|
||||
|
||||
@ -254,6 +255,7 @@ type
|
||||
fIdentFuncTable: array[0..191] of TIdentFuncTableFunc;
|
||||
fTokenPos: Integer;// start of current token in fLine
|
||||
FTokenID: TtkTokenKind;
|
||||
FTokenIsCaseLabel: Boolean;
|
||||
fStringAttri: TSynHighlighterAttributes;
|
||||
fNumberAttri: TSynHighlighterAttributes;
|
||||
fKeyAttri: TSynHighlighterAttributes;
|
||||
@ -262,6 +264,8 @@ type
|
||||
fCommentAttri: TSynHighlighterAttributes;
|
||||
fIdentifierAttri: TSynHighlighterAttributes;
|
||||
fSpaceAttri: TSynHighlighterAttributes;
|
||||
FCaseLabelAttri: TSynHighlighterAttributes;
|
||||
FCurCaseLabelAttri: TSynHighlighterAttributes;
|
||||
{$IFDEF SYN_LAZARUS}
|
||||
fDirectiveAttri: TSynHighlighterAttributes;
|
||||
FCompilerMode: TPascalCompilerMode;
|
||||
@ -504,6 +508,8 @@ type
|
||||
write fStringAttri;
|
||||
property SymbolAttri: TSynHighlighterAttributes read fSymbolAttri
|
||||
write fSymbolAttri;
|
||||
property CaseLabelAttri: TSynHighlighterAttributes read FCaseLabelAttri
|
||||
write FCaseLabelAttri;
|
||||
{$IFDEF SYN_LAZARUS}
|
||||
property DirectiveAttri: TSynHighlighterAttributes read fDirectiveAttri
|
||||
write fDirectiveAttri;
|
||||
@ -894,12 +900,17 @@ begin
|
||||
// Accidental start of block // End at next semicolon (usually same line)
|
||||
CodeFoldRange.Pop(false); // avoid minlevel
|
||||
CodeFoldRange.Add(Pointer(PtrInt(cfbtUses)), false);
|
||||
end;
|
||||
end
|
||||
else
|
||||
if (TopPascalCodeFoldBlockType = cfbtCase) then
|
||||
fRange := fRange + [rsAtCaseLabel];
|
||||
end
|
||||
else Result := tkIdentifier;
|
||||
end;
|
||||
|
||||
function TSynPasSyn.Func23: TtkTokenKind;
|
||||
var
|
||||
tfb: TPascalCodeFoldBlockType;
|
||||
begin
|
||||
if KeyComp('End') then begin
|
||||
if ((fToIdent<2) or (fLine[fToIdent-1]<>'@'))
|
||||
@ -909,30 +920,34 @@ begin
|
||||
PasCodeFoldRange.BracketNestLevel := 0; // Reset in case of partial code
|
||||
{$IFDEF SYN_LAZARUS}
|
||||
// there may be more than on block ending here
|
||||
if TopPascalCodeFoldBlockType = cfbtRecord then begin
|
||||
tfb := TopPascalCodeFoldBlockType;
|
||||
if tfb = cfbtRecord then begin
|
||||
EndPascalCodeFoldBlock;
|
||||
end else if TopPascalCodeFoldBlockType = cfbtUnit then begin
|
||||
end else if tfb = cfbtUnit then begin
|
||||
EndPascalCodeFoldBlock;
|
||||
end else if TopPascalCodeFoldBlockType = cfbtExcept then begin
|
||||
end else if tfb = cfbtExcept then begin
|
||||
EndPascalCodeFoldBlock;
|
||||
if TopPascalCodeFoldBlockType = cfbtTry then
|
||||
EndPascalCodeFoldBlock;
|
||||
end else if TopPascalCodeFoldBlockType = cfbtTry then begin
|
||||
end else if tfb = cfbtTry then begin
|
||||
EndPascalCodeFoldBlock;
|
||||
end else if TopPascalCodeFoldBlockType in [cfbtTopBeginEnd, cfbtAsm] then begin
|
||||
end else if tfb in [cfbtTopBeginEnd, cfbtAsm] then begin
|
||||
EndPascalCodeFoldBlock;
|
||||
if TopPascalCodeFoldBlockType in [cfbtProcedure] then
|
||||
EndPascalCodeFoldBlock;
|
||||
if TopPascalCodeFoldBlockType = cfbtProgram then
|
||||
EndPascalCodeFoldBlock;
|
||||
end else if TopPascalCodeFoldBlockType in [cfbtBeginEnd, cfbtCase] then begin
|
||||
end else if tfb in [cfbtCase] then begin
|
||||
EndPascalCodeFoldBlock;
|
||||
end else if TopPascalCodeFoldBlockType = cfbtUnitSection then begin
|
||||
fRange := fRange - [rsAtCaseLabel];
|
||||
end else if tfb in [cfbtBeginEnd] then begin
|
||||
EndPascalCodeFoldBlock;
|
||||
end else if tfb = cfbtUnitSection then begin
|
||||
EndPascalCodeFoldBlockLastLine;
|
||||
if TopPascalCodeFoldBlockType = cfbtUnit then // "Unit".."end."
|
||||
EndPascalCodeFoldBlock;
|
||||
end else begin
|
||||
if TopPascalCodeFoldBlockType = cfbtClassSection then
|
||||
if tfb = cfbtClassSection then
|
||||
EndPascalCodeFoldBlockLastLine;
|
||||
if TopPascalCodeFoldBlockType = cfbtClass then
|
||||
EndPascalCodeFoldBlock;
|
||||
@ -2037,6 +2052,10 @@ begin
|
||||
AddAttribute(fStringAttri);
|
||||
fSymbolAttri := TSynHighlighterAttributes.Create(SYNS_AttrSymbol, SYNS_XML_AttrSymbol);
|
||||
AddAttribute(fSymbolAttri);
|
||||
FCaseLabelAttri := TSynHighlighterAttributes.Create(SYNS_AttrCaseLabel, SYNS_XML_AttrCaseLabel);
|
||||
AddAttribute(FCaseLabelAttri);
|
||||
FCaseLabelAttri.Features := FCaseLabelAttri.Features + [hafStyleMask];
|
||||
FCurCaseLabelAttri := TSynHighlighterAttributes.Create(SYNS_AttrCaseLabel, SYNS_XML_AttrCaseLabel);
|
||||
{$IFDEF SYN_LAZARUS}
|
||||
fDirectiveAttri := TSynHighlighterAttributes.Create(SYNS_AttrDirective, SYNS_XML_AttrDirective);
|
||||
fDirectiveAttri.Style:= [fsItalic];
|
||||
@ -2056,6 +2075,7 @@ end; { Create }
|
||||
destructor TSynPasSyn.Destroy;
|
||||
begin
|
||||
DestroyDividerDrawConfig;
|
||||
FreeAndNil(FCurCaseLabelAttri);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -2307,6 +2327,7 @@ begin
|
||||
fTokenID := tkSymbol;
|
||||
inc(Run);
|
||||
if fLine[Run] = '=' then inc(Run);
|
||||
fRange := fRange - [rsAtCaseLabel];
|
||||
end;
|
||||
|
||||
procedure TSynPasSyn.CRProc;
|
||||
@ -2318,11 +2339,7 @@ end;
|
||||
|
||||
procedure TSynPasSyn.IdentProc;
|
||||
begin
|
||||
{$IFDEF SYN_LAZARUS}
|
||||
fTokenID := IdentKind(Run);
|
||||
{$ELSE}
|
||||
fTokenID := IdentKind((fLine + Run));
|
||||
{$ENDIF}
|
||||
inc(Run, fStringLen);
|
||||
while Identifiers[fLine[Run]] do inc(Run);
|
||||
end;
|
||||
@ -2521,13 +2538,18 @@ begin
|
||||
end;
|
||||
|
||||
procedure TSynPasSyn.SemicolonProc;
|
||||
var
|
||||
tfb: TPascalCodeFoldBlockType;
|
||||
begin
|
||||
Inc(Run);
|
||||
fTokenID := tkSymbol;
|
||||
if TopPascalCodeFoldBlockType = cfbtUses then
|
||||
tfb := TopPascalCodeFoldBlockType;
|
||||
if tfb = cfbtUses then
|
||||
EndPascalCodeFoldBlock;
|
||||
if (TopPascalCodeFoldBlockType = cfbtClass) and (rsAfterClass in fRange) then
|
||||
if (tfb = cfbtClass) and (rsAfterClass in fRange) then
|
||||
EndPascalCodeFoldBlock(True);
|
||||
if (tfb = cfbtCase) then
|
||||
fRange := fRange + [rsAtCaseLabel];
|
||||
if (rsProperty in fRange) and (PasCodeFoldRange.BracketNestLevel = 0) then
|
||||
fRange := fRange - [rsProperty];
|
||||
end;
|
||||
@ -2597,9 +2619,12 @@ begin
|
||||
end;
|
||||
|
||||
procedure TSynPasSyn.Next;
|
||||
var
|
||||
IsAtCaseLabel: Boolean;
|
||||
begin
|
||||
fAsmStart := False;
|
||||
fTokenPos := Run;
|
||||
FTokenIsCaseLabel := False;
|
||||
{$IFDEF SYN_LAZARUS}
|
||||
if Run>=fLineLen then begin
|
||||
fTokenID := tkNull;
|
||||
@ -2625,7 +2650,13 @@ begin
|
||||
else
|
||||
if rsAtClass in fRange then
|
||||
fRange := fRange + [rsAfterClass] - [rsAtClass];
|
||||
IsAtCaseLabel := rsAtCaseLabel in fRange;
|
||||
fProcTable[fLine[Run]];
|
||||
if (IsAtCaseLabel) and (rsAtCaseLabel in fRange) then begin
|
||||
FTokenIsCaseLabel := True;
|
||||
if (FTokenID = tkKey) then
|
||||
fRange := fRange - [rsAtCaseLabel];
|
||||
end;
|
||||
if not (FTokenID in [tkSpace, tkComment, tkDirective]) then begin
|
||||
if (PasCodeFoldRange.BracketNestLevel = 0) and
|
||||
not(rsAtClosingBracket in fRange) then
|
||||
@ -2700,6 +2731,8 @@ begin
|
||||
end;
|
||||
|
||||
function TSynPasSyn.GetTokenAttribute: TSynHighlighterAttributes;
|
||||
var
|
||||
sMask: TFontStyles;
|
||||
begin
|
||||
case GetTokenID of
|
||||
tkAsm: Result := fAsmAttri;
|
||||
@ -2717,6 +2750,18 @@ begin
|
||||
else
|
||||
Result := nil;
|
||||
end;
|
||||
if FTokenIsCaseLabel and
|
||||
(GetTokenID in [tkIdentifier, tkKey, tkNumber, tkString])
|
||||
then begin
|
||||
FCurCaseLabelAttri.Assign(Result);
|
||||
Result := FCurCaseLabelAttri;
|
||||
if FCaseLabelAttri.Background <> clNone then Result.Background := FCaseLabelAttri.Background;
|
||||
if FCaseLabelAttri.Foreground <> clNone then Result.Foreground := FCaseLabelAttri.Foreground;
|
||||
if FCaseLabelAttri.FrameColor <> clNone then Result.FrameColor := FCaseLabelAttri.FrameColor;
|
||||
sMask := FCaseLabelAttri.StyleMask + (fsNot(FCaseLabelAttri.StyleMask) * FCaseLabelAttri.Style); // Styles to be taken from FCaseLabelAttri
|
||||
Result.Style:= (Result.Style * fsNot(sMask)) + (FCaseLabelAttri.Style * sMask);
|
||||
Result.StyleMask:= (Result.StyleMask * fsNot(sMask)) + (FCaseLabelAttri.StyleMask * sMask);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSynPasSyn.GetTokenKind: integer;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user