mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-12 14:09:31 +02:00
IDE, SynEdit: Add custom ident/keywords to Pascal Highlighter
This commit is contained in:
Martin
parent
d4ecf72cc1
commit
9a3e82cf06
@ -169,6 +169,7 @@ type
|
||||
|
||||
procedure AssignFrom(Src: TLazSynCustomTextAttributes); override;
|
||||
procedure DoChange; override;
|
||||
procedure Init; virtual;
|
||||
property ConstName: string read FConstName write FConstName; // internal accessor
|
||||
public
|
||||
constructor Create;
|
||||
@ -1290,9 +1291,15 @@ begin
|
||||
fOnChange(Self);
|
||||
end;
|
||||
|
||||
procedure TSynHighlighterAttributes.Init;
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
constructor TSynHighlighterAttributes.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
Init;
|
||||
InternalSaveDefaultValues;
|
||||
end;
|
||||
|
||||
|
||||
@ -47,11 +47,12 @@ advanced features found in Object Pascal in Delphi 4.
|
||||
unit SynHighlighterPas;
|
||||
|
||||
{$I synedit.inc}
|
||||
{$ModeSwitch advancedrecords}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, Registry, Graphics, SynEditHighlighterFoldBase,
|
||||
SysUtils, Classes, fgl, Registry, Graphics, SynEditHighlighterFoldBase,
|
||||
SynEditMiscProcs, SynEditTypes, SynEditHighlighter, SynEditTextBase,
|
||||
SynEditStrConst, SynEditMiscClasses, LazLoggerBase;
|
||||
|
||||
@ -63,6 +64,7 @@ type
|
||||
TtkTokenKind = (tkAsm, tkComment, tkIdentifier, tkKey, tkModifier, tkNull, tkNumber,
|
||||
tkSpace, tkString, tkSymbol, tkDirective, tkIDEDirective,
|
||||
tkUnknown);
|
||||
TtkTokenKinds= set of TtkTokenKind;
|
||||
|
||||
TRangeState = (
|
||||
rsAnsiMultiDQ, // Multi line double quoted string
|
||||
@ -306,6 +308,30 @@ const
|
||||
|
||||
type
|
||||
|
||||
{ TSynPasSynCustomToken }
|
||||
|
||||
TSynPasSynCustomToken = class
|
||||
private
|
||||
FOnChange: TNotifyEvent;
|
||||
FOnMarkupChange: TNotifyEvent;
|
||||
procedure DoMarkupChaged(Sender: TObject);
|
||||
procedure DoTokensChanged(Sender: TObject);
|
||||
private
|
||||
FMarkup: TSynHighlighterAttributesModifier;
|
||||
FMatchTokenKinds: TtkTokenKinds;
|
||||
FTokens: TStrings;
|
||||
|
||||
procedure SetMatchTokenKinds(AValue: TtkTokenKinds);
|
||||
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
||||
property OnMarkupChange: TNotifyEvent read FOnMarkupChange write FOnMarkupChange;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
property MatchTokenKinds: TtkTokenKinds read FMatchTokenKinds write SetMatchTokenKinds;
|
||||
property Tokens: TStrings read FTokens;
|
||||
property Markup: TSynHighlighterAttributesModifier read FMarkup;
|
||||
end;
|
||||
|
||||
TSynPasRangeInfo = record
|
||||
EndLevelIfDef: Smallint;
|
||||
MinLevelIfDef: Smallint;
|
||||
@ -364,7 +390,29 @@ type
|
||||
{ TSynPasSyn }
|
||||
|
||||
TSynPasSyn = class(TSynCustomFoldHighlighter)
|
||||
private type
|
||||
|
||||
{ TSynPasSynCustomTokenInfo }
|
||||
|
||||
TSynPasSynCustomTokenInfo = record
|
||||
MatchTokenKinds: TtkTokenKinds;
|
||||
Word: String;
|
||||
Token: TSynPasSynCustomToken;
|
||||
class operator = (a, b: TSynPasSynCustomTokenInfo): boolean;
|
||||
end;
|
||||
PSynPasSynCustomTokenInfo = ^TSynPasSynCustomTokenInfo;
|
||||
PPSynPasSynCustomTokenInfo = ^PSynPasSynCustomTokenInfo;
|
||||
TSynPasSynCustomTokenInfoList = specialize TFPGList<TSynPasSynCustomTokenInfo>;
|
||||
private
|
||||
FSynCustomTokens: array of TSynPasSynCustomToken;
|
||||
FNeedCustomTokenBuild: boolean;
|
||||
FCustomTokenInfo: array [byte] of record
|
||||
MatchTokenKinds: TtkTokenKinds;
|
||||
List: TSynPasSynCustomTokenInfoList;
|
||||
end;
|
||||
FCustomTokenMarkup: TSynHighlighterAttributesModifier;
|
||||
FCustomTokenMergedMarkup: TSynSelectedColorMergeResult;
|
||||
|
||||
fAsmStart: Boolean;
|
||||
FExtendedKeywordsMode: Boolean;
|
||||
FNestedComments: boolean;
|
||||
@ -396,6 +444,7 @@ type
|
||||
fIdentFuncTable: array[0..220] of TIdentFuncTableFunc;
|
||||
fTokenPos: Integer;// start of current token in fLine
|
||||
FTokenID: TtkTokenKind;
|
||||
FTokenHashKey: Integer;
|
||||
FTokenFlags: set of (tfProcName);
|
||||
FTokenIsCaseLabel: Boolean;
|
||||
fStringAttri: TSynHighlighterAttributes;
|
||||
@ -418,6 +467,11 @@ type
|
||||
// Divider
|
||||
FDividerDrawConfig: Array [TSynPasDividerDrawLocation] of TSynDividerDrawConfig;
|
||||
|
||||
procedure DoCustomTokenChanged(Sender: TObject);
|
||||
procedure RebuildCustomTokenInfo;
|
||||
function GetCustomTokenCount: integer;
|
||||
procedure SetCustomTokenCount(AValue: integer);
|
||||
function GetCustomTokens(AnIndex: integer): TSynPasSynCustomToken;
|
||||
function GetPasCodeFoldRange: TSynPasSynRange;
|
||||
procedure PasDocAttrChanged(Sender: TObject);
|
||||
procedure SetCompilerMode(const AValue: TPascalCompilerMode);
|
||||
@ -669,6 +723,8 @@ type
|
||||
function FoldLineLength(ALineIndex, FoldIndex: Integer): integer; override; // accesses FoldNodeInfo
|
||||
function FoldEndLine(ALineIndex, FoldIndex: Integer): integer; override; // accesses FoldNodeInfo
|
||||
|
||||
property CustomTokenCount: integer read GetCustomTokenCount write SetCustomTokenCount;
|
||||
property CustomTokens[AnIndex: integer]: TSynPasSynCustomToken read GetCustomTokens;
|
||||
published
|
||||
property AsmAttri: TSynHighlighterAttributes read fAsmAttri write fAsmAttri;
|
||||
property CommentAttri: TSynHighlighterAttributes read fCommentAttri
|
||||
@ -1109,6 +1165,75 @@ begin
|
||||
Result := TSynPasSynRange(CodeFoldRange);
|
||||
end;
|
||||
|
||||
function TSynPasSyn.GetCustomTokenCount: integer;
|
||||
begin
|
||||
Result := Length(FSynCustomTokens);
|
||||
end;
|
||||
|
||||
procedure TSynPasSyn.DoCustomTokenChanged(Sender: TObject);
|
||||
begin
|
||||
FNeedCustomTokenBuild := True;
|
||||
end;
|
||||
|
||||
procedure TSynPasSyn.RebuildCustomTokenInfo;
|
||||
var
|
||||
i, j, h: Integer;
|
||||
ti: TSynPasSynCustomTokenInfo;
|
||||
t: String;
|
||||
begin
|
||||
FNeedCustomTokenBuild := False;
|
||||
for i := 0 to 255 do begin
|
||||
FreeAndNil(FCustomTokenInfo[i].List);
|
||||
FCustomTokenInfo[i].MatchTokenKinds := [];
|
||||
end;
|
||||
for i := 0 to Length(FSynCustomTokens) - 1 do begin
|
||||
for j := 0 to FSynCustomTokens[i].FTokens.Count - 1 do begin
|
||||
if FSynCustomTokens[i].MatchTokenKinds = [] then
|
||||
continue;
|
||||
t := FSynCustomTokens[i].FTokens[j];
|
||||
if t = '' then
|
||||
continue;
|
||||
fLine := PChar(t);
|
||||
fLineLen := Length(t);
|
||||
fToIdent := 0;
|
||||
h := KeyHash and 255;
|
||||
|
||||
if FCustomTokenInfo[h].List = nil then
|
||||
FCustomTokenInfo[h].List := TSynPasSynCustomTokenInfoList.Create;
|
||||
|
||||
ti.MatchTokenKinds := FSynCustomTokens[i].MatchTokenKinds;
|
||||
ti.Word := UpperCase(t);
|
||||
ti.Token := FSynCustomTokens[i];
|
||||
FCustomTokenInfo[h].MatchTokenKinds := FCustomTokenInfo[h].MatchTokenKinds + FSynCustomTokens[i].MatchTokenKinds;
|
||||
FCustomTokenInfo[h].List.Add(ti);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSynPasSyn.SetCustomTokenCount(AValue: integer);
|
||||
var
|
||||
l: SizeInt;
|
||||
i: Integer;
|
||||
begin
|
||||
l := Length(FSynCustomTokens);
|
||||
if AValue = l then
|
||||
exit;
|
||||
|
||||
for i := AValue to l - 1 do
|
||||
FSynCustomTokens[i].Free;
|
||||
SetLength(FSynCustomTokens, AValue);
|
||||
for i := l to AValue - 1 do begin
|
||||
FSynCustomTokens[i] := TSynPasSynCustomToken.Create;
|
||||
FSynCustomTokens[i].OnMarkupChange := @DefHighlightChange;
|
||||
FSynCustomTokens[i].OnChange := @DoCustomTokenChanged;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSynPasSyn.GetCustomTokens(AnIndex: integer): TSynPasSynCustomToken;
|
||||
begin
|
||||
Result := FSynCustomTokens[AnIndex];
|
||||
end;
|
||||
|
||||
procedure TSynPasSyn.PasDocAttrChanged(Sender: TObject);
|
||||
begin
|
||||
FUsePasDoc := fPasDocKeyWordAttri.IsEnabled or
|
||||
@ -3157,13 +3282,11 @@ begin
|
||||
end;
|
||||
|
||||
function TSynPasSyn.IdentKind(p: integer): TtkTokenKind;
|
||||
var
|
||||
HashKey: Integer;
|
||||
begin
|
||||
fToIdent := p;
|
||||
HashKey := KeyHash;
|
||||
if HashKey <= High(fIdentFuncTable) then
|
||||
Result := fIdentFuncTable[HashKey]()
|
||||
FTokenHashKey := KeyHash;
|
||||
if FTokenHashKey <= High(fIdentFuncTable) then
|
||||
Result := fIdentFuncTable[FTokenHashKey]()
|
||||
else
|
||||
Result := tkIdentifier;
|
||||
end;
|
||||
@ -3270,6 +3393,8 @@ begin
|
||||
FCurPasDocAttri := TSynSelectedColorMergeResult.Create(@SYNS_AttrCaseLabel, SYNS_XML_AttrCaseLabel);
|
||||
FPasDocWordList := TStringList.Create;
|
||||
|
||||
FCustomTokenMergedMarkup := TSynSelectedColorMergeResult.Create;
|
||||
|
||||
CompilerMode:=pcmDelphi;
|
||||
SetAttributesOnChange(@DefHighlightChange);
|
||||
fPasDocKeyWordAttri.OnChange := @PasDocAttrChanged;
|
||||
@ -3285,13 +3410,19 @@ begin
|
||||
end; { Create }
|
||||
|
||||
destructor TSynPasSyn.Destroy;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
DestroyDividerDrawConfig;
|
||||
FreeAndNil(FCurCaseLabelAttri);
|
||||
FreeAndNil(FCurIDEDirectiveAttri);
|
||||
FreeAndNil(FCurProcedureHeaderNameAttr);
|
||||
FreeAndNil(FCurPasDocAttri);
|
||||
FreeAndNil(FCustomTokenMergedMarkup);
|
||||
FreeAndNil(FPasDocWordList);
|
||||
CustomTokenCount := 0;
|
||||
for i := 0 to 255 do
|
||||
FCustomTokenInfo[i].List.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -3311,6 +3442,9 @@ end;
|
||||
procedure TSynPasSyn.SetLine(const NewValue: string; LineNumber:Integer);
|
||||
begin
|
||||
//DebugLn(['TSynPasSyn.SetLine START LineNumber=',LineNumber,' Line="',NewValue,'"']);
|
||||
if FNeedCustomTokenBuild then
|
||||
RebuildCustomTokenInfo;
|
||||
|
||||
fLineStr := NewValue;
|
||||
fLineLen:=length(fLineStr);
|
||||
fLine:=PChar(Pointer(fLineStr));
|
||||
@ -4243,7 +4377,10 @@ end;
|
||||
procedure TSynPasSyn.Next;
|
||||
var
|
||||
IsAtCaseLabel: Boolean;
|
||||
OldNestLevel: Integer;
|
||||
OldNestLevel, i: Integer;
|
||||
CustTk: TSynPasSynCustomTokenInfoList;
|
||||
CustTkList: PPSynPasSynCustomTokenInfo;
|
||||
UpperTk: String;
|
||||
begin
|
||||
fAsmStart := False;
|
||||
FIsPasDocKey := False;
|
||||
@ -4251,6 +4388,7 @@ begin
|
||||
FIsPasUnknown := False;
|
||||
FTokenIsCaseLabel := False;
|
||||
fTokenPos := Run;
|
||||
FCustomTokenMarkup := nil;
|
||||
if Run>=fLineLen then begin
|
||||
NullProc;
|
||||
exit;
|
||||
@ -4284,8 +4422,28 @@ begin
|
||||
|
||||
IsAtCaseLabel := rsAtCaseLabel in fRange;
|
||||
|
||||
FTokenHashKey := 0;
|
||||
fProcTable[fLine[Run]];
|
||||
|
||||
if FTokenID in FCustomTokenInfo[FTokenHashKey and 255].MatchTokenKinds then begin
|
||||
CustTk := FCustomTokenInfo[FTokenHashKey and 255].List;
|
||||
if CustTk <> nil then begin
|
||||
UpperTk := '';
|
||||
CustTkList := CustTk.List;
|
||||
for i := 0 to CustTk.Count - 1 do begin
|
||||
if (FTokenID in CustTkList^^.MatchTokenKinds) then begin
|
||||
if UpperTk = '' then
|
||||
UpperTk := UpperCase(GetToken);
|
||||
if (UpperTk = CustTkList^^.Word) then begin
|
||||
FCustomTokenMarkup := CustTkList^^.Token.FMarkup;
|
||||
break;
|
||||
end
|
||||
end;
|
||||
inc(CustTkList);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if (FTokenID = tkIdentifier) and (FTokenState = tsAtProcName) then begin
|
||||
if rsInProcHeader in fRange then
|
||||
FTokenFlags := FTokenFlags + [tfProcName];
|
||||
@ -4455,6 +4613,12 @@ begin
|
||||
FCurProcedureHeaderNameAttr.Merge(FProcedureHeaderNameAttr);
|
||||
Result := FCurProcedureHeaderNameAttr;
|
||||
end;
|
||||
|
||||
if FCustomTokenMarkup <> nil then begin
|
||||
FCustomTokenMergedMarkup.Assign(Result);
|
||||
FCustomTokenMergedMarkup.Merge(FCustomTokenMarkup);
|
||||
Result := FCustomTokenMergedMarkup;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSynPasSyn.GetTokenKind: integer;
|
||||
@ -5774,6 +5938,15 @@ begin
|
||||
FD4syntax := Value;
|
||||
end;
|
||||
|
||||
{ TSynPasSyn.TSynPasSynCustomTokenInfo }
|
||||
|
||||
class operator TSynPasSyn.TSynPasSynCustomTokenInfo. = (a, b: TSynPasSynCustomTokenInfo): boolean;
|
||||
begin
|
||||
Result := (a.MatchTokenKinds = b.MatchTokenKinds) and
|
||||
(a.Token = b.Token) and
|
||||
(a.Word = b.Word);
|
||||
end;
|
||||
|
||||
{ TSynFreePascalSyn }
|
||||
|
||||
constructor TSynFreePascalSyn.Create(AOwner: TComponent);
|
||||
@ -5859,6 +6032,43 @@ begin
|
||||
dec(FPasFoldFixLevel);
|
||||
end;
|
||||
|
||||
{ TSynPasSynCustomToken }
|
||||
|
||||
procedure TSynPasSynCustomToken.DoTokensChanged(Sender: TObject);
|
||||
begin
|
||||
if FOnChange <> nil then
|
||||
FOnChange(Self);
|
||||
end;
|
||||
|
||||
procedure TSynPasSynCustomToken.SetMatchTokenKinds(AValue: TtkTokenKinds);
|
||||
begin
|
||||
if FMatchTokenKinds = AValue then Exit;
|
||||
FMatchTokenKinds := AValue;
|
||||
DoTokensChanged(Self);
|
||||
end;
|
||||
|
||||
procedure TSynPasSynCustomToken.DoMarkupChaged(Sender: TObject);
|
||||
begin
|
||||
if FOnMarkupChange <> nil then
|
||||
FOnMarkupChange(Self);
|
||||
end;
|
||||
|
||||
constructor TSynPasSynCustomToken.Create;
|
||||
begin
|
||||
FMarkup := TSynHighlighterAttributesModifier.Create;
|
||||
FMarkup.OnChange := @DoMarkupChaged;
|
||||
FTokens := TStringList.Create;
|
||||
TStringList(FTokens).OnChange := @DoTokensChanged;
|
||||
FMatchTokenKinds := [];
|
||||
end;
|
||||
|
||||
destructor TSynPasSynCustomToken.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
FMarkup.Free;
|
||||
FTokens.Free;
|
||||
end;
|
||||
|
||||
{ TSynHighlighterPasRangeList }
|
||||
|
||||
function TSynHighlighterPasRangeList.GetTSynPasRangeInfo(Index: Integer): TSynPasRangeInfo;
|
||||
|
||||
@ -100,7 +100,8 @@ type
|
||||
( hafBackColor, hafForeColor, hafFrameColor, hafAlpha, hafPrior,
|
||||
hafStyle, hafStyleMask,
|
||||
hafFrameStyle, hafFrameEdges,
|
||||
hafMarkupFoldColor // for the MarkupFoldColor module
|
||||
hafMarkupFoldColor, // for the MarkupFoldColor module
|
||||
hafCustomWords
|
||||
);
|
||||
TColorSchemeAttributeFeatures = set of TColorSchemeAttributeFeature;
|
||||
|
||||
@ -283,7 +284,7 @@ type
|
||||
|
||||
{ TColorSchemeAttribute }
|
||||
|
||||
TColorSchemeAttribute = class(TSynHighlighterAttributesModifier)
|
||||
TColorSchemeAttribute = class(TSynHighlighterLazCustumPasAttribute)
|
||||
private
|
||||
FFeatures: TColorSchemeAttributeFeatures;
|
||||
FGroup: TAhaGroupName;
|
||||
@ -6985,6 +6986,10 @@ begin
|
||||
TSynHighlighterAttributesModifier(aDest).ForeAlpha := Src.ForeAlpha;
|
||||
TSynHighlighterAttributesModifier(aDest).BackAlpha := Src.BackAlpha;
|
||||
TSynHighlighterAttributesModifier(aDest).FrameAlpha := Src.FrameAlpha;
|
||||
if aDest is TSynHighlighterLazCustumPasAttribute then begin
|
||||
TSynHighlighterLazCustumPasAttribute(aDest).CustomWords.Assign(CustomWords);
|
||||
TSynHighlighterLazCustumPasAttribute(aDest).CustomWordTokenKind := CustomWordTokenKind;
|
||||
end;
|
||||
end;
|
||||
|
||||
if hafPrior in Src.Features then begin
|
||||
@ -7026,6 +7031,8 @@ begin
|
||||
inherited Assign(Src);
|
||||
FFeatures := [hafBackColor, hafForeColor, hafFrameColor,
|
||||
hafStyle, hafFrameStyle, hafFrameEdges, hafPrior];
|
||||
if Src is TSynHighlighterLazCustumPasAttribute then
|
||||
FFeatures := FFeatures + [hafCustomWords];
|
||||
if Src is TSynHighlighterAttributesModifier then
|
||||
FFeatures := FFeatures + [hafAlpha, hafStyleMask];
|
||||
|
||||
@ -7103,8 +7110,10 @@ begin
|
||||
Assert(Version > 4, 'TColorSchemeAttribute.LoadFromXml: Version ('+IntToStr(Version)+' < 5.');
|
||||
if StoredName = '' then exit;
|
||||
Path := aPath + StrToValidXMLName(StoredName) + '/';
|
||||
if aXMLConfig.HasPath(Path, False) then
|
||||
aXMLConfig.ReadObject(Path, Self, Defaults)
|
||||
if aXMLConfig.HasPath(Path, False) then begin
|
||||
aXMLConfig.ReadObject(Path, Self, Defaults);
|
||||
CustomWords.Text := aXMLConfig.GetValue(Path+'CustomWords', '');
|
||||
end
|
||||
else begin
|
||||
if (Defaults <> Self) and (Defaults <> nil) then begin
|
||||
// do not copy (Stored)Name or Features ...
|
||||
@ -7122,14 +7131,16 @@ begin
|
||||
BoldPriority := Defaults.BoldPriority;
|
||||
ItalicPriority := Defaults.ItalicPriority;
|
||||
UnderlinePriority := Defaults.UnderlinePriority;
|
||||
CustomWords.Text := Defaults.CustomWords.Text;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TColorSchemeAttribute.SaveToXml(aXMLConfig: TRttiXMLConfig;
|
||||
const aPath: String; Defaults: TColorSchemeAttribute);
|
||||
procedure TColorSchemeAttribute.SaveToXml(aXMLConfig: TRttiXMLConfig; const aPath: String;
|
||||
Defaults: TColorSchemeAttribute);
|
||||
var
|
||||
AttriName: String;
|
||||
Path: String;
|
||||
begin
|
||||
if StoredName = '' then
|
||||
exit;
|
||||
@ -7138,7 +7149,9 @@ begin
|
||||
if AttriName <> '' then
|
||||
aXMLConfig.DeletePath(aPath + StrToValidXMLName(AttriName));
|
||||
|
||||
aXMLConfig.WriteObject(aPath + StrToValidXMLName(StoredName) + '/', Self, Defaults);
|
||||
Path := aPath + StrToValidXMLName(StoredName) + '/';
|
||||
aXMLConfig.WriteObject(Path, Self, Defaults);
|
||||
aXMLConfig.SetDeleteValue(Path + 'CustomWords', CustomWords.Text, '');
|
||||
end;
|
||||
|
||||
{ TColorSchemeLanguage }
|
||||
@ -7258,6 +7271,9 @@ begin
|
||||
csa.Assign(hla);
|
||||
csa.Group := agnLanguage;
|
||||
if (FHighlighter <> nil) and (FHighlighter is TNonSrcIDEHighlighter) then
|
||||
if hla is TSynHighlighterLazCustumPasAttribute then
|
||||
csa.Features := [hafBackColor, hafForeColor, hafFrameColor, hafAlpha, hafPrior, hafStyle, hafStyleMask, hafCustomWords]
|
||||
else
|
||||
if hla is TSynHighlighterAttributesModifier then
|
||||
csa.Features := [hafBackColor, hafForeColor, hafFrameColor, hafAlpha, hafPrior, hafStyle, hafStyleMask]
|
||||
else
|
||||
|
||||
@ -1176,11 +1176,18 @@ begin
|
||||
agnDefault, // continue; // default is currently not shown
|
||||
agnLanguage:
|
||||
begin
|
||||
if FIsEditingDefaults then
|
||||
ParentName := AdditionalHighlightGroupNames[agnDefault]
|
||||
else
|
||||
ParentName := FCurrentHighlighter.LanguageName;
|
||||
ParentNode := ColorElementTree.Items.GetFirstNode;
|
||||
if FIsEditingDefaults then begin
|
||||
ParentName := AdditionalHighlightGroupNames[agnDefault];
|
||||
end
|
||||
else
|
||||
if hafCustomWords in Attr.Features then begin
|
||||
ParentName := FCurrentHighlighter.LanguageName + ' (Custom)';
|
||||
ParentNode := ColorElementTree.Items.FindTopLvlNode(ParentName);
|
||||
end
|
||||
else begin
|
||||
ParentName := FCurrentHighlighter.LanguageName;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
|
||||
@ -6291,6 +6291,9 @@ resourcestring
|
||||
optDispGutterNoCurrentLineColor = 'No current line color';
|
||||
optDispGutterUseCurrentLineColor = 'Use current line color';
|
||||
optDispGutterUseCurrentLineNumberColor = 'Use current line number color';
|
||||
dlgMatchWords = 'Match words';
|
||||
dlgKeyWord = 'KeyWord';
|
||||
dlgModifier = 'Modifier';
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@ -331,10 +331,32 @@ type
|
||||
FInitializationLine, FFinalizationLine: Integer;
|
||||
end;
|
||||
|
||||
{ TSynHighlighterLazCustumPasAttribute }
|
||||
|
||||
TSynHighlighterLazCustumPasAttribute = class(TSynHighlighterAttributesModifier)
|
||||
private
|
||||
FCustomWords: TStrings;
|
||||
FCustomWordTokenKind: TtkTokenKind;
|
||||
procedure DoWordsChanged(Sender: TObject);
|
||||
procedure SetCustomWordTokenKind(AValue: TtkTokenKind);
|
||||
protected
|
||||
procedure AssignFrom(Src: TLazSynCustomTextAttributes); override;
|
||||
procedure DoClear; override;
|
||||
procedure Init; override;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
property CustomWords: TStrings read FCustomWords;
|
||||
published
|
||||
property CustomWordTokenKind: TtkTokenKind read FCustomWordTokenKind write SetCustomWordTokenKind;
|
||||
end;
|
||||
|
||||
{ TIDESynPasSyn }
|
||||
|
||||
TIDESynPasSyn = class(TSynPasSyn)
|
||||
private
|
||||
FCustomAttribs: array[0..9] of TSynHighlighterLazCustumPasAttribute;
|
||||
|
||||
procedure DoBuildCustomPasAttr(Sender: TObject);
|
||||
function GetFinalizationLine: Integer;
|
||||
function GetImplementationLine: Integer;
|
||||
function GetInitializationLine: Integer;
|
||||
@ -345,6 +367,10 @@ type
|
||||
IncreaseLevel: Boolean = true; ForceDisabled: Boolean = False
|
||||
): TSynCustomCodeFoldBlock; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
//procedure DefHighlightChange(Sender: TObject);
|
||||
|
||||
|
||||
procedure SetLine({$IFDEF FPC}const {$ENDIF}NewValue: string;
|
||||
LineNumber: Integer); override;
|
||||
property InterfaceLine: Integer read GetInterfaceLine;
|
||||
@ -1925,11 +1951,86 @@ begin
|
||||
Ime.InvalidateLinesMethod := @InvalidateLines;
|
||||
ImeHandler := Ime;
|
||||
end;
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
{ TSynHighlighterLazCustumPasAttribute }
|
||||
|
||||
procedure TSynHighlighterLazCustumPasAttribute.SetCustomWordTokenKind(AValue: TtkTokenKind);
|
||||
begin
|
||||
if FCustomWordTokenKind = AValue then Exit;
|
||||
FCustomWordTokenKind := AValue;
|
||||
Changed;
|
||||
end;
|
||||
|
||||
procedure TSynHighlighterLazCustumPasAttribute.DoWordsChanged(Sender: TObject);
|
||||
begin
|
||||
Changed;
|
||||
end;
|
||||
|
||||
procedure TSynHighlighterLazCustumPasAttribute.AssignFrom(Src: TLazSynCustomTextAttributes);
|
||||
begin
|
||||
inherited AssignFrom(Src);
|
||||
if Src is TSynHighlighterLazCustumPasAttribute then begin
|
||||
FCustomWords.Assign(TSynHighlighterLazCustumPasAttribute(Src).FCustomWords);
|
||||
FCustomWordTokenKind := TSynHighlighterLazCustumPasAttribute(Src).FCustomWordTokenKind;
|
||||
end
|
||||
else begin
|
||||
FCustomWords.Clear;
|
||||
FCustomWordTokenKind := tkIdentifier;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSynHighlighterLazCustumPasAttribute.DoClear;
|
||||
begin
|
||||
inherited DoClear;
|
||||
if FCustomWords <> nil then
|
||||
FCustomWords.Clear;
|
||||
FCustomWordTokenKind := tkIdentifier;
|
||||
end;
|
||||
|
||||
procedure TSynHighlighterLazCustumPasAttribute.Init;
|
||||
begin
|
||||
FCustomWords := TStringList.Create;
|
||||
FCustomWordTokenKind := tkIdentifier;
|
||||
TStringList(FCustomWords).OnChange := @DoWordsChanged;
|
||||
inherited Init;
|
||||
end;
|
||||
|
||||
destructor TSynHighlighterLazCustumPasAttribute.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
FCustomWords.Destroy;
|
||||
end;
|
||||
|
||||
{ TIDESynPasSyn }
|
||||
|
||||
procedure TIDESynPasSyn.DoBuildCustomPasAttr(Sender: TObject);
|
||||
var
|
||||
c, i: Integer;
|
||||
begin
|
||||
c := 0;
|
||||
for i := 0 to 9 do
|
||||
if FCustomAttribs[i].IsEnabled and
|
||||
(trim(FCustomAttribs[i].CustomWords.Text) <> '')
|
||||
then
|
||||
inc(c);
|
||||
|
||||
CustomTokenCount := c;
|
||||
c := 0;
|
||||
for i := 0 to 9 do
|
||||
if FCustomAttribs[i].IsEnabled and
|
||||
(trim(FCustomAttribs[i].CustomWords.Text) <> '')
|
||||
then begin
|
||||
CustomTokens[c].Markup.Assign(FCustomAttribs[i]);
|
||||
CustomTokens[c].MatchTokenKinds := [FCustomAttribs[i].CustomWordTokenKind];
|
||||
CustomTokens[c].Tokens.Assign(FCustomAttribs[i].CustomWords);
|
||||
inc(c);
|
||||
end;
|
||||
|
||||
|
||||
DefHighlightChange(Sender);
|
||||
end;
|
||||
|
||||
function TIDESynPasSyn.GetFinalizationLine: Integer;
|
||||
begin
|
||||
Result := TIDESynHighlighterPasRangeList(CurrentRanges).FFinalizationLine;
|
||||
@ -1977,6 +2078,19 @@ begin
|
||||
Result := inherited;
|
||||
end;
|
||||
|
||||
constructor TIDESynPasSyn.Create(AOwner: TComponent);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
|
||||
for i := 0 to 9 do begin
|
||||
FCustomAttribs[i] := TSynHighlighterLazCustumPasAttribute.Create('Custom '+IntToStr(i), 'CustomToken_'+IntToStr(i));
|
||||
AddAttribute(FCustomAttribs[i]);
|
||||
FCustomAttribs[i].OnChange := @DoBuildCustomPasAttr;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TIDESynPasSyn.SetLine(const NewValue: string; LineNumber: Integer);
|
||||
begin
|
||||
if assigned(CurrentRanges) then begin
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -10,7 +10,7 @@ uses
|
||||
LCLIntf, Forms, StdCtrls, ExtCtrls, Graphics, GraphUtil,
|
||||
ColorBox, Dialogs, Menus, Spin,
|
||||
// SynEdit
|
||||
SynEditTypes, SynTextDrawer,
|
||||
SynEditTypes, SynTextDrawer, SynHighlighterPas,
|
||||
// IdeConfig
|
||||
EnvironmentOpts,
|
||||
// IDE
|
||||
@ -25,9 +25,20 @@ type
|
||||
BackPriorSpin: TSpinEdit;
|
||||
BackGroundColorBox: TColorBox;
|
||||
BackGroundLabel: TLabel;
|
||||
ColumnPosBevel: TPanel;
|
||||
dropCustomWordKind: TComboBox;
|
||||
ForePriorLabel: TLabel;
|
||||
ForePriorSpin: TSpinEdit;
|
||||
lbFiller1: TLabel;
|
||||
lbCustomWords: TLabel;
|
||||
lbFiller10: TLabel;
|
||||
lbFiller2: TLabel;
|
||||
lbFiller3: TLabel;
|
||||
lbFiller4: TLabel;
|
||||
lbFiller5: TLabel;
|
||||
lbFiller6: TLabel;
|
||||
lbFiller7: TLabel;
|
||||
lbFiller8: TLabel;
|
||||
lbFiller9: TLabel;
|
||||
lblInfo: TLabel;
|
||||
MarkupFoldStyleBox: TComboBox;
|
||||
MarkupFoldAlphaSpin: TSpinEdit;
|
||||
@ -45,6 +56,34 @@ type
|
||||
ForeAlphaLabel: TLabel;
|
||||
BackAlphaLabel: TLabel;
|
||||
FrameAlphaLabel: TLabel;
|
||||
edCustomWord: TMemo;
|
||||
Panel1: TPanel;
|
||||
Panel10: TPanel;
|
||||
Panel11: TPanel;
|
||||
Panel12: TPanel;
|
||||
Panel13: TPanel;
|
||||
Panel14: TPanel;
|
||||
Panel15: TPanel;
|
||||
Panel16: TPanel;
|
||||
Panel17: TPanel;
|
||||
Panel18: TPanel;
|
||||
Panel19: TPanel;
|
||||
Panel2: TPanel;
|
||||
Panel20: TPanel;
|
||||
Panel21: TPanel;
|
||||
Panel22: TPanel;
|
||||
pnlWords: TPanel;
|
||||
Panel3: TPanel;
|
||||
Panel4: TPanel;
|
||||
Panel5: TPanel;
|
||||
Panel6: TPanel;
|
||||
Panel7: TPanel;
|
||||
Panel8: TPanel;
|
||||
Panel9: TPanel;
|
||||
pnlFrameHost2: TPanel;
|
||||
pnlFrameHost1: TPanel;
|
||||
pnlForegroundName: TPanel;
|
||||
pnlBackgroundName: TPanel;
|
||||
pnlUnderline: TPanel;
|
||||
pnlBold: TPanel;
|
||||
pnlItalic: TPanel;
|
||||
@ -68,6 +107,8 @@ type
|
||||
TextUnderlineRadioPanel: TPanel;
|
||||
ForeGroundLabel: TLabel;
|
||||
ForeGroundUseDefaultCheckBox: TCheckBox;
|
||||
procedure dropCustomWordKindChange(Sender: TObject);
|
||||
procedure edCustomWordChange(Sender: TObject);
|
||||
procedure GeneralAlphaSpinOnChange(Sender: TObject);
|
||||
procedure GeneralAlphaSpinOnEnter(Sender: TObject);
|
||||
procedure GeneralColorBoxOnChange(Sender: TObject);
|
||||
@ -199,6 +240,25 @@ begin
|
||||
DoChanged;
|
||||
end;
|
||||
|
||||
procedure TSynColorAttrEditor.edCustomWordChange(Sender: TObject);
|
||||
begin
|
||||
if (FCurHighlightElement = nil) then
|
||||
exit;
|
||||
|
||||
FCurHighlightElement.CustomWords.Text := trim(edCustomWord.Text);
|
||||
end;
|
||||
|
||||
procedure TSynColorAttrEditor.dropCustomWordKindChange(Sender: TObject);
|
||||
begin
|
||||
case dropCustomWordKind.ItemIndex of
|
||||
0: FCurHighlightElement.CustomWordTokenKind := tkIdentifier;
|
||||
1: FCurHighlightElement.CustomWordTokenKind := tkKey;
|
||||
2: FCurHighlightElement.CustomWordTokenKind := tkModifier;
|
||||
3: FCurHighlightElement.CustomWordTokenKind := tkNumber;
|
||||
4: FCurHighlightElement.CustomWordTokenKind := tkSymbol;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSynColorAttrEditor.GeneralAlphaSpinOnEnter(Sender: TObject);
|
||||
begin
|
||||
UpdatingColor := True;
|
||||
@ -278,29 +338,19 @@ end;
|
||||
|
||||
procedure TSynColorAttrEditor.DoResized;
|
||||
var
|
||||
S: TSpinEdit;
|
||||
EdCustWidth: Integer;
|
||||
begin
|
||||
S := FramePriorSpin;
|
||||
if not S.Visible then
|
||||
S := FrameAlphaSpin;
|
||||
if Width > S.Left + S.Width + FrameStyleBox.Width + FrameEdgesBox.Width + 15 then
|
||||
begin
|
||||
//FrameEdgesBox.AnchorSide[akTop].Control := S;
|
||||
FrameEdgesBox.AnchorSide[akTop].Side := asrTop;
|
||||
FrameEdgesBox.AnchorSide[akLeft].Control := S;
|
||||
FrameEdgesBox.AnchorSide[akLeft].Side := asrBottom;
|
||||
FrameEdgesBox.BorderSpacing.Top := 0;
|
||||
FrameEdgesBox.BorderSpacing.Left := 6;
|
||||
MarkupFoldColorBox.AnchorSide[akTop].Control := FrameColorBox;
|
||||
EdCustWidth := 0;
|
||||
if edCustomWord.Visible then
|
||||
EdCustWidth := edCustomWord.Width;
|
||||
|
||||
if Width > Panel1.Width + EdCustWidth - pnlFrameHost1.Width + Max(pnlFrameHost1.Width, pnlFrameHost2.Width) + 15 then begin
|
||||
FrameEdgesBox.Parent := pnlFrameHost1;
|
||||
FrameStyleBox.Parent := pnlFrameHost1;
|
||||
end
|
||||
else begin
|
||||
//FrameEdgesBox.AnchorSide[akTop].Control := FrameColorBox;
|
||||
FrameEdgesBox.AnchorSide[akTop].Side := asrBottom;
|
||||
FrameEdgesBox.AnchorSide[akLeft].Control := FrameColorBox;
|
||||
FrameEdgesBox.AnchorSide[akLeft].Side := asrTop;
|
||||
FrameEdgesBox.BorderSpacing.Top := 3;
|
||||
FrameEdgesBox.BorderSpacing.Left := 0;
|
||||
MarkupFoldColorBox.AnchorSide[akTop].Control := FrameEdgesBox;
|
||||
FrameEdgesBox.Parent := pnlFrameHost2;
|
||||
FrameStyleBox.Parent := pnlFrameHost2;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -432,37 +482,14 @@ end;
|
||||
|
||||
procedure TSynColorAttrEditor.pnlElementAttributesResize(Sender: TObject);
|
||||
var
|
||||
MinAnchor: TControl;
|
||||
MinWidth: Integer;
|
||||
S: TSpinEdit;
|
||||
|
||||
procedure CheckControl(Other: TControl);
|
||||
var w,h: Integer;
|
||||
begin
|
||||
if not Other.Visible then exit;
|
||||
h:=0;
|
||||
w:=0;
|
||||
Other.GetPreferredSize(w,h);
|
||||
if w <= MinWidth then exit;
|
||||
MinAnchor := Other;
|
||||
MinWidth := w;
|
||||
end;
|
||||
EdCustWidth: Integer;
|
||||
begin
|
||||
MinWidth := -1;
|
||||
MinAnchor := ForeGroundLabel;
|
||||
CheckControl(ForeGroundLabel);
|
||||
CheckControl(BackGroundLabel);
|
||||
CheckControl(ForeGroundUseDefaultCheckBox);
|
||||
CheckControl(BackGroundUseDefaultCheckBox);
|
||||
CheckControl(FrameColorUseDefaultCheckBox);
|
||||
CheckControl(MarkupFoldColorUseDefaultCheckBox);
|
||||
EdCustWidth := 0;
|
||||
if edCustomWord.Visible then
|
||||
EdCustWidth := edCustomWord.Width;
|
||||
|
||||
ColumnPosBevel.AnchorSide[akLeft].Control := MinAnchor;
|
||||
Constraints.MinHeight := lblInfo.Top + lblInfo.Height;
|
||||
S := BackPriorSpin;
|
||||
if not S.Visible then
|
||||
S := BackAlphaSpin;
|
||||
Constraints.MinWidth := S.Left + S.Width;
|
||||
//Constraints.MinHeight := lblInfo.Top + lblInfo.Height;
|
||||
Constraints.MinWidth := Panel1.Width + EdCustWidth - pnlFrameHost1.Width + 15;
|
||||
end;
|
||||
|
||||
procedure TSynColorAttrEditor.TextStyleRadioOnChange(Sender: TObject);
|
||||
@ -743,12 +770,26 @@ begin
|
||||
TextUnderlineCheckBox.Checked := fsUnderline in FCurHighlightElement.Style;
|
||||
end;
|
||||
|
||||
lblInfo.Visible := False;
|
||||
lblInfo.Caption := '';
|
||||
if IsAhaElement(FCurHighlightElement, ahaCaretColor) then begin
|
||||
lblInfo.Caption := dlgCaretColorInfo;
|
||||
lblInfo.Visible := True;
|
||||
end;
|
||||
|
||||
// custom words
|
||||
lbCustomWords.Visible := hafCustomWords in FCurHighlightElement.Features;
|
||||
edCustomWord.Visible := hafCustomWords in FCurHighlightElement.Features;
|
||||
dropCustomWordKind.Visible := hafCustomWords in FCurHighlightElement.Features;
|
||||
edCustomWord.Text := FCurHighlightElement.CustomWords.Text;
|
||||
|
||||
case FCurHighlightElement.CustomWordTokenKind of
|
||||
tkIdentifier: dropCustomWordKind.ItemIndex := 0;
|
||||
tkKey: dropCustomWordKind.ItemIndex := 1;
|
||||
tkModifier: dropCustomWordKind.ItemIndex := 2;
|
||||
tkNumber: dropCustomWordKind.ItemIndex := 3;
|
||||
tkSymbol: dropCustomWordKind.ItemIndex := 4;
|
||||
end;
|
||||
|
||||
UpdatingColor := False;
|
||||
finally
|
||||
EnableAlign;
|
||||
@ -792,7 +833,6 @@ end;
|
||||
procedure TSynColorAttrEditor.Setup;
|
||||
begin
|
||||
UpdatingColor := False;
|
||||
ColumnPosBevel.Height := 1;
|
||||
ForeGroundLabel.Caption := dlgForecolor;
|
||||
BackGroundLabel.Caption := dlgBackColor;
|
||||
ForeGroundUseDefaultCheckBox.Caption := dlgForecolor;
|
||||
@ -822,11 +862,19 @@ begin
|
||||
TextUnderlineRadioOff.Caption := dlgEdOff;
|
||||
TextUnderlineRadioInvert.Caption := dlgEdInvert;
|
||||
|
||||
Constraints.MinHeight := max(Constraints.MinHeight,
|
||||
pnlUnderline.Top + pnlUnderline.Height +
|
||||
Max(pnlUnderline.BorderSpacing.Around,
|
||||
pnlUnderline.BorderSpacing.Bottom)
|
||||
);
|
||||
lbCustomWords.Caption := dlgMatchWords;
|
||||
dropCustomWordKind.Items.Add(lisCodeToolsOptsIdentifier);
|
||||
dropCustomWordKind.Items.Add(dlgKeyWord);
|
||||
dropCustomWordKind.Items.Add(dlgModifier);
|
||||
dropCustomWordKind.Items.Add(lisCodeToolsOptsNumber);
|
||||
dropCustomWordKind.Items.Add(lisCodeToolsOptsSymbol);
|
||||
dropCustomWordKind.ItemIndex := 0;
|
||||
|
||||
//Constraints.MinHeight := max(Constraints.MinHeight,
|
||||
// pnlUnderline.Top + pnlUnderline.Height +
|
||||
// Max(pnlUnderline.BorderSpacing.Around,
|
||||
// pnlUnderline.BorderSpacing.Bottom)
|
||||
// );
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user