Why Gemfury?
Push, build, and install
RubyGems
npm packages
Python packages
Maven artifacts
PHP packages
Go Modules
Debian packages
RPM packages
NuGet packages
Repository URL to install this package:
|
Version:
1.6 ▾
|
{-------------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: SynEditHighlighter.pas, released 2000-04-07.
The Original Code is based on mwHighlighter.pas by Martin Waldenburg, part of
the mwEdit component suite.
Portions created by Martin Waldenburg are Copyright (C) 1998 Martin Waldenburg.
All Rights Reserved.
Contributors to the SynEdit and mwEdit projects are listed in the
Contributors.txt file.
$Id: synedithighlighter.pp 51002 2015-12-23 07:44:39Z ondrej $
You may retrieve the latest version of this file at the SynEdit home page,
located at http://SynEdit.SourceForge.net
Known Issues:
-------------------------------------------------------------------------------}
unit SynEditHighlighter;
{$I synedit.inc}
interface
uses
SysUtils, Classes,
Graphics, LazUTF8, LCLProc, LCLIntf, LCLType, Registry, IniFiles,
SynEditTypes, SynEditTextBase;
type
{ TSynHighlighterRangeList }
TSynHighlighterRangeList = class(TSynManagedStorageMem)
private
FRefCount: Integer;
FNeedsReScanStartIndex: Integer;
FNeedsReScanEndIndex: Integer;
FNeedsReScanRealStartIndex: Integer;
function GetNeedsReScanRealStartIndex: Integer;
function GetRange(Index: Integer): Pointer;
procedure SetRange(Index: Integer; const AValue: Pointer);
protected
procedure LineTextChanged(AIndex: Integer; ACount: Integer = 1); override;
procedure InsertedLines(AIndex, ACount: Integer); override;
procedure DeletedLines(AIndex, ACount: Integer); override;
public
constructor Create;
procedure ClearReScanNeeded;
procedure AdjustReScanStart(ANewStart: Integer);
procedure InvalidateAll;
procedure IncRefCount;
procedure DecRefCount;
property Range[Index: Integer]: Pointer read GetRange write SetRange; default;
property RefCount: Integer read FRefCount;
property NeedsReScanStartIndex: Integer read FNeedsReScanStartIndex;
property NeedsReScanEndIndex: Integer read FNeedsReScanEndIndex;
property NeedsReScanRealStartIndex: Integer read GetNeedsReScanRealStartIndex;
end;
{ TLazSynCustomTextAttributes }
TLazSynCustomTextAttributes = class(TPersistent)
{strict} private
FUpdateCount: Integer;
FWasChanged: Boolean;
FBackground: TColor;
FForeground: TColor;
FFrameColor: TColor;
FFrameEdges: TSynFrameEdges;
FFrameStyle: TSynLineStyle;
fStyle: TFontStyles;
fStyleMask: TFontStyles;
procedure SetBackground(AValue: TColor);
procedure SetForeground(AValue: TColor);
procedure SetFrameColor(AValue: TColor);
procedure SetFrameEdges(AValue: TSynFrameEdges);
procedure SetFrameStyle(AValue: TSynLineStyle);
procedure SetStyle(AValue: TFontStyles);
procedure SetStyleMask(AValue: TFontStyles);
protected
procedure AssignFrom(Src: TLazSynCustomTextAttributes); virtual;
procedure DoClear; virtual;
procedure Changed;
procedure DoChange; virtual;
procedure Init; virtual;
public
constructor Create;
procedure Clear;
procedure Assign(aSource: TPersistent); override;
procedure BeginUpdate;
procedure EndUpdate;
public
property Background: TColor read FBackground write SetBackground;
property Foreground: TColor read FForeground write SetForeground;
property FrameColor: TColor read FFrameColor write SetFrameColor;
property FrameStyle: TSynLineStyle read FFrameStyle write SetFrameStyle;
property FrameEdges: TSynFrameEdges read FFrameEdges write SetFrameEdges;
property Style: TFontStyles read fStyle write SetStyle;
property StyleMask: TFontStyles read fStyleMask write SetStyleMask;
end;
{ TSynHighlighterAttributes }
TSynHighlighterAttributes = class(TLazSynCustomTextAttributes)
private
FBackgroundDefault: TColor;
FForegroundDefault: TColor;
FFrameColorDefault: TColor;
FFrameEdgesDefault: TSynFrameEdges;
FFrameStyleDefault: TSynLineStyle;
FStyleDefault: TFontStyles;
FStyleMaskDefault: TFontStyles;
FStoredName: string;
FConstName: string;
FCaption: PString;
FOnChange: TNotifyEvent;
function GetBackgroundColorStored: boolean;
function GetFontStyleMaskStored : boolean;
function GetForegroundColorStored: boolean;
function GetFrameColorStored: boolean;
function GetFrameEdgesStored: boolean;
function GetFrameStyleStored: boolean;
function GetStyleFromInt: integer;
procedure SetStyleFromInt(const Value: integer);
function GetFontStyleStored: boolean;
function GetStyleMaskFromInt : integer;
procedure SetStyleMaskFromInt(const Value : integer);
protected
procedure AssignFrom(Src: TLazSynCustomTextAttributes); override;
procedure DoChange; override;
public
constructor Create;
constructor Create(aCaption: string; aStoredName: String = '');
constructor Create(aCaption: PString; aStoredName: String = '');
procedure InternalSaveDefaultValues; virtual;
function LoadFromBorlandRegistry(rootKey: HKEY; attrKey, attrName: string;
oldStyle: boolean): boolean; virtual;
function LoadFromRegistry(Reg: TRegistry): boolean;
function SaveToRegistry(Reg: TRegistry): boolean;
function LoadFromFile(Ini : TIniFile): boolean;
function SaveToFile(Ini : TIniFile): boolean;
public
property IntegerStyle: integer read GetStyleFromInt write SetStyleFromInt;
property IntegerStyleMask: integer read GetStyleMaskFromInt write SetStyleMaskFromInt;
property Name: string read FConstName; // value of Caption at creation, use Caption instead, kept for compatibility
property Caption: PString read FCaption; // is never nil
property StoredName: string read FStoredName write FStoredName; // the identifier
property OnChange: TNotifyEvent read fOnChange write fOnChange;
published
property Background stored GetBackgroundColorStored;
property Foreground stored GetForegroundColorStored;
property FrameColor stored GetFrameColorStored;
property FrameStyle stored GetFrameStyleStored;
property FrameEdges stored GetFrameEdgesStored;
property Style stored GetFontStyleStored;
// TODO: StyleMask move to TSynHighlighterAttributesModifier
property StyleMask stored GetFontStyleMaskStored;
// FStyle = [], FStyleMask = [] ==> no modification
// FStyle = [fsBold], FStyleMask = [] ==> invert fsBold
// FStyle = [], FStyleMask = [fsBold] ==> clear fsBold
// FStyle = [fsBold], FStyleMask = [fsBold] ==> set fsBold
end;
{ TSynHighlighterAttributesModifier }
TSynHighlighterAttributesModifier = class(TSynHighlighterAttributes)
private
FBackAlpha: byte;
FForeAlpha: byte;
FFrameAlpha: byte;
FBackPriority: integer;
FForePriority: integer;
FFramePriority: integer;
FStylePriority: Array [TFontStyle] of integer;
FBackAlphaDefault: byte;
FForeAlphaDefault: byte;
FFrameAlphaDefault: byte;
FBackPriorityDefault: integer;
FForePriorityDefault: integer;
FFramePriorityDefault: integer;
FStylePriorityDefault: Array [TFontStyle] of integer;
function GetBackAlphaStored: Boolean;
function GetBackPriorityStored: Boolean;
function GetForeAlphaStored: Boolean;
function GetForePriorityStored: Boolean;
function GetFrameAlphaStored: Boolean;
function GetFramePriorityStored: Boolean;
function GetStylePriorityStored(Index: TFontStyle): Boolean;
function GetStylePriority(Index: TFontStyle): integer;
procedure SetBackAlpha(AValue: byte);
procedure SetBackPriority(AValue: integer);
procedure SetForeAlpha(AValue: byte);
procedure SetForePriority(AValue: integer);
procedure SetFrameAlpha(AValue: byte);
procedure SetFramePriority(AValue: integer);
procedure SetStylePriority(Index: TFontStyle; AValue: integer);
protected
procedure AssignFrom(Src: TLazSynCustomTextAttributes); override;
procedure DoClear; override;
procedure InitPriorities;
public
procedure InternalSaveDefaultValues; override;
procedure SetAllPriorities(APriority: integer);
property StylePriority[Index: TFontStyle]: integer read GetStylePriority write SetStylePriority;
published
property BackPriority: integer read FBackPriority write SetBackPriority stored GetBackPriorityStored;
property ForePriority: integer read FForePriority write SetForePriority stored GetForePriorityStored;
property FramePriority: integer read FFramePriority write SetFramePriority stored GetFramePriorityStored;
property BoldPriority: integer index fsBold read GetStylePriority write SetStylePriority stored GetStylePriorityStored;
property ItalicPriority: integer index fsItalic read GetStylePriority write SetStylePriority stored GetStylePriorityStored;
property UnderlinePriority: integer index fsUnderline read GetStylePriority write SetStylePriority stored GetStylePriorityStored;
property StrikeOutPriority: integer index fsStrikeOut read GetStylePriority write SetStylePriority stored GetStylePriorityStored;
// Alpha = 0 means solid // 1..255 means n of 256
property BackAlpha: byte read FBackAlpha write SetBackAlpha stored GetBackAlphaStored;
property ForeAlpha: byte read FForeAlpha write SetForeAlpha stored GetForeAlphaStored;
property FrameAlpha: byte read FFrameAlpha write SetFrameAlpha stored GetFrameAlphaStored;
end;
TSynHighlighterCapability = (
hcUserSettings, // supports Enum/UseUserSettings
hcRegistry, // supports LoadFrom/SaveToRegistry
hcCodeFolding
);
TSynHighlighterCapabilities = set of TSynHighlighterCapability;
const
{ EXPERIMENTAL: A list of some typical attributes.
This may be returned by a Highlighter via GetDefaultAttribute. Implementation
is optional for each HL. So a HL may return nil even if it has an attribute
of the requested type.
This list does *not* aim to be complete. It may be replaced in future.
}
SYN_ATTR_COMMENT = 0;
SYN_ATTR_IDENTIFIER = 1;
SYN_ATTR_KEYWORD = 2;
SYN_ATTR_STRING = 3;
SYN_ATTR_WHITESPACE = 4;
SYN_ATTR_SYMBOL = 5;
SYN_ATTR_NUMBER = 6;
SYN_ATTR_DIRECTIVE = 7;
SYN_ATTR_ASM = 8;
SYN_ATTR_VARIABLE = 9;
type
TSynDividerDrawConfigSetting = Record
Color: TColor;
end;
const
SynEmptyDividerDrawConfigSetting: TSynDividerDrawConfigSetting =
( Color: clNone );
type
{ TSynDividerDrawConfig }
TSynDividerDrawConfig = class
private
FDepth: Integer;
FTopSetting, FNestSetting: TSynDividerDrawConfigSetting;
fOnChange: TNotifyEvent;
function GetNestColor: TColor; virtual;
function GetTopColor: TColor; virtual;
procedure SetNestColor(const AValue: TColor); virtual;
procedure SetTopColor(const AValue: TColor); virtual;
protected
function GetMaxDrawDepth: Integer; virtual;
procedure SetMaxDrawDepth(AValue: Integer); virtual;
procedure Changed;
public
// Do not use to set values, or you skip the change notification
property TopSetting: TSynDividerDrawConfigSetting read FTopSetting;
property NestSetting: TSynDividerDrawConfigSetting read FNestSetting;
public
constructor Create;
procedure Assign(Src: TSynDividerDrawConfig); virtual;
property MaxDrawDepth: Integer read GetMaxDrawDepth write SetMaxDrawDepth;
property TopColor: TColor read GetTopColor write SetTopColor;
property NestColor: TColor read GetNestColor write SetNestColor;
property OnChange: TNotifyEvent read fOnChange write fOnChange;
end;
{ TSynEditLinesList }
TSynEditLinesList=class(TFPList)
private
function GetSynString(Index: Integer): TSynEditStringsBase;
procedure PutSynStrings(Index: Integer; const AValue: TSynEditStringsBase);
public
property Items[Index: Integer]: TSynEditStringsBase
read GetSynString write PutSynStrings; default;
end;
{ TSynCustomHighlighter }
TSynCustomHighlighter = class(TComponent)
private
fAttributes: TStringList;
fAttrChangeHooks: TMethodList;
FCapabilities: TSynHighlighterCapabilities;
FKnownLines: TSynEditLinesList;
FCurrentLines: TSynEditStringsBase;
FCurrentRanges: TSynHighlighterRangeList;
FDrawDividerLevel: Integer;
FLineIndex: Integer;
FLineText: String;
fUpdateCount: integer; //mh 2001-09-13
fEnabled: Boolean;
fWordBreakChars: TSynIdentChars;
FIsScanning: Boolean;
function GetKnownRanges(Index: Integer): TSynHighlighterRangeList;
procedure SetDrawDividerLevel(const AValue: Integer); deprecated;
procedure SetEnabled(const Value: boolean); //DDH 2001-10-23
protected
FAttributeChangeNeedScan: Boolean;
fDefaultFilter: string;
fUpdateChange: boolean; //mh 2001-09-13
FIsInNextToEOL: Boolean;
procedure AddAttribute(AAttrib: TSynHighlighterAttributes);
procedure FreeHighlighterAttributes; //mh 2001-09-13
function GetAttribCount: integer; virtual;
function GetAttribute(idx: integer): TSynHighlighterAttributes; virtual;
function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
virtual; abstract;
function GetDefaultFilter: string; virtual;
function GetIdentChars: TSynIdentChars; virtual;
procedure SetWordBreakChars(AChars: TSynIdentChars); virtual;
function GetSampleSource: string; virtual;
function IsFilterStored: boolean; virtual;
procedure SetAttributesOnChange(AEvent: TNotifyEvent);
procedure SetDefaultFilter(Value: string); virtual;
procedure SetSampleSource(Value: string); virtual;
function GetRangeIdentifier: Pointer; virtual;
function CreateRangeList(ALines: TSynEditStringsBase): TSynHighlighterRangeList; virtual;
procedure AfterAttachedToRangeList(ARangeList: TSynHighlighterRangeList); virtual;
procedure BeforeDetachedFromRangeList(ARangeList: TSynHighlighterRangeList); virtual;
function UpdateRangeInfoAtLine(Index: Integer): Boolean; virtual; // Returns true if range changed
// code fold - only valid if hcCodeFolding in Capabilities
procedure SetCurrentLines(const AValue: TSynEditStringsBase); virtual; // todo remove virtual
procedure DoCurrentLinesChanged; virtual;
property LineIndex: Integer read FLineIndex;
property CurrentRanges: TSynHighlighterRangeList read FCurrentRanges;
function GetDrawDivider(Index: integer): TSynDividerDrawConfigSetting; virtual;
function GetDividerDrawConfig(Index: Integer): TSynDividerDrawConfig; virtual;
function GetDividerDrawConfigCount: Integer; virtual;
function PerformScan(StartIndex, EndIndex: Integer; ForceEndIndex: Boolean = False): Integer; virtual;
property IsScanning: Boolean read FIsScanning;
property KnownRanges[Index: Integer]: TSynHighlighterRangeList read GetKnownRanges;
property KnownLines: TSynEditLinesList read FKnownLines;
public
procedure DefHighlightChange(Sender: TObject);
property AttributeChangeNeedScan: Boolean read FAttributeChangeNeedScan;
class function GetCapabilities: TSynHighlighterCapabilities; virtual;
class function GetLanguageName: string; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function AddSpecialAttribute(const aCaption: string;
const aStoredName: String = ''): TSynHighlighterAttributes;
function AddSpecialAttribute(const aCaption: PString;
const aStoredName: String = ''): TSynHighlighterAttributes;
procedure Assign(Source: TPersistent); override;
procedure BeginUpdate;
procedure EndUpdate;
procedure AttachToLines(Lines: TSynEditStringsBase);
procedure DetachFromLines(Lines: TSynEditStringsBase);
public
function GetEol: Boolean; virtual; abstract;
function GetRange: Pointer; virtual;
function GetToken: String; virtual; abstract;
procedure GetTokenEx(out TokenStart: PChar; out TokenLength: integer); virtual; abstract;
function GetEndOfLineAttribute: TSynHighlighterAttributes; virtual; // valid after line was scanned to EOL
function GetTokenAttribute: TSynHighlighterAttributes; virtual; abstract;
function GetTokenKind: integer; virtual; abstract;
function GetTokenPos: Integer; virtual; abstract; // 0-based
function IsKeyword(const AKeyword: string): boolean; virtual; // DJLP 2000-08-09
procedure Next; virtual; abstract;
procedure NextToEol;
property DrawDivider[Index: integer]: TSynDividerDrawConfigSetting
read GetDrawDivider;
property DrawDividerLevel: Integer read FDrawDividerLevel write SetDrawDividerLevel; deprecated;
public
property CurrentLines: TSynEditStringsBase read FCurrentLines write SetCurrentLines;
procedure StartAtLineIndex(LineNumber:Integer); virtual; // 0 based
procedure ContinueNextLine; // To be called at EOL; does not read the range
procedure ScanRanges;
function IdleScanRanges: Boolean; // Scan little by little during OnIdle; Return True, if more work avail
function NeedScan: Boolean;
procedure ScanAllRanges;
procedure SetRange(Value: Pointer); virtual;
procedure ResetRange; virtual;
procedure SetLine(const NewValue: String;
LineNumber:Integer // 0 based
); virtual;
public
function UseUserSettings(settingIndex: integer): boolean; virtual;
procedure EnumUserSettings(Settings: TStrings); virtual;
function LoadFromRegistry(RootKey: HKEY; Key: string): boolean; virtual;
function SaveToRegistry(RootKey: HKEY; Key: string): boolean; virtual;
function LoadFromFile(AFileName: String): boolean; //DDH 10/16/01
function SaveToFile(AFileName: String): boolean; //DDH 10/16/01
procedure HookAttrChangeEvent(ANotifyEvent: TNotifyEvent);
procedure UnhookAttrChangeEvent(ANotifyEvent: TNotifyEvent);
property IdentChars: TSynIdentChars read GetIdentChars;
property WordBreakChars: TSynIdentChars read fWordBreakChars write SetWordBreakChars;
property LanguageName: string read GetLanguageName;
public
property AttrCount: integer read GetAttribCount;
property Attribute[idx: integer]: TSynHighlighterAttributes
read GetAttribute;
property Capabilities: TSynHighlighterCapabilities
read FCapabilities;
property SampleSource: string read GetSampleSource write SetSampleSource;
// The below should be depricated and moved to those HL that actually implement them.
property CommentAttribute: TSynHighlighterAttributes
index SYN_ATTR_COMMENT read GetDefaultAttribute;
property IdentifierAttribute: TSynHighlighterAttributes
index SYN_ATTR_IDENTIFIER read GetDefaultAttribute;
property KeywordAttribute: TSynHighlighterAttributes
index SYN_ATTR_KEYWORD read GetDefaultAttribute;
property StringAttribute: TSynHighlighterAttributes
index SYN_ATTR_STRING read GetDefaultAttribute;
property SymbolAttribute: TSynHighlighterAttributes //mh 2001-09-13
index SYN_ATTR_SYMBOL read GetDefaultAttribute;
property WhitespaceAttribute: TSynHighlighterAttributes
index SYN_ATTR_WHITESPACE read GetDefaultAttribute;
property DividerDrawConfig[Index: Integer]: TSynDividerDrawConfig
read GetDividerDrawConfig;
property DividerDrawConfigCount: Integer read GetDividerDrawConfigCount;
published
property DefaultFilter: string read GetDefaultFilter write SetDefaultFilter
stored IsFilterStored;
property Enabled: boolean read fEnabled write SetEnabled default TRUE; //DDH 2001-10-23
end;
TSynCustomHighlighterClass = class of TSynCustomHighlighter;
TSynHighlighterList = class(TList)
private
hlList: TList;
function GetItem(idx: integer): TSynCustomHighlighterClass;
public
constructor Create;
destructor Destroy; override;
function Count: integer;
function FindByName(name: string): integer;
function FindByClass(comp: TComponent): integer;
property Items[idx: integer]: TSynCustomHighlighterClass
read GetItem; default;
end;
procedure RegisterPlaceableHighlighter(highlighter: TSynCustomHighlighterClass);
function GetPlaceableHighlighters: TSynHighlighterList;
implementation
const
IDLE_SCAN_CHUNK_SIZE = 2500;
{ TSynHighlighterAttributesModifier }
function TSynHighlighterAttributesModifier.GetStylePriority(Index: TFontStyle): integer;
begin
Result := FStylePriority[Index];
end;
procedure TSynHighlighterAttributesModifier.SetBackAlpha(AValue: byte);
begin
if FBackAlpha = AValue then Exit;
FBackAlpha := AValue;
Changed;
end;
function TSynHighlighterAttributesModifier.GetBackPriorityStored: Boolean;
begin
Result := FBackPriority <> FBackPriorityDefault;
end;
function TSynHighlighterAttributesModifier.GetBackAlphaStored: Boolean;
begin
Result := FBackAlpha <> FBackAlphaDefault;
end;
function TSynHighlighterAttributesModifier.GetForeAlphaStored: Boolean;
begin
Result := FForeAlpha <> FForeAlphaDefault;
end;
function TSynHighlighterAttributesModifier.GetForePriorityStored: Boolean;
begin
Result := FForePriority <> FForePriorityDefault;
end;
function TSynHighlighterAttributesModifier.GetFrameAlphaStored: Boolean;
begin
Result := FFrameAlpha <> FForeAlphaDefault;
end;
function TSynHighlighterAttributesModifier.GetFramePriorityStored: Boolean;
begin
Result := FFramePriority <> FFramePriorityDefault;
end;
function TSynHighlighterAttributesModifier.GetStylePriorityStored(Index: TFontStyle): Boolean;
begin
Result := FStylePriority[Index] <> FStylePriorityDefault[Index];
end;
procedure TSynHighlighterAttributesModifier.SetBackPriority(AValue: integer);
begin
if FBackPriority = AValue then Exit;
FBackPriority := AValue;
Changed;
end;
procedure TSynHighlighterAttributesModifier.SetForeAlpha(AValue: byte);
begin
if FForeAlpha = AValue then Exit;
FForeAlpha := AValue;
Changed;
end;
procedure TSynHighlighterAttributesModifier.SetForePriority(AValue: integer);
begin
if FForePriority = AValue then Exit;
FForePriority := AValue;
Changed;
end;
procedure TSynHighlighterAttributesModifier.SetFrameAlpha(AValue: byte);
begin
if FFrameAlpha = AValue then Exit;
FFrameAlpha := AValue;
Changed;
end;
procedure TSynHighlighterAttributesModifier.SetFramePriority(AValue: integer);
begin
if FFramePriority = AValue then Exit;
FFramePriority := AValue;
Changed;
end;
procedure TSynHighlighterAttributesModifier.SetStylePriority(Index: TFontStyle;
AValue: integer);
begin
if FStylePriority[Index] = AValue then Exit;
FStylePriority[Index] := AValue;
Changed;
end;
procedure TSynHighlighterAttributesModifier.AssignFrom(Src: TLazSynCustomTextAttributes);
var
Source: TSynHighlighterAttributesModifier;
begin
inherited AssignFrom(Src);
if Src is TSynHighlighterAttributesModifier then begin
Source := TSynHighlighterAttributesModifier(Src);
ForePriority := Source.ForePriority;
BackPriority := Source.BackPriority;
FramePriority := Source.FramePriority;
FStylePriority := Source.FStylePriority;
FBackAlpha := Source.BackAlpha;
FForeAlpha := Source.ForeAlpha;
FFrameAlpha := Source.FrameAlpha;
end
else begin
InitPriorities;
FBackAlpha := 0;
FForeAlpha := 0;
FFrameAlpha := 0;
end;
end;
procedure TSynHighlighterAttributesModifier.DoClear;
begin
inherited DoClear;
InitPriorities;
FBackAlpha := 0;
FForeAlpha := 0;
FFrameAlpha := 0;
end;
procedure TSynHighlighterAttributesModifier.InitPriorities;
var
i: TFontStyle;
begin
BeginUpdate;
ForePriority := 0;
BackPriority := 0;
FramePriority := 0;
for i := Low(TFontStyle) to High(TFontStyle) do
FStylePriority[i] := 0;
EndUpdate;
end;
procedure TSynHighlighterAttributesModifier.InternalSaveDefaultValues;
begin
inherited InternalSaveDefaultValues;
FBackPriorityDefault := FBackPriority;
FForePriorityDefault := FForePriority;
FFramePriorityDefault := FFramePriority;
FForeAlphaDefault := FForeAlpha;
FBackAlphaDefault := FBackAlpha;
FFrameAlphaDefault := FFrameAlpha;
FStylePriorityDefault := FStylePriority;
end;
procedure TSynHighlighterAttributesModifier.SetAllPriorities(APriority: integer);
var
i: TFontStyle;
begin
BeginUpdate;
ForePriority := APriority;
BackPriority := APriority;
FramePriority := APriority;
for i := Low(TFontStyle) to High(TFontStyle) do
FStylePriority[i] := APriority;
EndUpdate;
end;
{$IFDEF _Gp_MustEnhanceRegistry}
function IsRelative(const Value: string): Boolean;
begin
Result := not ((Value <> '') and (Value[1] = '\'));
end;
function TBetterRegistry.OpenKeyReadOnly(const Key: string): Boolean;
var
TempKey: HKey;
S: string;
Relative: Boolean;
begin
S := Key;
Relative := IsRelative(S);
if not Relative then Delete(S, 1, 1);
TempKey := 0;
Result := RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0,
KEY_READ, TempKey) = ERROR_SUCCESS;
if Result then
begin
if (CurrentKey <> 0) and Relative then S := CurrentPath + '\' + S;
ChangeKey(TempKey, S);
end;
end; { TBetterRegistry.OpenKeyReadOnly }
{$ENDIF _Gp_MustEnhanceRegistry}
{ THighlighterList }
function TSynHighlighterList.Count: integer;
begin
Result := hlList.Count;
end;
constructor TSynHighlighterList.Create;
begin
inherited Create;
hlList := TList.Create;
end;
destructor TSynHighlighterList.Destroy;
begin
hlList.Free;
inherited;
end;
function TSynHighlighterList.FindByClass(comp: TComponent): integer;
var
i: integer;
begin
Result := -1;
for i := 0 to Count-1 do begin
if comp is Items[i] then begin
Result := i;
Exit;
end;
end; //for
end;
function TSynHighlighterList.FindByName(name: string): integer;
var
i: integer;
begin
Result := -1;
for i := 0 to Count-1 do begin
if Items[i].GetLanguageName = name then begin
Result := i;
Exit;
end;
end; //for
end;
function TSynHighlighterList.GetItem(idx: integer): TSynCustomHighlighterClass;
begin
Result := TSynCustomHighlighterClass(hlList[idx]);
end;
var
G_PlaceableHighlighters: TSynHighlighterList;
function GetPlaceableHighlighters: TSynHighlighterList;
begin
Result := G_PlaceableHighlighters;
end;
procedure RegisterPlaceableHighlighter(highlighter: TSynCustomHighlighterClass);
begin
if G_PlaceableHighlighters.hlList.IndexOf(highlighter) < 0 then
G_PlaceableHighlighters.hlList.Add(highlighter);
end;
{ TLazSynCustomTextAttributes }
procedure TLazSynCustomTextAttributes.SetBackground(AValue: TColor);
begin
if FBackground = AValue then Exit;
FBackground := AValue;
Changed;
end;
procedure TLazSynCustomTextAttributes.SetForeground(AValue: TColor);
begin
if FForeground = AValue then Exit;
FForeground := AValue;
Changed;
end;
procedure TLazSynCustomTextAttributes.SetFrameColor(AValue: TColor);
begin
if FFrameColor = AValue then Exit;
FFrameColor := AValue;
Changed;
end;
procedure TLazSynCustomTextAttributes.SetFrameEdges(AValue: TSynFrameEdges);
begin
if FFrameEdges = AValue then Exit;
FFrameEdges := AValue;
Changed;
end;
procedure TLazSynCustomTextAttributes.SetFrameStyle(AValue: TSynLineStyle);
begin
if FFrameStyle = AValue then Exit;
FFrameStyle := AValue;
Changed;
end;
procedure TLazSynCustomTextAttributes.SetStyle(AValue: TFontStyles);
begin
if fStyle = AValue then Exit;
fStyle := AValue;
Changed;
end;
procedure TLazSynCustomTextAttributes.SetStyleMask(AValue: TFontStyles);
begin
if fStyleMask = AValue then Exit;
fStyleMask := AValue;
Changed;
end;
procedure TLazSynCustomTextAttributes.Changed;
begin
FWasChanged := True;
if FUpdateCount > 0 then
exit;
FWasChanged := False;
DoChange;
end;
procedure TLazSynCustomTextAttributes.AssignFrom(Src: TLazSynCustomTextAttributes);
begin
//
end;
procedure TLazSynCustomTextAttributes.DoClear;
begin
Background := clNone;
Foreground := clNone;
FrameColor := clNone;
FrameStyle := slsSolid;
FrameEdges := sfeAround;
Style := [];
StyleMask := [];
end;
procedure TLazSynCustomTextAttributes.DoChange;
begin
//
end;
procedure TLazSynCustomTextAttributes.Init;
begin
// called by create
Clear;
end;
constructor TLazSynCustomTextAttributes.Create;
begin
inherited;
FUpdateCount := 0;
FWasChanged := False;
Init;
end;
procedure TLazSynCustomTextAttributes.Clear;
begin
BeginUpdate;
DoClear;
EndUpdate;
end;
procedure TLazSynCustomTextAttributes.Assign(aSource: TPersistent);
var
Source : TLazSynCustomTextAttributes;
begin
if Assigned(aSource) and (aSource is TLazSynCustomTextAttributes) then
begin
BeginUpdate;
Source := TLazSynCustomTextAttributes(aSource);
Foreground := Source.Foreground;
Background := Source.Background;
FrameColor := Source.FrameColor;
FrameStyle := Source.FrameStyle;
FrameEdges := Source.FrameEdges;
Style := Source.FStyle;
StyleMask := Source.FStyleMask;
AssignFrom(Source);
EndUpdate;
end
else
inherited;
end;
procedure TLazSynCustomTextAttributes.BeginUpdate;
begin
inc(FUpdateCount);
end;
procedure TLazSynCustomTextAttributes.EndUpdate;
begin
dec(FUpdateCount);
if (FUpdateCount = 0) and FWasChanged then
Changed;
end;
{ TSynHighlighterAttributes }
constructor TSynHighlighterAttributes.Create(aCaption: string;
aStoredName: String = '');
begin
Create;
FConstName := aCaption;
FCaption := @FConstName;
if aStoredName = '' then
aStoredName := FConstName;
FStoredName := aStoredName;;
end;
constructor TSynHighlighterAttributes.Create(aCaption: PString;
aStoredName: String);
begin
Create;
if aCaption<>nil then begin
FConstName := aCaption^;
FCaption := aCaption;
end
else begin
FConstName := '';
FCaption := @FConstName;
end;
if aStoredName = '' then
aStoredName := FConstName;
FStoredName := aStoredName;;
end;
function TSynHighlighterAttributes.GetBackgroundColorStored: boolean;
begin
Result := Background <> fBackgroundDefault;
end;
function TSynHighlighterAttributes.GetFontStyleMaskStored : boolean;
begin
Result := StyleMask <> fStyleMaskDefault;
end;
function TSynHighlighterAttributes.GetForegroundColorStored: boolean;
begin
Result := Foreground <> fForegroundDefault;
end;
function TSynHighlighterAttributes.GetFrameColorStored: boolean;
begin
Result := FrameColor <> FFrameColorDefault;
end;
function TSynHighlighterAttributes.GetFrameEdgesStored: boolean;
begin
Result := FrameEdges <> FFrameEdgesDefault;
end;
function TSynHighlighterAttributes.GetFrameStyleStored: boolean;
begin
Result := FrameStyle <> FFrameStyleDefault;
end;
function TSynHighlighterAttributes.GetFontStyleStored: boolean;
begin
Result := Style <> fStyleDefault;
end;
procedure TSynHighlighterAttributes.InternalSaveDefaultValues;
(* Called once from TSynCustomHighlighter.Create (and only from there),
after all Attributes where created *)
begin
fForegroundDefault := Foreground;
fBackgroundDefault := Background;
FFrameColorDefault := FrameColor;
FFrameStyleDefault := FrameStyle;
FFrameEdgesDefault := FrameEdges;
fStyleDefault := Style;
fStyleMaskDefault := StyleMask;
end;
function TSynHighlighterAttributes.LoadFromBorlandRegistry(rootKey: HKEY;
attrKey, attrName: string; oldStyle: boolean): boolean;
// How the highlighting information is stored:
// Delphi 1.0:
// I don't know and I don't care.
// Delphi 2.0 & 3.0:
// In the registry branch HKCU\Software\Borland\Delphi\x.0\Highlight
// where x=2 or x=3.
// Each entry is one string value, encoded as
// <foreground RGB>,<background RGB>,<font style>,<default fg>,<default Background>,<fg index>,<Background index>
// Example:
// 0,16777215,BI,0,1,0,15
// foreground color (RGB): 0
// background color (RGB): 16777215 ($FFFFFF)
// font style: BI (bold italic), possible flags: B(old), I(talic), U(nderline)
// default foreground: no, specified color will be used (black (0) is used when this flag is 1)
// default background: yes, white ($FFFFFF, 15) will be used for background
// foreground index: 0 (foreground index (Pal16), corresponds to foreground RGB color)
// background index: 15 (background index (Pal16), corresponds to background RGB color)
// Delphi 4.0 & 5.0:
// In the registry branch HKCU\Software\Borland\Delphi\4.0\Editor\Highlight.
// Each entry is subkey containing several values:
// Foreground Color: foreground index (Pal16), 0..15 (dword)
// Background Color: background index (Pal16), 0..15 (dword)
// Bold: fsBold yes/no, 0/True (string)
// Italic: fsItalic yes/no, 0/True (string)
// Underline: fsUnderline yes/no, 0/True (string)
// Default Foreground: use default foreground (clBlack) yes/no, False/-1 (string)
// Default Background: use default backround (clWhite) yes/no, False/-1 (string)
{$IFNDEF SYN_LAZARUS}
const
Pal16: array [0..15] of TColor = (clBlack, clMaroon, clGreen, clOlive,
clNavy, clPurple, clTeal, clLtGray, clDkGray, clRed, clLime,
clYellow, clBlue, clFuchsia, clAqua, clWhite);
{$ENDIF}
function LoadOldStyle(rootKey: HKEY; attrKey, attrName: string): boolean;
var
{$IFNDEF SYN_LAZARUS}
descript : string;
//fgColRGB : string;
//bgColRGB : string;
fontStyle: string;
fgDefault: string;
bgDefault: string;
fgIndex16: string;
bgIndex16: string;
{$ENDIF}
reg : TRegistry;
function Get(var name: string): string;
var
p: integer;
begin
p := Pos(',',name);
if p = 0 then p := Length(name)+1;
Result := Copy(name,1,p-1);
name := Copy(name,p+1,Length(name)-p);
end; { Get }
begin { LoadOldStyle }
Result := false;
try
reg := TRegistry.Create;
reg.RootKey := rootKey;
try
with reg do begin
{$IFNDEF SYN_LAZARUS}
// ToDo Registry
if OpenKeyReadOnly(attrKey) then begin
try
if ValueExists(attrName) then begin
descript := ReadString(attrName);
//fgColRGB := Get(descript);
//bgColRGB := Get(descript);
fontStyle := Get(descript);
fgDefault := Get(descript);
bgDefault := Get(descript);
fgIndex16 := Get(descript);
bgIndex16 := Get(descript);
if bgDefault = '1'
then Background := clWindow
else Background := Pal16[StrToInt(bgIndex16)];
if fgDefault = '1'
then Foreground := clWindowText
else Foreground := Pal16[StrToInt(fgIndex16)];
Style := [];
if Pos('B',fontStyle) > 0 then Style := Style + [fsBold];
if Pos('I',fontStyle) > 0 then Style := Style + [fsItalic];
if Pos('U',fontStyle) > 0 then Style := Style + [fsUnderline];
Result := true;
end;
finally CloseKey; end;
end; // if
{$ENDIF}
end; // with
finally reg.Free; end;
except end;
end; { LoadOldStyle }
function LoadNewStyle(rootKey: HKEY; attrKey, attrName: string): boolean;
var
{$IFNDEF SYN_LAZARUS}
fgIndex16 : DWORD;
bgIndex16 : DWORD;
fontBold : string;
fontItalic : string;
fontUnderline: string;
fgDefault : string;
bgDefault : string;
{$ENDIF}
reg : TRegistry;
function IsTrue(value: string): boolean;
begin
Result := not ((UpperCase(value) = 'FALSE') or (value = '0'));
end; { IsTrue }
begin
Result := false;
try
reg := TRegistry.Create;
reg.RootKey := rootKey;
try
with reg do begin
{$IFNDEF SYN_LAZARUS}
// ToDo Registry
if OpenKeyReadOnly(attrKey+'\'+attrName) then begin
try
if ValueExists('Foreground Color')
then fgIndex16 := ReadInteger('Foreground Color')
else Exit;
if ValueExists('Background Color')
then bgIndex16 := ReadInteger('Background Color')
else Exit;
if ValueExists('Bold')
then fontBold := ReadString('Bold')
else Exit;
if ValueExists('Italic')
then fontItalic := ReadString('Italic')
else Exit;
if ValueExists('Underline')
then fontUnderline := ReadString('Underline')
else Exit;
if ValueExists('Default Foreground')
then fgDefault := ReadString('Default Foreground')
else Exit;
if ValueExists('Default Background')
then bgDefault := ReadString('Default Background')
else Exit;
if IsTrue(bgDefault)
then Background := clWindow
else Background := Pal16[bgIndex16];
if IsTrue(fgDefault)
then Foreground := clWindowText
else Foreground := Pal16[fgIndex16];
Style := [];
if IsTrue(fontBold) then Style := Style + [fsBold];
if IsTrue(fontItalic) then Style := Style + [fsItalic];
if IsTrue(fontUnderline) then Style := Style + [fsUnderline];
Result := true;
finally CloseKey; end;
end; // if
{$ENDIF}
end; // with
finally reg.Free; end;
except end;
end; { LoadNewStyle }
begin
if oldStyle then Result := LoadOldStyle(rootKey, attrKey, attrName)
else Result := LoadNewStyle(rootKey, attrKey, attrName);
end; { TSynHighlighterAttributes.LoadFromBorlandRegistry }
function TSynHighlighterAttributes.LoadFromRegistry(Reg: TRegistry): boolean;
{$IFNDEF SYN_LAZARUS}
var
key: string;
{$ENDIF}
begin
{$IFNDEF SYN_LAZARUS}
// ToDo Registry
key := Reg.CurrentPath;
if Reg.OpenKeyReadOnly(StoredName) then begin
if Reg.ValueExists('Background') then
Background := Reg.ReadInteger('Background');
if Reg.ValueExists('Foreground') then
Foreground := Reg.ReadInteger('Foreground');
if Reg.ValueExists('Style') then
IntegerStyle := Reg.ReadInteger('Style');
if Reg.ValueExists('StyleMask') then
IntegerStyle := Reg.ReadInteger('StyleMask');
reg.OpenKeyReadOnly('\' + key);
Result := true;
end else
Result := false;
{$ELSE}
Result:=false;
{$ENDIF}
end;
function TSynHighlighterAttributes.SaveToRegistry(Reg: TRegistry): boolean;
var
key: string;
begin
key := Reg.CurrentPath;
if Reg.OpenKey(StoredName,true) then begin
Reg.WriteInteger('Background', Background);
Reg.WriteInteger('Foreground', Foreground);
Reg.WriteInteger('Style', IntegerStyle);
Reg.WriteInteger('StyleMask', IntegerStyleMask);
reg.OpenKey('\' + key, false);
Result := true;
end else
Result := false;
end;
function TSynHighlighterAttributes.LoadFromFile(Ini : TIniFile): boolean; //DDH 10/16/01
var
S: TStringList;
begin
S := TStringList.Create;
try
Ini.ReadSection(StoredName, S);
if S.Count > 0 then
begin
if S.IndexOf('Background') <> -1 then
Background := Ini.ReadInteger(StoredName, 'Background', clWindow);
if S.IndexOf('Foreground') <> -1 then
Foreground := Ini.ReadInteger(StoredName, 'Foreground', clWindowText);
if S.IndexOf('Style') <> -1 then
IntegerStyle := Ini.ReadInteger(StoredName, 'Style', 0);
if S.IndexOf('StyleMask') <> -1 then
IntegerStyleMask := Ini.ReadInteger(StoredName, 'StyleMask', 0);
Result := true;
end else Result := false;
finally
S.Free;
end;
end;
function TSynHighlighterAttributes.SaveToFile(Ini : TIniFile): boolean; //DDH 10/16/01
begin
Ini.WriteInteger(StoredName, 'Background', Background);
Ini.WriteInteger(StoredName, 'Foreground', Foreground);
Ini.WriteInteger(StoredName, 'Style', IntegerStyle);
Ini.WriteInteger(StoredName, 'StyleMask', IntegerStyleMask);
Result := true;
end;
function TSynHighlighterAttributes.GetStyleFromInt: integer;
begin
if fsBold in Style then Result:= 1 else Result:= 0;
if fsItalic in Style then Result:= Result + 2;
if fsUnderline in Style then Result:= Result + 4;
if fsStrikeout in Style then Result:= Result + 8;
end;
procedure TSynHighlighterAttributes.SetStyleFromInt(const Value: integer);
begin
if Value and $1 = 0 then Style:= [] else Style:= [fsBold];
if Value and $2 <> 0 then Style:= Style + [fsItalic];
if Value and $4 <> 0 then Style:= Style + [fsUnderline];
if Value and $8 <> 0 then Style:= Style + [fsStrikeout];
end;
function TSynHighlighterAttributes.GetStyleMaskFromInt : integer;
begin
if fsBold in StyleMask then Result:= 1 else Result:= 0;
if fsItalic in StyleMask then Result:= Result + 2;
if fsUnderline in StyleMask then Result:= Result + 4;
if fsStrikeout in StyleMask then Result:= Result + 8;
end;
procedure TSynHighlighterAttributes.SetStyleMaskFromInt(const Value : integer);
begin
if Value and $1 = 0 then StyleMask:= [] else StyleMask:= [fsBold];
if Value and $2 <> 0 then StyleMask:= StyleMask + [fsItalic];
if Value and $4 <> 0 then StyleMask:= StyleMask + [fsUnderline];
if Value and $8 <> 0 then StyleMask:= StyleMask + [fsStrikeout];
end;
procedure TSynHighlighterAttributes.AssignFrom(Src: TLazSynCustomTextAttributes);
begin
inherited AssignFrom(Src);
if not (Src is TSynHighlighterAttributes) then exit;
FConstName := TSynHighlighterAttributes(Src).FConstName;
FStoredName:= TSynHighlighterAttributes(Src).FStoredName;
Changed; {TODO: only if really changed}
end;
procedure TSynHighlighterAttributes.DoChange;
begin
inherited DoChange;
if Assigned(fOnChange) then
fOnChange(Self);
end;
constructor TSynHighlighterAttributes.Create;
begin
inherited Create;
InternalSaveDefaultValues;
end;
{ TSynEditLinesList }
function TSynEditLinesList.GetSynString(Index: Integer): TSynEditStringsBase;
begin
Result := TSynEditStringsBase(inherited Items[Index]);
end;
procedure TSynEditLinesList.PutSynStrings(Index: Integer; const AValue: TSynEditStringsBase);
begin
inherited Items[Index] := AValue;
end;
{ TSynCustomHighlighter }
constructor TSynCustomHighlighter.Create(AOwner: TComponent);
begin
FCapabilities:=GetCapabilities;
FKnownLines := TSynEditLinesList.Create;
inherited Create(AOwner);
fWordBreakChars := TSynWordBreakChars;
fAttributes := TStringList.Create;
fAttributes.Duplicates := dupError;
fAttributes.Sorted := TRUE;
fAttrChangeHooks := TMethodList.Create;
fDefaultFilter := '';
end;
destructor TSynCustomHighlighter.Destroy;
begin
FreeHighlighterAttributes;
fAttributes.Free;
fAttrChangeHooks.Free;
inherited Destroy;
FreeAndNil(FKnownLines);
end;
procedure TSynCustomHighlighter.BeginUpdate;
begin
Inc(fUpdateCount);
end;
procedure TSynCustomHighlighter.EndUpdate;
begin
if fUpdateCount > 0 then begin
Dec(fUpdateCount);
if (fUpdateCount = 0) and fUpdateChange then begin
fUpdateChange := FALSE;
DefHighlightChange(Self);
end;
end;
end;
procedure TSynCustomHighlighter.FreeHighlighterAttributes;
var
i: integer;
begin
if fAttributes <> nil then begin
for i := fAttributes.Count - 1 downto 0 do
TSynHighlighterAttributes(fAttributes.Objects[i]).Free;
fAttributes.Clear;
end;
end;
procedure TSynCustomHighlighter.Assign(Source: TPersistent);
var
Src: TSynCustomHighlighter;
i, j: integer;
SrcAttri: TSynHighlighterAttributes;
StoredName: String;
begin
if (Source <> nil) and (Source is TSynCustomHighlighter) then begin
Src := TSynCustomHighlighter(Source);
for i := 0 to AttrCount - 1 do begin
// assign first attribute with the same name
StoredName := Attribute[i].StoredName;
for j := 0 to Src.AttrCount - 1 do begin
SrcAttri := Src.Attribute[j];
if StoredName = SrcAttri.StoredName then begin
Attribute[i].Assign(SrcAttri);
continue;
end;
end;
end;
for i := 0 to DividerDrawConfigCount - 1 do
DividerDrawConfig[i].Assign(Src.DividerDrawConfig[i]);
// assign the sample source text only if same or descendant class
if Src is ClassType then
SampleSource := Src.SampleSource;
fWordBreakChars := Src.WordBreakChars;
DefaultFilter := Src.DefaultFilter;
Enabled := Src.Enabled;
end else
inherited Assign(Source);
end;
procedure TSynCustomHighlighter.EnumUserSettings(Settings: TStrings);
begin
Settings.Clear;
end;
function TSynCustomHighlighter.UseUserSettings(settingIndex: integer): boolean;
begin
Result := false;
end;
function TSynCustomHighlighter.LoadFromRegistry(RootKey: HKEY;
Key: string): boolean;
var
r: TRegistry;
{ i: integer; }
begin
r := TRegistry.Create;
try
r.RootKey := RootKey;
{TODO:
if r.OpenKeyReadOnly(Key) then begin
Result := true;
for i := 0 to AttrCount-1 do
Result := Result and Attribute[i].LoadFromRegistry(r);
end
else
}
Result := false;
finally r.Free; end;
end;
function TSynCustomHighlighter.SaveToRegistry(RootKey: HKEY;
Key: string): boolean;
var
r: TRegistry;
i: integer;
begin
r := TRegistry.Create;
try
r.RootKey := RootKey;
if r.OpenKey(Key,true) then begin
Result := true;
for i := 0 to AttrCount-1 do
Result := Result and Attribute[i].SaveToRegistry(r);
end
else Result := false;
finally r.Free; end;
end;
function TSynCustomHighlighter.LoadFromFile(AFileName : String): boolean; //DDH 10/16/01
VAR AIni : TIniFile;
i : Integer;
begin
AIni := TIniFile.Create(UTF8ToSys(AFileName));
try
with AIni do
begin
Result := true;
for i := 0 to AttrCount-1 do
Result := Result and Attribute[i].LoadFromFile(AIni);
end;
finally
AIni.Free;
end;
end;
function TSynCustomHighlighter.SaveToFile(AFileName : String): boolean; //DDH 10/16/01
var AIni : TIniFile;
i: integer;
begin
AIni := TIniFile.Create(UTF8ToSys(AFileName));
try
with AIni do
begin
Result := true;
for i := 0 to AttrCount-1 do
Result := Result and Attribute[i].SaveToFile(AIni);
end;
finally
AIni.Free;
end;
end;
procedure TSynCustomHighlighter.AddAttribute(AAttrib: TSynHighlighterAttributes);
begin
fAttributes.AddObject(AAttrib.StoredName, AAttrib);
end;
function TSynCustomHighlighter.AddSpecialAttribute(const aCaption: string;
const aStoredName: String): TSynHighlighterAttributes;
begin
result := TSynHighlighterAttributes.Create(aCaption,aStoredName);
AddAttribute(result);
end;
function TSynCustomHighlighter.AddSpecialAttribute(const aCaption: PString;
const aStoredName: String): TSynHighlighterAttributes;
begin
Result := TSynHighlighterAttributes.Create(aCaption,aStoredName);
AddAttribute(result);
end;
procedure TSynCustomHighlighter.DefHighlightChange(Sender: TObject);
begin
if fUpdateCount > 0 then
fUpdateChange := TRUE
else begin
fAttrChangeHooks.CallNotifyEvents(self);
FAttributeChangeNeedScan := False;
end;
end;
function TSynCustomHighlighter.GetAttribCount: integer;
begin
Result := fAttributes.Count;
end;
function TSynCustomHighlighter.GetAttribute(idx: integer):
TSynHighlighterAttributes;
begin
Result := nil;
if (idx >= 0) and (idx < fAttributes.Count) then
Result := TSynHighlighterAttributes(fAttributes.Objects[idx]);
end;
class function TSynCustomHighlighter.GetCapabilities: TSynHighlighterCapabilities;
begin
Result := [hcRegistry]; //registry save/load supported by default
end;
function TSynCustomHighlighter.GetDefaultFilter: string;
begin
Result := fDefaultFilter;
end;
function TSynCustomHighlighter.GetIdentChars: TSynIdentChars;
begin
Result := ['_', 'A'..'Z', 'a'..'z', '0'..'9'];
end;
function TSynCustomHighlighter.GetEndOfLineAttribute: TSynHighlighterAttributes;
begin
Result := nil;
end;
procedure TSynCustomHighlighter.SetWordBreakChars(AChars: TSynIdentChars);
begin
fWordBreakChars := AChars;
end;
class function TSynCustomHighlighter.GetLanguageName: string;
begin
{$IFDEF SYN_DEVELOPMENT_CHECKS}
raise Exception.CreateFmt('%s.GetLanguageName not implemented', [ClassName]);
{$ENDIF}
Result := '<Unknown>';
end;
function TSynCustomHighlighter.GetRange: Pointer;
begin
Result := nil;
end;
function TSynCustomHighlighter.GetSampleSource: string;
begin
Result := '';
end;
procedure TSynCustomHighlighter.HookAttrChangeEvent(ANotifyEvent: TNotifyEvent);
begin
fAttrChangeHooks.Add(TMethod(ANotifyEvent));
end;
function TSynCustomHighlighter.IsFilterStored: boolean;
begin
Result := TRUE;
end;
{begin} // DJLP 2000-08-09
function TSynCustomHighlighter.IsKeyword(const AKeyword: string): boolean;
begin
Result := FALSE;
end;
{end} // DJLP 2000-08-09
procedure TSynCustomHighlighter.NextToEol;
begin
FIsInNextToEOL := True;
while not GetEol do Next;
FIsInNextToEOL := False;
end;
procedure TSynCustomHighlighter.ContinueNextLine;
begin
inc(FLineIndex);
SetLine(CurrentLines[FLineIndex], FLineIndex);
end;
procedure TSynCustomHighlighter.StartAtLineIndex(LineNumber: Integer);
begin
FLineIndex := LineNumber;
if LineNumber = 0 then
ResetRange
else
SetRange(FCurrentRanges[LineNumber - 1]);
SetLine(CurrentLines[LineNumber], LineNumber);
end;
procedure TSynCustomHighlighter.ResetRange;
begin
end;
procedure TSynCustomHighlighter.SetLine(const NewValue: String; LineNumber: Integer);
begin
// Keep a copy of the line text, since some highlighters just use a PChar pointer to it.
FLineText := NewValue;
FIsInNextToEOL := False;
FLineIndex := LineNumber;
end;
procedure TSynCustomHighlighter.SetAttributesOnChange(AEvent: TNotifyEvent);
(* Called once from TSynCustomHighlighter.Create (and only from there),
after all Attributes where created *)
var
i: integer;
Attri: TSynHighlighterAttributes;
begin
for i := fAttributes.Count - 1 downto 0 do begin
Attri := TSynHighlighterAttributes(fAttributes.Objects[i]);
if Attri <> nil then begin
Attri.OnChange := AEvent;
Attri.InternalSaveDefaultValues;
end;
end;
end;
procedure TSynCustomHighlighter.SetRange(Value: Pointer);
begin
end;
procedure TSynCustomHighlighter.SetDefaultFilter(Value: string);
begin
fDefaultFilter := Value;
end;
procedure TSynCustomHighlighter.SetSampleSource(Value: string);
begin
end;
function TSynCustomHighlighter.GetRangeIdentifier: Pointer;
begin
Result := self;
end;
function TSynCustomHighlighter.CreateRangeList(ALines: TSynEditStringsBase): TSynHighlighterRangeList;
begin
Result := TSynHighlighterRangeList.Create;
end;
procedure TSynCustomHighlighter.AfterAttachedToRangeList(ARangeList: TSynHighlighterRangeList);
begin // empty base
end;
procedure TSynCustomHighlighter.BeforeDetachedFromRangeList(ARangeList: TSynHighlighterRangeList);
begin // empty base
end;
procedure TSynCustomHighlighter.UnhookAttrChangeEvent(ANotifyEvent: TNotifyEvent);
begin
fAttrChangeHooks.Remove(TMethod(ANotifyEvent));
end;
function TSynCustomHighlighter.UpdateRangeInfoAtLine(Index: Integer): Boolean;
var
r: Pointer;
begin
r := GetRange;
Result := r <> FCurrentRanges[Index];
if Result then
FCurrentRanges[Index] := r;
end;
procedure TSynCustomHighlighter.ScanRanges;
var
StartIndex, EndIndex: Integer;
begin
StartIndex := CurrentRanges.NeedsReScanStartIndex;
if (StartIndex < 0) or (StartIndex >= CurrentRanges.Count) then
exit;
EndIndex := CurrentRanges.NeedsReScanEndIndex + 1;
//debugln(['=== scan ',StartIndex,' - ',EndIndex]);
FIsScanning := True;
try
EndIndex := PerformScan(StartIndex, EndIndex);
finally
FIsScanning := False;
end;
StartIndex := CurrentRanges.NeedsReScanRealStartIndex; // include idle scanned
CurrentRanges.ClearReScanNeeded;
// Invalidate one line above, since folds can change depending on next line
// TODO: only classes with end-fold-last-line
if StartIndex > 0
then CurrentLines.SendHighlightChanged(StartIndex - 1, EndIndex - StartIndex + 1)
else CurrentLines.SendHighlightChanged(StartIndex, EndIndex - StartIndex );
end;
function TSynCustomHighlighter.IdleScanRanges: Boolean;
var
StartIndex, EndIndex, RealEndIndex: Integer;
begin
Result := False;
StartIndex := CurrentRanges.NeedsReScanStartIndex;
if (StartIndex < 0) or (StartIndex >= CurrentRanges.Count) then
exit;
EndIndex := CurrentRanges.NeedsReScanEndIndex + 1;
RealEndIndex := EndIndex;
if EndIndex > StartIndex + IDLE_SCAN_CHUNK_SIZE then
EndIndex := StartIndex + IDLE_SCAN_CHUNK_SIZE;
FIsScanning := True;
try
EndIndex := PerformScan(StartIndex, EndIndex, True);
finally
FIsScanning := False;
end;
if EndIndex >= RealEndIndex then begin
StartIndex := CurrentRanges.NeedsReScanRealStartIndex; // include idle scanned
//debugln(['=== IDLE SendHighlightChanged ',StartIndex,' - ',EndIndex]);
CurrentRanges.ClearReScanNeeded;
// Invalidate one line above, since folds can change depending on next line
CurrentLines.SendHighlightChanged(StartIndex - 1, EndIndex - StartIndex + 1);
exit;
end
else begin
CurrentRanges.AdjustReScanStart(EndIndex);
Result := True;
end;
end;
function TSynCustomHighlighter.NeedScan: Boolean;
begin
Result := (CurrentRanges.NeedsReScanStartIndex >= 0);
end;
function TSynCustomHighlighter.PerformScan(StartIndex, EndIndex: Integer;
ForceEndIndex: Boolean = False): Integer;
var
c: Integer;
begin
Result := StartIndex;
c := CurrentLines.Count;
if (c = 0) or (Result >= c) then
exit;
StartAtLineIndex(Result);
NextToEol;
while UpdateRangeInfoAtLine(Result) or (Result <= EndIndex) do begin
inc(Result);
if (Result = c) or (ForceEndIndex and (Result > EndIndex)) then
break;
ContinueNextLine;
NextToEol;
end;
end;
procedure TSynCustomHighlighter.ScanAllRanges;
begin
CurrentRanges.InvalidateAll;
ScanRanges;
end;
procedure TSynCustomHighlighter.SetEnabled(const Value: boolean);
begin
if fEnabled <> Value then
begin
fEnabled := Value;
//we need to notify any editor that we are attached to to repaint,
//but a highlighter doesn't know what editor it is attached to.
//Until this is resolved, you will have to manually call repaint
//on the editor in question.
end;
end;
procedure TSynCustomHighlighter.SetCurrentLines(const AValue: TSynEditStringsBase);
begin
if AValue = FCurrentLines then
exit;
FCurrentLines := AValue;
if FCurrentLines <> nil
then FCurrentRanges := TSynHighlighterRangeList(AValue.Ranges[GetRangeIdentifier])
else FCurrentRanges := nil;
DoCurrentLinesChanged;
end;
procedure TSynCustomHighlighter.DoCurrentLinesChanged;
begin
//
end;
procedure TSynCustomHighlighter.AttachToLines(Lines: TSynEditStringsBase);
var
r: TSynHighlighterRangeList;
begin
r := TSynHighlighterRangeList(Lines.Ranges[GetRangeIdentifier]);
if assigned(r) then
r.IncRefCount
else begin
FKnownLines.Add(Lines);
r := CreateRangeList(Lines);
Lines.Ranges[GetRangeIdentifier] := r;
r.InvalidateAll;
end;
AfterAttachedToRangeList(r); // RefCount already increased
FCurrentLines := nil;
end;
procedure TSynCustomHighlighter.DetachFromLines(Lines: TSynEditStringsBase);
var
r: TSynHighlighterRangeList;
begin
r := TSynHighlighterRangeList(Lines.Ranges[GetRangeIdentifier]);
if not assigned(r) then exit;
r.DecRefCount;
BeforeDetachedFromRangeList(r); // RefCount already decreased
if r.RefCount = 0 then begin
Lines.Ranges[GetRangeIdentifier] := nil;
if FCurrentRanges = r then begin
FCurrentRanges := nil;
FCurrentLines := nil;
end;
r.Free;
end;
FKnownLines.Remove(Lines);
end;
procedure TSynCustomHighlighter.SetDrawDividerLevel(const AValue: Integer);
begin
if FDrawDividerLevel = AValue then exit;
FDrawDividerLevel := AValue;
//DefHighlightChange(Self);
end;
function TSynCustomHighlighter.GetKnownRanges(Index: Integer): TSynHighlighterRangeList;
begin
Result := TSynHighlighterRangeList(KnownLines[Index].Ranges[GetRangeIdentifier]);
end;
function TSynCustomHighlighter.GetDrawDivider(Index: integer): TSynDividerDrawConfigSetting;
begin
result := SynEmptyDividerDrawConfigSetting;
end;
function TSynCustomHighlighter.GetDividerDrawConfig(Index: Integer): TSynDividerDrawConfig;
begin
Result := nil;
end;
function TSynCustomHighlighter.GetDividerDrawConfigCount: Integer;
begin
Result := 0;
end;
{ TSynHighlighterRangeList }
function TSynHighlighterRangeList.GetRange(Index: Integer): Pointer;
begin
Result := Pointer(ItemPointer[Index]^);
end;
function TSynHighlighterRangeList.GetNeedsReScanRealStartIndex: Integer;
begin
Result := FNeedsReScanRealStartIndex;
if Result < 0 then
Result := FNeedsReScanStartIndex;
end;
procedure TSynHighlighterRangeList.SetRange(Index: Integer; const AValue: Pointer);
begin
Pointer(ItemPointer[Index]^) := AValue;
end;
procedure TSynHighlighterRangeList.LineTextChanged(AIndex: Integer; ACount: Integer = 1);
begin
if FNeedsReScanStartIndex < 0 then begin
FNeedsReScanStartIndex := AIndex;
FNeedsReScanEndIndex := AIndex + ACount - 1;
end
else if AIndex < FNeedsReScanStartIndex then
FNeedsReScanStartIndex := AIndex
else if AIndex + ACount - 1 > FNeedsReScanEndIndex then
FNeedsReScanEndIndex := AIndex + ACount - 1;
end;
procedure TSynHighlighterRangeList.InsertedLines(AIndex, ACount: Integer);
begin
if (FNeedsReScanStartIndex < 0) or (AIndex < FNeedsReScanStartIndex) then
FNeedsReScanStartIndex := AIndex;
if (FNeedsReScanEndIndex < 0) or (FNeedsReScanEndIndex < AIndex) then
FNeedsReScanEndIndex := AIndex + ACount
else
FNeedsReScanEndIndex := FNeedsReScanEndIndex + ACount
end;
procedure TSynHighlighterRangeList.DeletedLines(AIndex, ACount: Integer);
begin
if AIndex >= Count then exit;
if (FNeedsReScanStartIndex < 0) or (AIndex < FNeedsReScanStartIndex) then
FNeedsReScanStartIndex := AIndex;
if (FNeedsReScanEndIndex < 0) or (FNeedsReScanEndIndex < AIndex) then
FNeedsReScanEndIndex := AIndex;
end;
procedure TSynHighlighterRangeList.ClearReScanNeeded;
begin
FNeedsReScanStartIndex := -1;
FNeedsReScanEndIndex := -1;
FNeedsReScanRealStartIndex := -1;
end;
procedure TSynHighlighterRangeList.AdjustReScanStart(ANewStart: Integer);
begin
if FNeedsReScanRealStartIndex < 0 then
FNeedsReScanRealStartIndex := FNeedsReScanStartIndex;
FNeedsReScanStartIndex := ANewStart;
end;
procedure TSynHighlighterRangeList.InvalidateAll;
begin
FNeedsReScanStartIndex := 0;
FNeedsReScanEndIndex := Count - 1;
end;
constructor TSynHighlighterRangeList.Create;
begin
Inherited;
ItemSize := SizeOf(Pointer);
FRefCount := 1;
ClearReScanNeeded;
end;
procedure TSynHighlighterRangeList.IncRefCount;
begin
inc(FRefCount);
end;
procedure TSynHighlighterRangeList.DecRefCount;
begin
dec(FRefCount);
end;
{ TSynDividerDrawConfig }
function TSynDividerDrawConfig.GetNestColor: TColor;
begin
Result := FNestSetting.Color;
end;
function TSynDividerDrawConfig.GetTopColor: TColor;
begin
Result := FTopSetting.Color;
end;
procedure TSynDividerDrawConfig.SetNestColor(const AValue: TColor);
begin
if AValue = FNestSetting.Color then exit;
FNestSetting.Color := AValue;
Changed;
end;
procedure TSynDividerDrawConfig.SetTopColor(const AValue: TColor);
begin
if AValue = FTopSetting.Color then exit;
FTopSetting.Color := AValue;
Changed;
end;
function TSynDividerDrawConfig.GetMaxDrawDepth: Integer;
begin
Result := FDepth;
end;
procedure TSynDividerDrawConfig.SetMaxDrawDepth(AValue: Integer);
begin
if FDepth = AValue then exit;
FDepth := AValue;
Changed;
end;
procedure TSynDividerDrawConfig.Changed;
begin
if Assigned(fOnChange) then
fOnChange(Self);
end;
constructor TSynDividerDrawConfig.Create;
begin
inherited;
FDepth := 0;
FTopSetting.Color := clDefault;
FNestSetting.Color := clDefault;
end;
procedure TSynDividerDrawConfig.Assign(Src: TSynDividerDrawConfig);
begin
fOnChange := src.fOnChange;
FDepth := Src.FDepth;
end;
initialization
G_PlaceableHighlighters := TSynHighlighterList.Create;
finalization
G_PlaceableHighlighters.Free;
G_PlaceableHighlighters := nil;
end.