{ 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: SynUniHighlighter.pas, released 2003-01 All Rights Reserved. Alternatively, the contents of this file may be used under the terms of the GNU General Public License Version 2 or later (the "GPL"), in which case the provisions of the GPL are applicable instead of those above. If you wish to allow use of your version of this file only under the terms of the GPL and not to allow others to use your version of this file under the MPL, indicate your decision by deleting the provisions above and replace them with the notice and other provisions required by the GPL. If you do not delete the provisions above, a recipient may use your version of this file under either the MPL or the GPL. }{ @abstract(Provides a universal highlighter for SynEdit) @authors(Fantasist [walking_in_the_sky@yahoo.com], Vit [nevzorov@yahoo.com], Vitalik [vetal-x@mail.ru]) @created(2003) @lastmod(2004-05-12) } unit SynUniClasses; interface uses SysUtils, Graphics, Classes, SynEditHighlighter, Contnrs, Laz2_DOM; type TSymbSet = set of char; TSynInfo = class; TStreamWriter = class; TSynSymbol = class; TSymbolNode = class; TSymbolList = class; TSynRule = class; TVersionType = (vtInternalTest, vtBeta, vtRelease); TAuthorInfo = record Name: string; Email: string; Web: string; Copyright: string; Company: string; Remark: string; end; TVerInfo = record Version: integer; Revision: integer; VersionType: TVersionType; ReleaseDate: TDateTime; end; THighInfo = record Name: string; Extensions: string; Other: Boolean end; TSynInfo = class //Vitalik 2004 Author: TAuthorInfo; Version: TVerInfo; General: THighInfo; History: TStringList; Sample: TStringlist; constructor Create(); procedure Clear(); procedure LoadFromXml(xml: TDOMNode); procedure LoadFromStream(Stream: TStream); procedure SaveToStream(Stream: TStream; Ind: integer = 0); overload; procedure SaveToStream(StreamWriter: TStreamWriter; Ind: integer = 0); overload; end; TSynEditProperties = class //Vitalik 2004 end; TSymbStartType = (stUnspecified, stAny, stTerm); //Vitalik 2004 TSymbBrakeType = (btUnspecified, btAny, btTerm); TSymbStartLine = (slNotFirst, slFirst, slFirstNonSpace); //Vitalik 2004 TStreamWriter = class //Vitalik 2004 Stream: TStream; constructor Create(aStream: TStream); procedure WriteString(const Str: string); procedure InsertTag(Ind: integer; Name: string; Value: string); procedure WriteTag(Ind: integer; Name: string; EndLine: boolean = False); procedure WriteParam(Key, Value: string; CloseTag: string = ''); procedure WriteBoolParam(Key: string; Value, Default: boolean; CloseTag: string = ''); end; TSynAttributes = class (TSynHighlighterAttributes) //Vitalik 2004 public // UseStyle: boolean; OldColorForeground: TColor; OldColorBackground: TColor; ParentForeground: boolean; ParentBackground: boolean; constructor Create(Name: string); // destructor Destroy(); override; procedure LoadFromString(Value: string); procedure SaveToStream(StreamWriter: TStreamWriter); end; TAbstractRule = class; TSynSymbol = class public Symbol: string; fOpenRule: TAbstractRule; StartType: TSymbStartType; //Vitalik 2004 BrakeType: TSymbBrakeType; StartLine: TSymbStartLine; //Vitalik 2004 Attributes: TSynHighlighterAttributes; constructor Create(st: string; Attribs: TSynHighlighterAttributes); virtual; destructor Destroy(); override; end; TSymbolNode = class ch: char; BrakeType: TSymbBrakeType; StartType: TSymbStartType; //Vitalik 2004 NextSymbs: TSymbolList; tkSynSymbol: TSynSymbol; constructor Create(AC: char; SynSymbol: TSynSymbol; ABrakeType: TSymbBrakeType); overload; virtual; constructor Create(AC: char); overload; destructor Destroy(); override; end; TSymbolList = class SymbList: TList; //Vitalik 2004 procedure AddSymbol(symb: TSymbolNode); procedure SetSymbolNode(Index: Integer; Value: TSymbolNode); function FindSymbol(ch: char): TSymbolNode; function GetSymbolNode(Index: integer): TSymbolNode; function GetCount(): integer; property Nodes[index: integer]: TSymbolNode read GetSymbolNode write SetSymbolNode; property Count: Integer read GetCount; constructor Create(); virtual; destructor Destroy(); override; end; TSynUniStyles = class (TObjectList) public FileName: string; constructor Create(); destructor Destroy(); override; function GetStyle(const Name: string): {TSynHighlighter}TSynAttributes; function GetStyleDef(const Name: string; const Def: {TSynHighlighter}TSynAttributes): {TSynHighlighter}TSynAttributes; procedure AddStyle(Name: string; Foreground, Background: TColor; FontStyle: TFontStyles); procedure ListStylesNames(const AList: TStrings); function GetStylesAsXML(): string; procedure Load(); procedure Save(); end; TAbstractRule = class //Vitalik 2004 Enabled: boolean; constructor Create(); end; TSynRule = class(TAbstractRule) //Vitalik 2004 public Ind: integer; //temp Name: string; Attribs: TSynAttributes; Style: string; Styles: TSynUniStyles; constructor Create(); destructor Destroy(); override; procedure LoadFromXml(xml: TDOMNode); virtual; abstract; procedure LoadFromStream(aSrc: TStream); procedure LoadFromFile(FileName: string); function GetAsStream(): TMemoryStream; procedure SaveToStream(Stream: TStream; Ind: integer = 0); overload; procedure SaveToStream(StreamWriter: TStreamWriter; Ind: integer = 0); overload; virtual; abstract; end; function StrToSet(st: string): TSymbSet; function SetToStr(st: TSymbSet): string; function StrToFontStyle(Style: string): TFontStyles; function FontStyleToStr(Style: TFontStyles): string; procedure FreeList(var List: TList); procedure ClearList(List: TList); function Indent(i: integer): string; const AbsoluteTermSymbols: TSymbSet = [#0, #9, #10, #13, #32]; EOL = #13#10; CloseEmptyTag = '/>'; CloseStartTag = '>'; implementation uses Laz2_XMLRead; function StrToSet(st: string): TSymbSet; var i: integer; begin result := []; for i := 1 to length(st) do Result := Result + [st[i]]; end; function SetToStr(st: TSymbSet): string; var b: byte; begin Result := ''; for b := 1 to 255 do if (chr(b) in st) and (not (chr(b) in AbsoluteTermSymbols)) then Result := Result+chr(b); end; function StrToFontStyle(Style: string): TFontStyles; begin Result := []; if Pos('B', Style) > 0 then Include( Result, fsBold ); if Pos('I', Style) > 0 then Include( Result, fsItalic ); if Pos('U', Style) > 0 then Include( Result, fsUnderline ); if Pos('S', Style) > 0 then Include( Result, fsStrikeOut ); end; function FontStyleToStr(Style: TFontStyles): string; begin Result := ''; if fsBold in Style then Result := Result + 'B'; if fsItalic in Style then Result := Result + 'I'; if fsUnderline in Style then Result := Result + 'U'; if fsStrikeOut in Style then Result := Result + 'S'; end; procedure FreeList(var List: TList); var i: integer; begin if List = nil then exit; for i := 0 to List.Count-1 do TObject(List[i]).Free; List.Free; List := nil; end; procedure ClearList(List: TList); var i: integer; begin if List = nil then exit; for i := 0 to List.Count-1 do TObject(List[i]).Free; List.Clear; end; //==== TInfo ================================================================= constructor TSynInfo.Create(); begin inherited; end; procedure TSynInfo.Clear(); begin General.Other := False; General.Name := ''; General.Extensions := ''; Author.Name := ''; Author.Email := ''; Author.Web := ''; Author.Copyright := ''; Author.Company := ''; Author.Remark := ''; Version.Version := 0; Version.Revision := 0; Version.ReleaseDate := 0; Version.VersionType := vtInternalTest; History.Clear; Sample.Clear; end; function ReadValue(ANode: TDOMNode): String; begin if Assigned(ANode.FirstChild) then Result:= ANode.FirstChild.NodeValue else Result:= EmptyStr; end; procedure TSynInfo.LoadFromXml(xml: TDOMNode); var i, J: integer; Key, Value: string; ChildNode1, ChildNode2: TDOMNode; begin for J := 0 to Int32(xml.ChildNodes.Count) - 1 do begin ChildNode1:= xml.ChildNodes.Item[J]; if SameText('General', ChildNode1.NodeName) then for i := 0 to Int32(ChildNode1.Attributes.Length) - 1 do begin Key := ChildNode1.Attributes[i].NodeName; Value := ChildNode1.Attributes[i].NodeValue; if SameText('Name', Key) then General.Name := Value else if SameText('Extensions', Key) then General.Extensions := Value else if SameText('Other', Key) then General.Other := StrToBoolDef(Value, False) end else if SameText('Author', ChildNode1.NodeName) then for i := 0 to Int32(ChildNode1.Attributes.Length) - 1 do begin Key := ChildNode1.Attributes[i].NodeName; Value := ChildNode1.Attributes[i].NodeValue; if SameText('Name', Key) then Author.Name := Value else if SameText('Email', Key) then Author.Email := Value else if SameText('Web', Key) then Author.Web := Value else if SameText('Copyright', Key) then Author.Copyright := Value else if SameText('Company', Key) then Author.Company := Value else if SameText('Remark', Key) then Author.Remark := Value else end else if SameText('Version', ChildNode1.NodeName) then for i := 0 to Int32(ChildNode1.Attributes.Length) - 1 do begin Key := ChildNode1.Attributes[i].NodeName; Value := ChildNode1.Attributes[i].NodeValue; if SameText('Version', Key) then Version.Version := StrToIntDef(Value, 0) else if SameText('Revision', Key) then Version.Revision := StrToIntDef(Value, 0) else if SameText('Date', Key) then try Value := StringReplace(Value, ',', DefaultFormatSettings.DecimalSeparator, [rfReplaceAll]); // Since no one ever call something like "GetFormatSettings", "DefaultFormatSettings" still hold the default values. Value := StringReplace(Value, '.', DefaultFormatSettings.DecimalSeparator, [rfReplaceAll]); // Just in case there is something we did not think about. Version.ReleaseDate := StrToFloat(Value, DefaultFormatSettings); except // Ignore end else if SameText('Type', Key) then if Value = 'Beta' then Version.VersionType := vtBeta else if Value = 'Release' then Version.VersionType := vtRelease else Version.VersionType := vtInternalTest end else if SameText('History', ChildNode1.NodeName) then begin History.Clear; Sample.Clear; for I:= 0 to Int32(ChildNode1.ChildNodes.Count) - 1 do begin ChildNode2 := ChildNode1.ChildNodes.Item[I]; if ChildNode2.NodeName = 'H' then History.Add(ReadValue(ChildNode2)); end; end else if SameText('Sample', ChildNode1.NodeName) then begin Sample.Clear; for I:= 0 to Int32(ChildNode1.ChildNodes.Count) - 1 do begin ChildNode2 := ChildNode1.ChildNodes.Item[I]; if ChildNode2.NodeName = 'S' then Sample.Add(ReadValue(ChildNode2)); end; end; end; end; procedure TSynInfo.LoadFromStream(Stream: TStream); var xml: TXMLDocument = nil; begin try ReadXMLFile(xml, Stream); LoadFromXml(xml); finally xml.Free; end; end; procedure TSynInfo.SaveToStream(Stream: TStream; Ind: integer); var StreamWriter: TStreamWriter; begin StreamWriter := TStreamWriter.Create(Stream); SaveToStream(StreamWriter, Ind); StreamWriter.Free; end; procedure TSynInfo.SaveToStream(StreamWriter: TStreamWriter; Ind: integer); var i: integer; begin with StreamWriter do begin WriteTag(Ind, 'Info', True); WriteTag(Ind+2, 'General'); WriteParam('Name', General.Name); WriteParam('Extensions', General.Extensions, CloseEmptyTag); WriteParam('Other', BoolToStr(General.Other), CloseEmptyTag); WriteTag(Ind+2, 'Author'); WriteParam('Name', Author.Name); WriteParam('Email', Author.Email); WriteParam('Web', Author.Web); WriteParam('Copyright', Author.Copyright); WriteParam('Company', Author.Company); WriteParam('Remark', Author.Remark, CloseEmptyTag); WriteTag(Ind+2, 'Version'); WriteParam('Version', IntToStr(Version.Version)); WriteParam('Revision', IntToStr(Version.Revision)); WriteParam('Date', FloatToStr(Version.ReleaseDate), CloseEmptyTag); { case Version.VersionType of vtInternalTest: WriteParam('Type', 'Internal Test'); vtBeta: WriteParam('Type', 'Beta'); vtRelease: WriteParam('Type', 'Release'); end;} WriteTag(Ind+2, 'History', True); for i := 0 to History.Count-1 do InsertTag(Ind+4, 'H', History[i]); WriteTag(Ind+2, '/History', True); WriteTag(Ind+2, 'Sample', True); for i := 0 to Sample.Count-1 do InsertTag(Ind+4, 'S', Sample[i]); WriteTag(Ind+2, '/Sample', True); WriteTag(Ind, '/Info', True); end; end; //==== TStreamWriter ========================================================= function Indent(i: integer): string; begin SetLength(Result, i); // if i > 0 then !!!!!!!!!!!!!!!!!!!!!!!!! {To prevent error...} {$IFDEF FPC} if i > 0 then {$ENDIF} FillChar(Result[1], i, #32); end; function GetValidValue(Value: string): string; begin Value := StringReplace(Value, '&', '&', [rfReplaceAll, rfIgnoreCase]); Value := StringReplace(Value, '<', '<', [rfReplaceAll, rfIgnoreCase]); Value := StringReplace(Value, '"', '"', [rfReplaceAll, rfIgnoreCase]); Result := StringReplace(Value, '>', '>', [rfReplaceAll, rfIgnoreCase]); end; constructor TStreamWriter.Create(aStream: TStream); begin Stream := aStream; end; procedure TStreamWriter.WriteString(const Str: string); begin Stream.Write(Str[1], Length(Str)); end; procedure TStreamWriter.InsertTag(Ind: integer; Name: string; Value: string); begin WriteString(Format('%s<%s>%s'+EOL, [Indent(Ind), Name, GetValidValue(Value), Name])); end; { procedure OpenTag(Ind: integer; Name: string; Param: string = ''; ParamValue: string = ''); begin if Param = '' then WriteString(Format('%s<%s>', [Indent(Ind), Name])) else WriteString(Format('%s<%s %s="%s">', [Indent(Ind), Name, Param, GetValidValue(ParamValue)])); end;} procedure TStreamWriter.WriteTag(Ind: integer; Name: string; EndLine: boolean = False); begin WriteString(Format('%s<%s', [Indent(Ind), Name])); if EndLine then WriteString('>' + EOL); end; { procedure SaveColor(MainTag: string; Ind, Fore, Back: integer; Style: TFontStyles; PFore, PBack: boolean); procedure InsertTagBool(Ind: integer; Name: string; Value: Boolean); begin if Value then WriteString(Format('%s<%s>True', [Indent(Ind), Name, Name])) else WriteString(Format('%s<%s>False', [Indent(Ind), Name, Name])) end; begin OpenTag(Ind, MainTag); InsertTag(Ind+1, 'Back', Inttostr(Back)); InsertTag(Ind+1, 'Fore', Inttostr(Fore)); InsertTag(Ind+1, 'Style', Fs2String(Style)); InsertTagBool(Ind+1, 'ParentForeground', PFore); InsertTagBool(Ind+1, 'ParentBackground', PBack); OpenTag(Ind, '/'+MainTag); end;} procedure TStreamWriter.WriteParam(Key, Value: string; CloseTag: string = ''); begin WriteString(Format(' %s="%s"', [Key, GetValidValue(Value)])); if CloseTag <> '' then WriteString(CloseTag + EOL); end; procedure TStreamWriter.WriteBoolParam(Key: string; Value, Default: boolean; CloseTag: string = ''); begin If Value <> Default then WriteParam(Key, BoolToStr(Value,True), CloseTag); end; //==== TAttributes =========================================================== constructor TSynAttributes.Create(Name: String); begin // Std := TSynHighlighterAttributes.Create(SYNS_AttrDefaultPackage); inherited Create(Name{SYNS_AttrDefaultPackage}); // UseStyle := False; end; {destructor TSynAttributes.Destroy; //var xml: TXMLParser; begin // if not UseStyle then //Std.Free; // xml := TXMLParser.Create; // xml.Standalone inherited; end; } procedure TSynAttributes.LoadFromString(Value: string); begin ParentForeground := False; ParentBackground := False; Foreground := StrToIntDef(Copy(Value, 1, pos(',',Value)-1), 0); OldColorForeground := Foreground; Background := StrToIntDef(Copy(Value, pos(',',Value)+1, pos(';',Value)-pos(',',Value)-1), $FFFFFF); OldColorBackground := Background; ParentForeground := LowerCase(Copy(Value, pos(';',Value)+1, pos(':',Value)-pos(';',Value)-1)) = 'true'; ParentBackground := LowerCase(Copy(Value, pos(':',Value)+1, pos('.',Value)-pos(':',Value)-1)) = 'true'; Style := StrToFontStyle(Copy(Value, pos('.',Value)+1, Length(Value)-pos('.',Value))); // '12345,0;true:false.' { Std.Background := StrToIntDef(Value, $FFFFFF); OldColorBackground := Std.Background; Std.Foreground := StrToIntDef(Value, 0); OldColorForeground := Std.Foreground; Std.Style := String2Fs(Value) ParentForeground := LoweValue = 'true' ParentBackground := LowerValue = 'true';} end; procedure TSynAttributes.SaveToStream(StreamWriter: TStreamWriter); begin with StreamWriter do WriteParam('Attributes', IntToStr(Foreground)+','+IntToStr(Background)+';'+ BoolToStr(ParentForeground,True)+':'+ BoolToStr(ParentBackground,True)+'.'+ FontStyleToStr(Style)); end; //==== TSynSymbol ============================================================ constructor TSynSymbol.Create(st: string; Attribs: TSynHighlighterAttributes); //: Constructor of TSynSymbol begin Attributes := Attribs; Symbol := st; fOpenRule := nil; StartLine := slNotFirst; StartType := stUnspecified; BrakeType := btUnspecified; end; destructor TSynSymbol.Destroy; //: Destructor of TSynSymbol begin inherited; end; //==== TSymbolNode =========================================================== constructor TSymbolNode.Create(AC: char; SynSymbol: TSynSymbol; ABrakeType: TSymbBrakeType); begin ch := AC; NextSymbs := TSymbolList.Create; BrakeType := ABrakeType; StartType := SynSymbol.StartType; tkSynSymbol := SynSymbol; end; constructor TSymbolNode.Create(AC: char); begin ch := AC; NextSymbs := TSymbolList.Create; tkSynSymbol := nil; end; destructor TSymbolNode.Destroy; //: Destructor of TSymbolNode begin NextSymbs.Free; inherited; end; //==== TSymbolList =========================================================== procedure TSymbolList.AddSymbol(symb: TSymbolNode); //: Add Node to SymbolList begin SymbList.Add(symb); end; constructor TSymbolList.Create; //: Constructor of TSymbolList begin SymbList := TList.Create; end; destructor TSymbolList.Destroy; //: Destructor of TSymbolList begin FreeList(SymbList); inherited; end; function TSymbolList.FindSymbol(ch: char): TSymbolNode; //: Find Node in SymbolList by char var i: integer; begin Result := nil; for i := 0 to SymbList.Count-1 do if TSymbolNode(SymbList[i]).ch = ch then begin Result := TSymbolNode(SymbList[i]); break; end; end; function TSymbolList.GetCount: integer; //: Return Node count in SymbolList begin Result := SymbList.Count end; function TSymbolList.GetSymbolNode(Index: integer): TSymbolNode; //: Return Node in SymbolList by index begin Result := TSymbolNode(SymbList[index]); end; procedure TSymbolList.SetSymbolNode(Index: Integer; Value: TSymbolNode); //: Set Node in SymbolList bt index begin if Index < SymbList.Count then TSymbolNode(SymbList[index]).Free; SymbList[index] := Value; end; constructor TAbstractRule.Create(); begin Enabled := True; end; //==== TSynRule ============================================================== {function TSynRule.GetAttribs: TAttributes; begin if (Ind < 0) or (Ind >= AttribsList.Count) then raise Exception.CreateFmt ('Invalid index: %d', [Ind]); Result := TAttributes(AttribsList[Ind]); end; function TSynRule.GetAttribsByIndex(Index: integer): TAttributes; begin if (Index < 0) or (Index >= AttribsList.Count) then raise Exception.CreateFmt ('Invalid index: %d', [Ind]); Result := TAttributes(AttribsList[Index]); end; } constructor TSynRule.Create; begin inherited; ind := -1; Attribs := TSynAttributes.Create('unknown'); // AttribsList := TList.Create; end; destructor TSynRule.Destroy; begin // FreeList(AttribsList); Attribs.Free; inherited Destroy; end; {function TSynRule.AddAttribute(): integer; var i: integer; begin ind := AttribsList.Add(TAttributes.Create); Attribs.ParentForeground := True; Attribs.ParentBackground := True; Attribs.Std.Foreground := clBlack; Attribs.Std.Background := clWhite; Attribs.OldColorForeground := Attribs.Std.Foreground; Attribs.OldColorBackground := Attribs.Std.Background; Attribs.Std.Style := []; Result := ind; if self is TSynRange then with self as TSynRange do begin for i := 0 to RangeCount-1 do Ranges[i].AddAttribute(); for i := 0 to KeyListCount-1 do KeyLists[i].AddAttribute(); for i := 0 to SetCount-1 do Sets[i].AddAttribute(); end; end; procedure TSynRule.DeleteAttributes(Index: integer); var i: integer; begin AttribsList.Delete(Index); if AttribsList.Count = Index then ind := Index-1 else ind := Index; if self is TSynRange then with self as TSynRange do begin for i := 0 to RangeCount-1 do Ranges[i].DeleteAttributes(Index); for i := 0 to KeyListCount-1 do KeyLists[i].DeleteAttributes(Index); for i := 0 to SetCount-1 do Sets[i].DeleteAttributes(Index); end; end; procedure TSynRule.ClearAttributes(); var i: integer; begin ClearList(AttribsList); ind := -1; if self is TSynRange then with self as TSynRange do begin for i := 0 to RangeCount-1 do Ranges[i].ClearAttributes(); for i := 0 to KeyListCount-1 do KeyLists[i].ClearAttributes(); for i := 0 to SetCount-1 do Sets[i].ClearAttributes(); end; end; procedure TSynRule.SetAttributesIndex(Index: integer); var i: integer; begin ind := Index; if self is TSynRange then with self as TSynRange do begin for i := 0 to RangeCount-1 do Ranges[i].SetAttributesIndex(Index); for i := 0 to KeyListCount-1 do KeyLists[i].SetAttributesIndex(Index); for i := 0 to SetCount-1 do Sets[i].SetAttributesIndex(Index); end; end;} function TSynRule.GetAsStream: TMemoryStream; begin Result := TMemoryStream.Create; SaveToStream(Result); end; procedure TSynRule.SaveToStream(Stream: TStream; Ind: integer = 0); var StreamWriter: TStreamWriter; begin StreamWriter := TStreamWriter.Create(Stream); SaveToStream(StreamWriter, Ind); StreamWriter.Free; end; procedure TSynRule.LoadFromStream(aSrc: TStream); var I: Integer; ChildNode: TDOMNode; TagName: UnicodeString; xml: TXMLDocument = nil; begin if ClassName = 'TSynRange' then TagName := 'Range' else if ClassName = 'TSynKeyList' then TagName := 'Keywords' else if ClassName = 'TSynSet' then TagName := 'Set' else raise Exception.Create(ClassName + '.LoadFromStream - Unknown rule to load!'); try ReadXMLFile(xml, aSrc); for I:= 0 to Int32(xml.ChildNodes.Count) - 1 do begin ChildNode:= xml.ChildNodes.Item[I]; if SameText(ChildNode.NodeName, TagName) then LoadFromXml(ChildNode); end; finally xml.Free; end; end; procedure TSynRule.LoadFromFile(FileName: string); var xml: TXMLDocument = nil; begin if not FileExists(FileName) then raise Exception.Create(ClassName + '.LoadFromFile - "'+FileName+'" does not exists.'); try ReadXMLFile(xml, FileName); LoadFromXml(xml); finally xml.Free; end; end; //==== TSynUniStyles ========================================================= constructor TSynUniStyles.Create; begin Self.OwnsObjects := True; end; destructor TSynUniStyles.Destroy; begin inherited; end; function TSynUniStyles.GetStyle(const Name: string): {TSynHighlighter}TSynAttributes; begin Result := GetStyleDef(Name, nil); end; function TSynUniStyles.GetStyleDef(const Name: string; const Def: {TSynHighlighter}TSynAttributes): {TSynHighlighter}TSynAttributes; var i: integer; begin Result := Def; for i := 0 to Self.Count-1 do if SameText({TSynHighlighter}TSynAttributes(Self.Items[i]).Name, Name) then begin Result := {TSynHighlighter}TSynAttributes(Self.Items[i]); Exit; end; end; procedure TSynUniStyles.AddStyle(Name: string; Foreground, Background: TColor; FontStyle: TFontStyles); var Atr: {TSynHighlighter}TSynAttributes; begin Atr := {TSynHighlighter}TSynAttributes.Create(Name); Atr.Foreground := Foreground; Atr.Background := Background; Atr.Style := FontStyle; Self.Add(Atr); end; procedure TSynUniStyles.ListStylesNames(const AList: TStrings); var i: integer; begin aList.BeginUpdate; try aList.Clear; for i := 0 to Self.Count-1 do aList.Add({TSynHighlighter}TSynAttributes(Self.Items[i]).Name); finally aList.EndUpdate; end; end; function TSynUniStyles.GetStylesAsXML: string; var i: integer; begin // Result:= ''#13#10#13#10'; Result := ''#13#10; Result := Result + ' '#13#10; for i := 0 to Self.Count-1 do with {TSynHighlighter}TSynAttributes(Self.Items[I]) do Result := Result + '