{
  This Delphi component is part of TIGCC IDE.

  Copyright (C) 2000-2004 Sebastian Reichelt

  This program is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2, or (at your option)
  any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software Foundation,
  Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA.
}

{*******************************************************}
{                                                       }
{       TSourceEdit Component v2.19                     }
{                                                       }
{       Based on TMemoComponent                         }
{                                                       }
{       Copyright (c) 2000-2004 Sebastian Reichelt      }
{                                                       }
{*******************************************************}

unit SourceEditUnit;

interface

uses
	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
	StdCtrls, Consts, ObjList, MemoComponentUnit;

const
	SymbolChars: set of Char = ['<', '{', '[', '(', ')', ']', '}', '>', ';', ':', ',', '.', '=', '+', '-', '*', '/', '\', '|', '"', '''', '!', '?', '&', '%', '#', '@', '^', '~'];
	MaxBeginEndTextLength  = 20;
	CustomStyleCheckLength = 128;
	MaxOnFlySectionLength  = 128;
	SSourceEditError = 'TSourceEdit internal error';

type
	ESourceEdit = class(Exception);

	TSyntaxColoring = class;
	TWordLists = class;
	TWordList = class;
	TCustomStyles = class;
	TCustomStyle = class;

	TSyntaxRange = class;

	TIgnoreChar = string [1];
	TParenthesisStyle = (psOpening, psClosing);

	TDebuggableRange = record
		RStart,
		REnd: Integer;
		Text,
		ClassName: string;
	end;
	TDebuggableRanges = array of TDebuggableRange;

	TSourceEdit = class(TMemoComponent)
	private
		FSyntaxColoring: TSyntaxColoring;
		FFirstSyntaxRange: TSyntaxRange;
		FLastSyntaxRange: TSyntaxRange;
		FAutoIndentIncrease: Boolean;
		FAutoIndentIncreaseStart: Char;
		FAutoIndentIncreaseEnd: Char;
		FSplitOnFly: Boolean;
		procedure CMFontChanged(var Message: TMessage); message cm_FontChanged;
		procedure WMKeyDown(var Message: TWMKeyDown); message wm_KeyDown;
		procedure SetSyntaxColoring(const Value: TSyntaxColoring);
		procedure SetSplitOnFly(const Value: Boolean);
	protected
		SyntaxStartRange,
		LastPRange: TSyntaxRange;
		LastCRange: TCustomRange;
		procedure KeyPress(var Key: Char); override;
		procedure TextChangeNotification(StartPos, OldLength, NewLength: Integer); override;
		procedure TextChangeNotificationAfter; override;
		procedure ReColor; virtual;
		procedure ReColorRange(Range: TCustomRange); virtual;
		procedure FreeAllSyntaxRanges; virtual;
		function ReplaceSyntaxRanges(NewRange: TSyntaxRange; var StartRange: TSyntaxRange): Boolean; virtual;
		function CreateSplitRanges(Range: TCustomRange): TFormattedRangeArray; override;
		procedure OverwriteRange(Sender: TObject);
		function FindSyntaxHole: TSyntaxRange; virtual;
		function FindSyntaxOverlap: TSyntaxRange; virtual;
		function MakeDebuggableRanges: TDebuggableRanges; virtual;
	public
		constructor Create(AOwner: TComponent); override;
		destructor Destroy; override;
		function SyntaxRangeAtPos(RangePos: Integer): TSyntaxRange; virtual;
		function SyntaxRangeAtPosWithHint(RangePos: Integer; Hint: TSyntaxRange): TSyntaxRange; virtual;
		procedure RemoveTrSpFromString(var Str: string; IncludeLastLine: Boolean = False); override;
		property FirstSyntaxRange: TSyntaxRange read FFirstSyntaxRange write FFirstSyntaxRange;
		property LastSyntaxRange: TSyntaxRange read FLastSyntaxRange write FLastSyntaxRange;
	published
		property SyntaxColoring: TSyntaxColoring read FSyntaxColoring write SetSyntaxColoring;
		property AutoIndentIncrease: Boolean read FAutoIndentIncrease write FAutoIndentIncrease;
		property AutoIndentIncreaseStart: Char read FAutoIndentIncreaseStart write FAutoIndentIncreaseStart;
		property AutoIndentIncreaseEnd: Char read FAutoIndentIncreaseEnd write FAutoIndentIncreaseEnd;
		property SplitOnFly: Boolean read FSplitOnFly write SetSplitOnFly;
	end;

	TSyntaxRangeClass = class of TSyntaxRange;

	TSyntaxRange = class(TCustomFormattedRange)
	private
		FParenthesisLevel: Integer;
		FNextRange: TSyntaxRange;
		FPrevRange: TSyntaxRange;
	protected
		procedure SetNewParenthesisLevel; virtual;
		function GetNextParenthesisLevel: Integer; virtual;
		function GetColor: TColor; override;
		function ReplaceSyntaxRanges(var StartRange: TSyntaxRange): Boolean; virtual;
	public
		destructor Destroy; override;
		class function EqualEndings(Range1, Range2: TSyntaxRange): Boolean;
		function EqualEndingsWith(Range: TSyntaxRange): Boolean; virtual;
		class function InsertRangeBefore(Range: TSyntaxRange; RangeClass: TSyntaxRangeClass; Editor: TSourceEdit): TSyntaxRange;
		function InsertBefore(RangeClass: TSyntaxRangeClass): TSyntaxRange;
		function InsertAfter(RangeClass: TSyntaxRangeClass): TSyntaxRange;
		class function NewRangeInsertedBefore(Range: TSyntaxRange; Editor: TSourceEdit): TSyntaxRange;
		class function NewRangeInsertedAfter(Range: TSyntaxRange; Editor: TSourceEdit): TSyntaxRange;
		procedure UpdateParenthesisLevel; virtual;
		property NextParenthesisLevel: Integer read GetNextParenthesisLevel;
		property PrevRange: TSyntaxRange read FPrevRange write FPrevRange;
		property NextRange: TSyntaxRange read FNextRange write FNextRange;
	published
		property ParenthesisLevel: Integer read FParenthesisLevel write FParenthesisLevel;
	end;

	TNormalTextRange = class(TSyntaxRange)
	protected
		function GetFont: TFont; override;
	public
		function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
	end;

	TCustomStyleRange = class(TSyntaxRange)
	private
		FStyle: TCustomStyle;
	protected
		function GetFont: TFont; override;
	public
		function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
	published
		property Style: TCustomStyle read FStyle write FStyle;
	end;

	TCustomTextRange = class(TSyntaxRange)
	protected
		function GetFont: TFont; override;
	public
		function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
	end;

	TWordListRange = class(TSyntaxRange)
	private
		FWordList: TWordList;
	protected
		function GetFont: TFont; override;
	public
		function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
	published
		property WordList: TWordList read FWordList write FWordList;
	end;

	TSymbolRange = class(TSyntaxRange)
	private
		FSymbol: string;
	protected
		function GetFont: TFont; override;
	public
		function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
	published
		property Symbol: string read FSymbol write FSymbol;
	end;

	TNumberRange = class(TSyntaxRange)
	private
		FNumber: string;
	protected
		function GetFont: TFont; override;
	public
		function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
	published
		property Number: string read FNumber write FNumber;
	end;

	TParenthesisRange = class(TSyntaxRange)
	private
		FStyle: TParenthesisStyle;
	protected
		procedure SetNewParenthesisLevel; override;
		function GetNextParenthesisLevel: Integer; override;
		function GetFont: TFont; override;
	public
		function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
		procedure UpdateParenthesisLevel; override;
	published
		property Style: TParenthesisStyle read FStyle write FStyle;
	end;

	TSyntaxColoring = class(TOwnedPersistent)
	private
		FNumberColor: TColor;
		FSymbolColor: TColor;
		FCustomStyles: TCustomStyles;
		FWordLists: TWordLists;
		FEnabled: Boolean;
		FUpdateDebth: Integer;
		FParenthesisColors: TStringList;
		FSymbolCustomStyle: Boolean;
		FNumberCustomStyle: Boolean;
		FNumberStyle: TFontStyles;
		FSymbolStyle: TFontStyles;
		FParenthesisCustomStyle: Boolean;
		FParenthesisStyle: TFontStyles;
		procedure SetCustomStyles(const Value: TCustomStyles);
		procedure SetNumberColor(const Value: TColor);
		procedure SetSymbolColor(const Value: TColor);
		procedure SetWordLists(const Value: TWordLists);
		procedure SetEnabled(const Value: Boolean);
		procedure SetParenthesisColors(const Value: TStringList);
		procedure SetNumberCustomStyle(const Value: Boolean);
		procedure SetNumberStyle(const Value: TFontStyles);
		procedure SetSymbolCustomStyle(const Value: Boolean);
		procedure SetSymbolStyle(const Value: TFontStyles);
		procedure SetParenthesisCustomStyle(const Value: Boolean);
		procedure SetParenthesisStyle(const Value: TFontStyles);
	protected
		SymbolFont,
		NumberFont,
		ParenthesisFont: TFont;
		procedure ChangeNotification(Sender: TObject);
	public
		constructor Create(AOwner: TPersistent); override;
		destructor Destroy; override;
		procedure ColoringChange; virtual;
		procedure Assign(Source: TPersistent); override;
		function GetParenthesisColor(Index: Integer): TColor;
		procedure BeginUpdate; virtual;
		procedure EndUpdate; virtual;
	published
		property Enabled: Boolean read FEnabled write SetEnabled;
		property SymbolColor: TColor read FSymbolColor write SetSymbolColor;
		property SymbolStyle: TFontStyles read FSymbolStyle write SetSymbolStyle;
		property SymbolCustomStyle: Boolean read FSymbolCustomStyle write SetSymbolCustomStyle;
		property NumberColor: TColor read FNumberColor write SetNumberColor;
		property NumberStyle: TFontStyles read FNumberStyle write SetNumberStyle;
		property NumberCustomStyle: Boolean read FNumberCustomStyle write SetNumberCustomStyle;
		property WordLists: TWordLists read FWordLists write SetWordLists;
		property CustomStyles: TCustomStyles read FCustomStyles write SetCustomStyles;
		property ParenthesisColors: TStringList read FParenthesisColors write SetParenthesisColors;
		property ParenthesisStyle: TFontStyles read FParenthesisStyle write SetParenthesisStyle;
		property ParenthesisCustomStyle: Boolean read FParenthesisCustomStyle write SetParenthesisCustomStyle;
	end;

	TWordLists = class(TCollection)
	private
		FColoring: TSyntaxColoring;
		function GetItem(Index: Integer): TWordList;
		procedure SetItem(Index: Integer; Value: TWordList);
	protected
		function GetOwner: TPersistent; override;
		procedure Update(Item: TCollectionItem); override;
	public
		constructor Create(AColoring: TSyntaxColoring);
		function Add: TWordList;
		function FindList(const S: string): TWordList;
		property Items[Index: Integer]: TWordList read GetItem write SetItem; default;
	end;

	TWordList = class(TCollectionItem)
	private
		FCustomStyle: Boolean;
		FCustomColor: Boolean;
		FColor: TColor;
		FStyle: TFontStyles;
		FWords: TStringList;
		FDisplayName: string;
		FCaseSensitive: Boolean;
		procedure SetColor(const Value: TColor);
		procedure SetCustomColor(const Value: Boolean);
		procedure SetCustomStyle(const Value: Boolean);
		procedure SetStyle(const Value: TFontStyles);
		procedure SetWords(const Value: TStringList);
		procedure SetCaseSensitive(const Value: Boolean);
	protected
		Font: TFont;
		function GetDisplayName: string; override;
		procedure SetDisplayName(const Value: string); override;
		procedure ListChange; virtual;
		procedure ChangeNotification(Sender: TObject);
	public
		constructor Create(Collection: TCollection); override;
		destructor Destroy; override;
		procedure Assign(Source: TPersistent); override;
		function WordInList(S: string): Boolean;
	published
		property Caption: string read FDisplayName write SetDisplayName;
		property CustomColor: Boolean read FCustomColor write SetCustomColor;
		property Color: TColor read FColor write SetColor;
		property CustomStyle: Boolean read FCustomStyle write SetCustomStyle;
		property Style: TFontStyles read FStyle write SetStyle;
		property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
		property Words: TStringList read FWords write SetWords;
	end;

	TCustomStyles = class(TCollection)
	private
		FColoring: TSyntaxColoring;
		function GetItem(Index: Integer): TCustomStyle;
		procedure SetItem(Index: Integer; Value: TCustomStyle);
	protected
		function GetOwner: TPersistent; override;
		procedure Update(Item: TCollectionItem); override;
	public
		constructor Create(AColoring: TSyntaxColoring);
		function Add: TCustomStyle;
		function FindStyle(const S: string): TCustomStyle;
		property Items[Index: Integer]: TCustomStyle read GetItem write SetItem; default;
	end;

	TCustomStyle = class(TCollectionItem)
	private
		FCustomStyle: Boolean;
		FCustomColor: Boolean;
		FEndText: string;
		FBeginText: string;
		FColor: TColor;
		FStyle: TFontStyles;
		FIgnoreChar: TIgnoreChar;
		FDisplayName: string;
		FSwitchable: Boolean;
		FLineStartOnly: Boolean;
    FIgnoreLeadingBlanks: Boolean;
		procedure SetBeginText(Value: string);
		procedure SetColor(const Value: TColor);
		procedure SetCustomColor(const Value: Boolean);
		procedure SetCustomStyle(const Value: Boolean);
		procedure SetEndText(Value: string);
		procedure SetIgnoreChar(const Value: TIgnoreChar);
		procedure SetStyle(const Value: TFontStyles);
		procedure SetSwitchable(const Value: Boolean);
		procedure SetLineStartOnly(const Value: Boolean);
    procedure SetIgnoreLeadingBlanks(const Value: Boolean);
	protected
		Font: TFont;
		function GetDisplayName: string; override;
		procedure SetDisplayName(const Value: string); override;
		procedure StyleChange; virtual;
	public
		constructor Create(Collection: TCollection); override;
		destructor Destroy; override;
		procedure Assign(Source: TPersistent); override;
	published
		property Caption: string read FDisplayName write SetDisplayName;
		property CustomColor: Boolean read FCustomColor write SetCustomColor;
		property Color: TColor read FColor write SetColor;
		property CustomStyle: Boolean read FCustomStyle write SetCustomStyle;
		property Style: TFontStyles read FStyle write SetStyle;
		property BeginText: string read FBeginText write SetBeginText;
		property EndText: string read FEndText write SetEndText;
		property IgnoreChar: TIgnoreChar read FIgnoreChar write SetIgnoreChar;
		property Switchable: Boolean read FSwitchable write SetSwitchable;
		property LineStartOnly: Boolean read FLineStartOnly write SetLineStartOnly;
		property IgnoreLeadingBlanks: Boolean read FIgnoreLeadingBlanks write SetIgnoreLeadingBlanks;
	end;

	TSyntaxColoringCopy = class(TComponent)
	private
		FNumberColor: TColor;
		FSymbolColor: TColor;
		FCustomStyles: TCustomStyles;
		FWordLists: TWordLists;
		FEnabled: Boolean;
		FParenthesisColors: TStringList;
		FSymbolCustomStyle: Boolean;
		FNumberCustomStyle: Boolean;
		FNumberStyle: TFontStyles;
		FSymbolStyle: TFontStyles;
		FParenthesisCustomStyle: Boolean;
		FParenthesisStyle: TFontStyles;
		procedure SetCustomStyles(const Value: TCustomStyles);
		procedure SetParenthesisColors(const Value: TStringList);
		procedure SetWordLists(const Value: TWordLists);
	protected
	public
		procedure Assign(Source: TPersistent); override;
	published
		constructor Create(AOwner: TComponent); override;
		destructor Destroy; override;
		property Enabled: Boolean read FEnabled write FEnabled;
		property SymbolColor: TColor read FSymbolColor write FSymbolColor;
		property SymbolStyle: TFontStyles read FSymbolStyle write FSymbolStyle;
		property SymbolCustomStyle: Boolean read FSymbolCustomStyle write FSymbolCustomStyle;
		property NumberColor: TColor read FNumberColor write FNumberColor;
		property NumberStyle: TFontStyles read FNumberStyle write FNumberStyle;
		property NumberCustomStyle: Boolean read FNumberCustomStyle write FNumberCustomStyle;
		property WordLists: TWordLists read FWordLists write SetWordLists;
		property CustomStyles: TCustomStyles read FCustomStyles write SetCustomStyles;
		property ParenthesisColors: TStringList read FParenthesisColors write SetParenthesisColors;
		property ParenthesisStyle: TFontStyles read FParenthesisStyle write FParenthesisStyle;
		property ParenthesisCustomStyle: Boolean read FParenthesisCustomStyle write FParenthesisCustomStyle;
	end;

	TSectionType = (stText, stSymbol, stParenthesis, stCustomStyle);

function CharIsWordable(Ch: Char): Boolean;
function CharIsIdentifier(Ch: Char): Boolean;
function CharIsExtNumber(Ch: Char): Boolean;
function CharIsNumber(Ch: Char): Boolean;
function CharIsSymbol(Ch: Char): Boolean;
function CharIsParenthesis(Ch: Char): Boolean;

procedure Register;

implementation

uses
	UtilsDos;

function CharIsWordable(Ch: Char): Boolean;
begin
	Result := CharIsIdentifier (Ch) or (Ch in ['#', '.', '+', '-']);
end;

function CharIsIdentifier(Ch: Char): Boolean;
begin
	Result := Ch in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$'];
end;

function CharIsExtNumber(Ch: Char): Boolean;
begin
	Result := CharIsNumber (Ch) or (Ch in ['#', '.']);
end;

function CharIsNumber(Ch: Char): Boolean;
begin
	Result := Ch in ['0'..'9'];
end;

function CharIsHexNumber(Ch: Char): Boolean;
begin
	Result := Ch in ['A'..'F', 'a'..'f', '0'..'9'];
end;

function CharIsSymbol(Ch: Char): Boolean;
begin
	Result := Ch in SymbolChars;
end;

function CharIsParenthesis(Ch: Char): Boolean;
begin
	Result := Ch in ['(', ')'];
end;

procedure Register;
begin
	RegisterComponents ('Edit Controls', [TSourceEdit]);
end;

{ TSourceEdit }

procedure TSourceEdit.CMFontChanged(var Message: TMessage);
begin
	inherited;
	if Assigned (SyntaxColoring) then
		SyntaxColoring.ColoringChange;
end;

constructor TSourceEdit.Create(AOwner: TComponent);
begin
	inherited;
	FSyntaxColoring := TSyntaxColoring.Create (Self);
	AutoIndent := True;
	FAutoIndentIncrease := False;
	FAutoIndentIncreaseStart := '{';
	FAutoIndentIncreaseEnd := '}';
	FSplitOnFly := False;
end;

function TSourceEdit.CreateSplitRanges(Range: TCustomRange): TFormattedRangeArray;
var
	RS,
	RE,
	TotalEnd: Integer;
	ExitHere: Boolean;
procedure AddRange(R: TCustomFormattedRange; AlwaysCopy: Boolean);
procedure UpdateRS;
begin
	RS := RE + 1;
	if RS < Range.RStart then
		RS := Range.RStart;
	if RS < R.RStart then
		RS := R.RStart;
end;
procedure SetRE(NewValue: Integer);
begin
	if NewValue < RE then
		NewValue := RE;
	RE := NewValue;
	if RE > Range.REnd then
		RE := Range.REnd;
	if RE > R.REnd then
		RE := R.REnd;
end;
begin
	UpdateRS;
	if Selection.RLength > 0 then begin
		SetRE (Selection.RStart - 1);
		if RE >= RS then begin
			SetLength (Result, Length (Result) + 1);
			if AlwaysCopy or (RS <> R.RStart) or (RE <> R.REnd) then begin
				Result [High (Result)] := TFormattedRange.Create (nil);
				with Result [High (Result)] do begin
					FreeWhenDone := True;
					Editor := Self;
					RStart := RS;
					REnd := RE;
					Font := R.Font;
					Color := Self.Color;
				end;
			end else
				Result [High (Result)] := R;
		end;
		UpdateRS;
		SetRE (Selection.REnd);
		if RE >= RS then begin
			SetLength (Result, Length (Result) + 1);
			Result [High (Result)] := TFormattedRange.Create (nil);
			with Result [High (Result)] do begin
				FreeWhenDone := True;
				Editor := Self;
				RStart := RS;
				REnd := RE;
				Font := R.Font;
				if HasFocus then begin
					Font.Color := clHighlightText;
					Color := clHighlight;
				end else
					Color := clSilver;
			end;
		end;
		UpdateRS;
	end;
	SetRE (R.REnd);
	if RE >= RS then begin
		SetLength (Result, Length (Result) + 1);
		if AlwaysCopy or (RS <> R.RStart) or (RE <> R.REnd) then begin
			Result [High (Result)] := TFormattedRange.Create (nil);
			with Result [High (Result)] do begin
				FreeWhenDone := True;
				Editor := Self;
				RStart := RS;
				REnd := RE;
				Font := R.Font;
				Color := Self.Color;
			end;
		end else
			Result [High (Result)] := R;
	end;
	if R.REnd >= TotalEnd then
		ExitHere := True;
end;
var
	I,
	J,
	LastStart: Integer;
	CurWord: string;
	IsNum: Boolean;
	WordStyle: TWordList;
	R: TCustomFormattedRange;
begin
	if SyntaxColoring.Enabled then begin
		ExitHere := False;
		TotalEnd := Range.REnd;
		SyntaxStartRange := SyntaxRangeAtPosWithHint (Range.RStart, SyntaxStartRange);
		RE := Range.RStart - 1;
		while Assigned (SyntaxStartRange) and (SyntaxStartRange.RStart <= Range.REnd) do begin
			if SyntaxStartRange is TCustomTextRange then begin
				CurWord := '';
				LastStart := SyntaxStartRange.RStart;
				for I := SyntaxStartRange.RStart to SyntaxStartRange.REnd + 1 do begin
					if I >= LastStart then begin
						if (I <= SyntaxStartRange.REnd) and CharIsWordable (Text [I]) and ((not CharIsSymbol (Text [I]) or ((Text [I] = '.') and (((Length (CurWord) <= 0) and (I + 1 <= Length (Text)) and CharIsNumber (Text [I + 1])) or ((Length (CurWord) > 0) and CharIsExtNumber (CurWord [1])))))) then
							CurWord := CurWord + Text [I]
						else begin
							if Length (CurWord) > 0 then begin
								IsNum := CharIsExtNumber (CurWord [1]);
								if (not IsNum) and (CurWord [1] = '$') and (Length (CurWord) > 1) then begin
									IsNum := True;
									for J := 2 to Length (CurWord) do
										if not CharIsHexNumber (CurWord [J]) then begin
											IsNum := False;
											Break;
										end;
								end;
								if IsNum then begin
									if I - Length (CurWord) > LastStart then begin
										R := TNormalTextRange.Create (nil);
										with R do try
											Editor := Self;
											RStart := LastStart;
											REnd := I - Length (CurWord) - 1;
											if RLength > 0 then
												AddRange (R, True);
										finally
											Free;
										end;
									end;
									R := TNumberRange.Create (nil);
									with R as TNumberRange do try
										Editor := Self;
										RStart := I - Length (CurWord);
										REnd := I - 1;
										Number := Text;
										if RLength > 0 then
											AddRange (R, True);
										LastStart := I;
									finally
										Free;
									end;
								end else begin
									WordStyle := SyntaxColoring.WordLists.FindList (CurWord);
									if Assigned (WordStyle) then begin
										if I - Length (CurWord) > LastStart then begin
											R := TNormalTextRange.Create (nil);
											with R do try
												Editor := Self;
												RStart := LastStart;
												REnd := I - Length (CurWord) - 1;
												if RLength > 0 then
													AddRange (R, True);
											finally
												Free;
											end;
										end;
										R := TWordListRange.Create (nil);
										with R as TWordListRange do try
											Editor := Self;
											RStart := I - Length (CurWord);
											REnd := I - 1;
											WordList := WordStyle;
											if RLength > 0 then
												AddRange (R, True);
											LastStart := I;
										finally
											Free;
										end;
									end;
								end;
								CurWord := '';
							end;
							if (I <= SyntaxStartRange.REnd) and CharIsSymbol (Text [I]) then begin
								if I > LastStart then begin
									R := TNormalTextRange.Create (nil);
									with R do try
										Editor := Self;
										RStart := LastStart;
										REnd := I - 1;
										if RLength > 0 then
											AddRange (R, True);
									finally
										Free;
									end;
								end;
								R := TSymbolRange.Create (nil);
								with R as TSymbolRange do try
									Editor := Self;
									RStart := I;
									LastStart := I;
									while (LastStart <= SyntaxStartRange.REnd) and CharIsSymbol (Self.Text [LastStart]) do
										Inc (LastStart);
									REnd := LastStart - 1;
									Symbol := Text;
									if RLength > 0 then
										AddRange (R, True);
								finally
									Free;
								end;
							end;
							if (I > SyntaxStartRange.REnd) and (I > LastStart) then begin
								R := TNormalTextRange.Create (nil);
								with R do try
									Editor := Self;
									RStart := LastStart;
									REnd := I - 1;
									LastStart := I;
									if RLength > 0 then
										AddRange (R, True);
								finally
									Free;
								end;
							end;
						end;
						if ExitHere then
							Break;
					end;
				end;
			end else
				AddRange (SyntaxStartRange, False);
			SyntaxStartRange := SyntaxStartRange.NextRange;
		end;
	end else
		Result := inherited CreateSplitRanges (Range);
	{$IFDEF SyntaxDebug}
		for I := Low (Result) + 1 to High (Result) do
			if Result[I-1].REnd + 1 <> Result[I].RStart then
				raise ESourceEdit.Create (SSourceEditError);
	{$ENDIF}
end;

destructor TSourceEdit.Destroy;
begin
	if Assigned (FSyntaxColoring) then begin
		FSyntaxColoring.FUpdateDebth := 100;
		FSyntaxColoring.Free;
	end;
	inherited;
end;

function TSourceEdit.FindSyntaxHole: TSyntaxRange;
begin
	Result := FirstSyntaxRange;
	if Assigned (Result) and (Result.RStart = 1) then begin
		if LastSyntaxRange.REnd <> TextLength then
			Result := LastSyntaxRange
		else
			while Assigned (Result) and ((not Assigned (Result.NextRange)) or (Result.REnd + 1 = Result.NextRange.RStart)) do
				Result := Result.NextRange;
	end;
end;

function TSourceEdit.FindSyntaxOverlap: TSyntaxRange;
begin
	Result := FirstSyntaxRange;
	while Assigned (Result) and ((not Assigned (Result.NextRange)) or (Result.REnd < Result.NextRange.RStart)) do
		Result := Result.NextRange;
end;

procedure TSourceEdit.FreeAllSyntaxRanges;
begin
	while Assigned (LastSyntaxRange) do
		LastSyntaxRange.Free;
end;

procedure TSourceEdit.KeyPress(var Key: Char);
var
	InsS: string;
	Rs,
	BeginLn,
	FirstChr: Integer;
begin
	if (Key = #13) and AutoIndent then
		with Selection do
			if AutoIndentIncrease and (RStart - 1 > 0) and (RStart - 1 <= TextLength) and (Self.Text [RStart - 1] = AutoIndentIncreaseStart) and (RStart - 2 > 0) and (not (Self.Text [RStart - 2] in [#9, #10, #13])) then begin
				BeginLn := CellToCharIdx (TextCell (StartRowCol.Row, 1));
				FirstChr := FirstNonWhiteSpace (Copy (Self.Text, BeginLn, RStart - BeginLn));
				InsS := #13#10 + Copy (Self.Text, BeginLn, FirstChr - 1) + #9;
				RS := RStart;
				Text := InsS + #13#10 + Copy (Self.Text, BeginLn, FirstChr - 1) + AutoIndentIncreaseEnd;
				NoSelAtPos (RS + Length (InsS));
				ScrollInView (4);
				Key := #0;
			end;
	if (Key = AutoIndentIncreaseStart) and AutoIndentIncrease then begin
		BeginLn := CellToCharIdx (TextCell (Selection.StartRowCol.Row, 1));
		FirstChr := FirstNonWhiteSpace (Copy (Text, BeginLn, Selection.RStart - BeginLn));
		if (BeginLn + FirstChr - 1 > TextLength) or (Text [BeginLn + FirstChr - 1] = #13) then begin
			InsS := Key + #13#10 + Copy (Self.Text, BeginLn, FirstChr - 1) + #9;
			with Selection do begin
				RS := RStart;
				Text := InsS + #13#10 + Copy (Self.Text, BeginLn, FirstChr - 1) + AutoIndentIncreaseEnd;
				NoSelAtPos (RS + Length (InsS));
				ScrollInView (4);
			end;
			Key := #0;
		end;
	end;
	inherited;
end;

function TSourceEdit.MakeDebuggableRanges: TDebuggableRanges;
var
	Range: TSyntaxRange;
begin
	Range := FirstSyntaxRange;
	while Assigned (Range) do begin
		SetLength (Result, Length (Result) + 1);
		with Result [High (Result)] do begin
			RStart := Range.RStart;
			REnd := Range.REnd;
			Text := Range.Text;
			ClassName := Range.ClassName;
		end;
		Range := Range.NextRange;
	end;
end;

procedure TSourceEdit.OverwriteRange(Sender: TObject);
begin
	Sender.Free;
end;

procedure TSourceEdit.ReColor;
begin
	if TextLength > 0 then begin
		Selection.HideCaret;
		FreeAllSyntaxRanges;
		ReColorRange (WholeText);
		while Assigned (LastPRange) do begin
			LastPRange.SetNewParenthesisLevel;
			LastPRange := LastPRange.NextRange;
		end;
		VisibleRange.DrawRange;
		Selection.UpdateCaretPos;
		Selection.ShowCaret;
	end;
end;

procedure TSourceEdit.ReColorRange(Range: TCustomRange);
var
	LastRange: TSyntaxRange;
	KeepRunning,
	EndingsEqual: Boolean;
	SectionStart,
	SectionLength,
	WordStart,
	CurPos: Integer;
	CustomStyle,
	NewCustomStyle: TCustomStyle;
	CurChar: Char;
	SectionType: TSectionType;
procedure ProcessSection;
var
	I,
	J,
	LastStart: Integer;
	CurWord: string;
	IsNum: Boolean;
	WordStyle: TWordList;
begin
	if SectionLength > 0 then begin
		case SectionType of
			stSymbol:
				with TSymbolRange (TSymbolRange.NewRangeInsertedBefore (LastRange, Self)) do begin
					RStart := SectionStart;
					RLength := SectionLength;
					Symbol := Text;
					EndingsEqual := ReplaceSyntaxRanges (LastRange);
				end;
			stParenthesis:
				with TParenthesisRange (TParenthesisRange.NewRangeInsertedBefore (LastRange, Self)) do begin
					RStart := SectionStart;
					RLength := SectionLength;
					if Self.Text [SectionStart] in [')', '}', ']'] then
						Style := psClosing
					else
						Style := psOpening;
					EndingsEqual := ReplaceSyntaxRanges (LastRange);
				end;
			stCustomStyle:
				with TCustomStyleRange (TCustomStyleRange.NewRangeInsertedBefore (LastRange, Self)) do begin
					RStart := SectionStart;
					RLength := SectionLength;
					Style := CustomStyle;
					EndingsEqual := ReplaceSyntaxRanges (LastRange);
				end;
			stText: begin
				if SplitOnFly then
					with TCustomTextRange (TCustomTextRange.NewRangeInsertedBefore (LastRange, Self)) do begin
						RStart := SectionStart;
						RLength := SectionLength;
						EndingsEqual := ReplaceSyntaxRanges (LastRange);
					end
				else begin
					CurWord := '';
					LastStart := SectionStart;
					for I := SectionStart to SectionStart + SectionLength do begin
						if (I < SectionStart + SectionLength) and CharIsWordable (Text [I]) then
							Insert (Text [I], CurWord, Length (CurWord) + 1)
						else begin
							if Length (CurWord) > 0 then begin
								IsNum := CharIsExtNumber (CurWord [1]);
								if (not IsNum) and (CurWord [1] = '$') and (Length (CurWord) > 1) then begin
									IsNum := True;
									for J := 2 to Length (CurWord) do
										if not CharIsHexNumber (CurWord [J]) then begin
											IsNum := False;
											Break;
										end;
								end;
								if IsNum then begin
									if I - Length (CurWord) > LastStart then
										with TNormalTextRange (TNormalTextRange.NewRangeInsertedBefore (LastRange, Self)) do begin
											RStart := LastStart;
											REnd := I - Length (CurWord) - 1;
											if RLength > 0 then
												EndingsEqual := ReplaceSyntaxRanges (LastRange)
											else
												Free;
										end;
									with TNumberRange (TNumberRange.NewRangeInsertedBefore (LastRange, Self)) do begin
										RStart := I - Length (CurWord);
										REnd := I - 1;
										Number := Text;
										EndingsEqual := ReplaceSyntaxRanges (LastRange);
										LastStart := I;
									end;
								end else begin
									WordStyle := SyntaxColoring.WordLists.FindList (CurWord);
									if Assigned (WordStyle) then begin
										if I - Length (CurWord) > LastStart then
											with TNormalTextRange (TNormalTextRange.NewRangeInsertedBefore (LastRange, Self)) do begin
												RStart := LastStart;
												REnd := I - Length (CurWord) - 1;
												if RLength > 0 then
													EndingsEqual := ReplaceSyntaxRanges (LastRange)
												else
													Free;
											end;
										with TWordListRange (TWordListRange.NewRangeInsertedBefore (LastRange, Self)) do begin
											RStart := I - Length (CurWord);
											REnd := I - 1;
											WordList := WordStyle;
											EndingsEqual := ReplaceSyntaxRanges (LastRange);
											LastStart := I;
										end;
									end;
								end;
								CurWord := '';
							end;
							if (I >= SectionStart + SectionLength) and (I > LastStart) then
								with TNormalTextRange (TNormalTextRange.NewRangeInsertedBefore (LastRange, Self)) do begin
									RStart := LastStart;
									REnd := I - 1;
									LastStart := I;
									if RLength > 0 then
										EndingsEqual := ReplaceSyntaxRanges (LastRange)
									else
										Free;
								end;
						end;
					end;
				end;
			end;
		end;
	end;
end;
procedure SetSectionType(NewType: TSectionType);
begin
	if SplitOnFly and (NewType = stSymbol) and (SectionLength <= MaxOnFlySectionLength) then
		NewType := stText;
	if (NewType <> SectionType) or (NewType = stParenthesis) or (NewType = stCustomStyle) then begin
		if SplitOnFly and (NewType = stSymbol) then
			NewType := stText;
		ProcessSection;
		SectionStart := CurPos;
		SectionLength := 0;
		WordStart := CurPos;
		SectionType := NewType;
	end;
end;
function LeadingTextOnlyHasBlanks: Boolean;
var
	I: Integer;
begin
	Result := True;
	I := CurPos - 1;
	while I >= 1 do begin
		if Text [I] in [#10, #13] then
			Break;
		if not (Text [I] in [#9, ' ']) then begin
			Result := False;
			Break;
		end;
		Dec (I);
	end;
end;
var
	I,
	L,
	P1,
	P2,
	BeginPos: Integer;
	B: Boolean;
	S,
	T: string;
begin
	if SyntaxColoring.FUpdateDebth = 0 then begin
		if SyntaxColoring.Enabled and (TextLength > 0) then begin
			Inc (SyntaxColoring.FUpdateDebth);
			LastRange := SyntaxRangeAtPos (Range.RStart - 1);
			if Assigned (LastRange) then begin
				if Assigned (LastRange.PrevRange) and (LastRange.PrevRange is TCustomStyleRange) and Assigned ((LastRange.PrevRange as TCustomStyleRange).Style) and (LastRange.PrevRange as TCustomStyleRange).Style.Switchable then
					LastRange := LastRange.PrevRange;
				if Range.RStart > LastRange.RStart then
					Range.RStart := LastRange.RStart;
			end else
				Range.RStart := 1;
			CurPos := Range.RStart;
			SectionStart := CurPos;
			SectionLength := 0;
			WordStart := CurPos;
			SectionType := stText;
			CustomStyle := nil;
			EndingsEqual := False;
			KeepRunning := False;
			while (CurPos <= TextLength) and ((CurPos <= Range.REnd + 2) or (not EndingsEqual) or KeepRunning) do begin
				EndingsEqual := False;
				CurChar := Text [CurPos];
				NewCustomStyle := SyntaxColoring.CustomStyles.FindStyle (Copy (Text, CurPos, MaxBeginEndTextLength));
				if Assigned (NewCustomStyle) and NewCustomStyle.LineStartOnly and (CurPos - 1 > 0) and (not (Text [CurPos - 1] in [#10, #13])) and ((not NewCustomStyle.IgnoreLeadingBlanks) or LeadingTextOnlyHasBlanks) then
					NewCustomStyle := nil;
				if Assigned (NewCustomStyle) and ((SectionType = stCustomStyle) and Assigned (CustomStyle) and (((NewCustomStyle = CustomStyle) and CustomStyle.Switchable) or (NewCustomStyle.EndText <> CustomStyle.EndText))) then
					NewCustomStyle := nil;
				KeepRunning := (SectionType = stCustomStyle) and Assigned (CustomStyle) and CustomStyle.Switchable and (not Assigned (NewCustomStyle));
				if KeepRunning then begin
					T := CustomStyle.EndText;
					S := Copy (Text, CurPos, Length (T));
					if (S = T) or ((T = ' ') and ((S = #9) or (S = #13))) then begin
						KeepRunning := False;
						I := CurPos - 1;
						while (I >= 1) and ((Text [I] = CustomStyle.IgnoreChar) or ((CustomStyle.IgnoreChar = '\') and (Copy (Text, I - 2, 3) = '??/'))) do begin
							KeepRunning := not KeepRunning;
							if Text [I] = CustomStyle.IgnoreChar then
								Dec (I)
							else
								Dec (I, 3);
						end;
					end;
				end;
				if not KeepRunning then begin
					if Assigned (NewCustomStyle) then begin
						SetSectionType (stCustomStyle);
						CustomStyle := NewCustomStyle;
						if CustomStyle.Switchable then begin
							KeepRunning := True;
							Inc (SectionLength);
							Inc (CurPos);
						end else begin
							repeat
								S := CustomStyle.EndText;
								BeginPos := CurPos + Length (CustomStyle.BeginText);
								repeat
									T := Copy (Text, BeginPos, CustomStyleCheckLength);
									P1 := Pos (S, T);
									if S = ' ' then begin
										P2 := Pos (#9, T);
										if (P2 > 0) and ((P1 <= 0) or (P2 < P1)) then
											P1 := P2;
										P2 := Pos (#13, T);
										if (P2 > 0) and ((P1 <= 0) or (P2 < P1)) then begin
											P1 := P2;
											S := #13;
										end;
									end;
									if P1 <= 0 then
										Inc (BeginPos, CustomStyleCheckLength - MaxBeginEndTextLength);
								until (P1 > 0) or (BeginPos > TextLength);
								CurPos := BeginPos + P1 + Length (S) - 2;
								B := (P1 <= 0) or (CurPos <= Length (S));
								if not B then begin
									B := True;
									I := CurPos - Length (S);
									while (I >= 1) and ((Text [I] = CustomStyle.IgnoreChar) or ((CustomStyle.IgnoreChar = '\') and (Copy (Text, I - 2, 3) = '??/'))) do begin
										B := not B;
										if Text [I] = CustomStyle.IgnoreChar then
											Dec (I)
										else
											Dec (I, 3);
									end;
								end;
							until B;
							if S = #13 then
								Inc (CurPos);
							if (P1 <= 0) or (CurPos <= Length (S)) or (CurPos > TextLength) then
								CurPos := TextLength;
							Inc (CurPos);
							SectionLength := CurPos - SectionStart;
							SetSectionType (stText);
						end;
						Continue;
					end else if (SectionType = stCustomStyle) and Assigned (CustomStyle) and CustomStyle.Switchable then begin
						if CustomStyle.EndText = #13 then
							L := 2
						else
							L := Length (CustomStyle.EndText);
						Inc (SectionLength, L);
						Inc (CurPos, L);
						SetSectionType (stText);
						Continue;
					end;
					if CharIsParenthesis (CurChar) then
						SetSectionType (stParenthesis)
					else if CurChar = '.' then begin
						if ((SectionType = stText) and CharIsNumber (Text [WordStart])) or ((CurPos + 1 <= TextLength) and CharIsNumber (Text [CurPos + 1])) then
							SetSectionType (stText)
						else
							SetSectionType (stSymbol);
					end else if CurChar in ['+', '-'] then begin
						if not ((CurPos - 2 >= 1) and CharIsExtNumber (Text [CurPos - 2]) and (CurPos - 1 >= 1) and (Text [CurPos - 1] in ['e', 'E', 'p', 'P'])) then
							SetSectionType (stSymbol);
					end else if CharIsSymbol (CurChar) then
						SetSectionType (stSymbol)
					else begin
						SetSectionType (stText);
						if not CharIsIdentifier (CurChar) then
							WordStart := CurPos;
					end;
				end;
				Inc (SectionLength);
				Inc (CurPos);
			end;
			Range.REnd := CurPos - 1;
			if CurPos > TextLength then
				ProcessSection;
			LastPRange := SyntaxRangeAtPosWithHint (Range.RStart, LastRange);
			Dec (SyntaxColoring.FUpdateDebth);
		end else
			FreeAllSyntaxRanges;
	end;
	{$IFDEF SyntaxDebug}
		if FindSyntaxHole <> nil then
			raise ESourceEdit.Create (SSourceEditError);
	{$ENDIF}
end;

procedure TSourceEdit.RemoveTrSpFromString(var Str: string;
	IncludeLastLine: Boolean);
var
	I: Integer;
	OK: Boolean;
begin
	if AutoIndentIncrease then begin
		OK := False;
		for I := 1 to Length (Str) do
			if not (Str [I] in [#13, #10, ' ', #9, AutoIndentIncreaseStart, AutoIndentIncreaseEnd]) then begin
				OK := True;
				break;
			end;
	end else
		OK := True;
	if OK then
		inherited;
end;

function TSourceEdit.ReplaceSyntaxRanges(NewRange: TSyntaxRange;
	var StartRange: TSyntaxRange): Boolean;
var
	PrevRange: TSyntaxRange;
begin
	Result := False;
	if not Assigned (StartRange) then
		StartRange := LastSyntaxRange;
	while Assigned (StartRange) and ((StartRange.RStart > NewRange.RStart) or (StartRange = NewRange)) do
		StartRange := StartRange.PrevRange;
	if not Assigned (StartRange) then
		StartRange := FirstSyntaxRange;
	while Assigned (StartRange) and ((StartRange.RStart < NewRange.RStart) or (StartRange = NewRange)) do
		StartRange := StartRange.NextRange;
	if (not Assigned (StartRange)) and (LastSyntaxRange <> NewRange) then
		StartRange := LastSyntaxRange;
	while Assigned (StartRange) and (StartRange <> NewRange) and ((StartRange.RStart <= NewRange.REnd) or (StartRange.REnd <= NewRange.REnd)) do begin
		Result := StartRange.EqualEndingsWith (NewRange);
		PrevRange := StartRange;
		StartRange := StartRange.NextRange;
		PrevRange.Free;
	end;
	{$IFDEF SyntaxDebug}
		if FindSyntaxOverlap <> nil then
			raise ESourceEdit.Create (SSourceEditError);
	{$ENDIF}
end;

procedure TSourceEdit.SetSplitOnFly(const Value: Boolean);
begin
	if FSplitOnFly <> Value then begin
		FSplitOnFly := Value;
		ReColor;
	end;
end;

procedure TSourceEdit.SetSyntaxColoring(const Value: TSyntaxColoring);
begin
	FSyntaxColoring.Assign (Value);
end;

function TSourceEdit.SyntaxRangeAtPos(RangePos: Integer): TSyntaxRange;
begin
	Result := FirstSyntaxRange;
	while Assigned (Result) and (Result.REnd < RangePos) do
		Result := Result.NextRange;
end;

function TSourceEdit.SyntaxRangeAtPosWithHint(RangePos: Integer;
	Hint: TSyntaxRange): TSyntaxRange;
begin
	if Assigned (Hint) then begin
		Result := Hint;
		while Assigned (Result) and (Result.REnd >= RangePos) do
			Result := Result.PrevRange;
		if not Assigned (Result) then
			Result := FirstSyntaxRange;
	end else
		Result := FirstSyntaxRange;
	while Assigned (Result) and (Result.REnd < RangePos) do
		Result := Result.NextRange;
end;

procedure TSourceEdit.TextChangeNotification(StartPos, OldLength,
	NewLength: Integer);
begin
	inherited;
	LastPRange := nil;
	LastCRange := TMCRange.Create (nil);
	with LastCRange do begin
		Editor := Self;
		RStart := StartPos;
		RLength := NewLength;
		ReColorRange (LastCRange);
	end;
end;

procedure TSourceEdit.TextChangeNotificationAfter;
begin
	inherited;
	if Assigned (LastCRange) then begin
		while Assigned (LastPRange) do begin
			if LastPRange.REnd <= LastCRange.REnd then
				LastPRange.SetNewParenthesisLevel
			else
				LastPRange.UpdateParenthesisLevel;
			LastPRange := LastPRange.NextRange;
		end;
		LastCRange.DrawRange;
		LastCRange.Free;
		LastCRange := nil;
	end;
end;

procedure TSourceEdit.WMKeyDown(var Message: TWMKeyDown);
var
	Shift: TShiftState;
begin
	if Message.CharCode = vk_Tab then begin
		Shift := KeyDataToShiftState (Message.KeyData);
		if ssShift in Shift then
			ChangeIndent (-1)
		else if (Selection.RLength > 0) and (Selection.EndRowCol.Row > Selection.StartRowCol.Row) then
			ChangeIndent (1)
		else
			inherited;
	end else
		inherited;
end;

{ TSyntaxColoring }

procedure TSyntaxColoring.Assign(Source: TPersistent);
begin
	if Source is TSyntaxColoring then begin
		BeginUpdate;
		FEnabled := TSyntaxColoring(Source).Enabled;
		FSymbolColor := TSyntaxColoring(Source).SymbolColor;
		FSymbolStyle := TSyntaxColoring(Source).SymbolStyle;
		FSymbolCustomStyle := TSyntaxColoring(Source).SymbolCustomStyle;
		FNumberColor := TSyntaxColoring(Source).NumberColor;
		FNumberStyle := TSyntaxColoring(Source).NumberStyle;
		FNumberCustomStyle := TSyntaxColoring(Source).NumberCustomStyle;
		FWordLists.Assign (TSyntaxColoring(Source).WordLists);
		FCustomStyles.Assign (TSyntaxColoring(Source).CustomStyles);
		FParenthesisColors.Assign (TSyntaxColoring(Source).ParenthesisColors);
		FParenthesisStyle := TSyntaxColoring(Source).ParenthesisStyle;
		FParenthesisCustomStyle := TSyntaxColoring(Source).ParenthesisCustomStyle;
		EndUpdate;
	end else if Source is TSyntaxColoringCopy then begin
		BeginUpdate;
		FEnabled := TSyntaxColoringCopy(Source).Enabled;
		FSymbolColor := TSyntaxColoringCopy(Source).SymbolColor;
		FSymbolStyle := TSyntaxColoringCopy(Source).SymbolStyle;
		FSymbolCustomStyle := TSyntaxColoringCopy(Source).SymbolCustomStyle;
		FNumberColor := TSyntaxColoringCopy(Source).NumberColor;
		FNumberStyle := TSyntaxColoringCopy(Source).NumberStyle;
		FNumberCustomStyle := TSyntaxColoringCopy(Source).NumberCustomStyle;
		FWordLists.Assign (TSyntaxColoringCopy(Source).WordLists);
		FCustomStyles.Assign (TSyntaxColoringCopy(Source).CustomStyles);
		FParenthesisColors.Assign (TSyntaxColoringCopy(Source).ParenthesisColors);
		FParenthesisStyle := TSyntaxColoringCopy(Source).ParenthesisStyle;
		FParenthesisCustomStyle := TSyntaxColoringCopy(Source).ParenthesisCustomStyle;
		EndUpdate;
	end else
		inherited Assign (Source);
end;

procedure TSyntaxColoring.BeginUpdate;
begin
	Inc (FUpdateDebth);
end;

procedure TSyntaxColoring.ChangeNotification(Sender: TObject);
begin
	ColoringChange;
end;

procedure TSyntaxColoring.ColoringChange;
var
	I: Integer;
begin
	if FUpdateDebth = 0 then
		if Assigned (Owner) then
			if Owner is TSourceEdit then
				with Owner as TSourceEdit do begin
					with SymbolFont do begin
						Assign (Font);
						Color := SymbolColor;
						if SymbolCustomStyle then
							Style := SymbolStyle;
					end;
					with NumberFont do begin
						Assign (Font);
						Color := NumberColor;
						if NumberCustomStyle then
							Style := NumberStyle;
					end;
					with ParenthesisFont do begin
						Assign (Font);
						Color := GetParenthesisColor (0);
						if ParenthesisCustomStyle then
							Style := ParenthesisStyle;
					end;
					with WordLists do
						for I := 0 to Count - 1 do
							with Items[I].Font do begin
								Assign (Font);
								if Items[I].CustomColor then
									Color := Items[I].Color;
								if Items[I].CustomStyle then
									Style := Items[I].Style;
							end;
					with CustomStyles do
						for I := 0 to Count - 1 do
							with Items[I].Font do begin
								Assign (Font);
								if Items[I].CustomColor then
									Color := Items[I].Color;
								if Items[I].CustomStyle then
									Style := Items[I].Style;
							end;
					ReColor;
				end;
end;

constructor TSyntaxColoring.Create(AOwner: TPersistent);
begin
	inherited;
	SymbolFont := TFont.Create;
	NumberFont := TFont.Create;
	ParenthesisFont := TFont.Create;
	FWordLists := TWordLists.Create (Self);
	FCustomStyles := TCustomStyles.Create (Self);
	FParenthesisColors := TStringList.Create;
	FParenthesisColors.Duplicates := dupAccept;
	FParenthesisColors.Add ('$000000');
	FParenthesisColors.OnChange := ChangeNotification;
	FNumberColor := clGreen;
	FSymbolColor := clOlive;
	FEnabled := True;
end;

destructor TSyntaxColoring.Destroy;
begin
	FParenthesisColors.Free;
	FCustomStyles.Free;
	FWordLists.Free;
	NumberFont.Free;
	SymbolFont.Free;
	ParenthesisFont.Free;
	inherited;
end;

procedure TSyntaxColoring.EndUpdate;
begin
	Dec (FUpdateDebth);
	if FUpdateDebth = 0 then
		ColoringChange;
end;

function TSyntaxColoring.GetParenthesisColor(Index: Integer): TColor;
begin
	with ParenthesisColors do
		if (Count <= 0) or (Index < 0) then
			Result := clWindowText
		else
			try
				Result := StrToInt (Strings [Index mod Count]);
			except
				Result := clWindowText;
			end;
end;

procedure TSyntaxColoring.SetCustomStyles(const Value: TCustomStyles);
begin
	FCustomStyles.Assign (Value);
	ColoringChange;
end;

procedure TSyntaxColoring.SetEnabled(const Value: Boolean);
begin
	if FEnabled <> Value then begin
		FEnabled := Value;
		ColoringChange;
	end;
end;

procedure TSyntaxColoring.SetNumberColor(const Value: TColor);
begin
	if FNumberColor <> Value then begin
		FNumberColor := Value;
		ColoringChange;
	end;
end;

procedure TSyntaxColoring.SetNumberCustomStyle(const Value: Boolean);
begin
	if FNumberCustomStyle <> Value then begin
		FNumberCustomStyle := Value;
		ColoringChange;
	end;
end;

procedure TSyntaxColoring.SetNumberStyle(const Value: TFontStyles);
begin
	if FNumberStyle <> Value then begin
		FNumberStyle := Value;
		ColoringChange;
	end;
end;

procedure TSyntaxColoring.SetParenthesisColors(const Value: TStringList);
begin
	FParenthesisColors.Assign (Value);
end;

procedure TSyntaxColoring.SetParenthesisCustomStyle(const Value: Boolean);
begin
	if FParenthesisCustomStyle <> Value then begin
		FParenthesisCustomStyle := Value;
		ColoringChange;
	end;
end;

procedure TSyntaxColoring.SetParenthesisStyle(const Value: TFontStyles);
begin
	if FParenthesisStyle <> Value then begin
		FParenthesisStyle := Value;
		ColoringChange;
	end;
end;

procedure TSyntaxColoring.SetSymbolColor(const Value: TColor);
begin
	if FSymbolColor <> Value then begin
		FSymbolColor := Value;
		ColoringChange;
	end;
end;

procedure TSyntaxColoring.SetSymbolCustomStyle(const Value: Boolean);
begin
	if FSymbolCustomStyle <> Value then begin
		FSymbolCustomStyle := Value;
		ColoringChange;
	end;
end;

procedure TSyntaxColoring.SetSymbolStyle(const Value: TFontStyles);
begin
	if FSymbolStyle <> Value then begin
		FSymbolStyle := Value;
		ColoringChange;
	end;
end;

procedure TSyntaxColoring.SetWordLists(const Value: TWordLists);
begin
	FWordLists.Assign (Value);
	ColoringChange;
end;

{ TWordLists }

function TWordLists.Add: TWordList;
begin
	Result := TWordList (inherited Add);
end;

constructor TWordLists.Create(AColoring: TSyntaxColoring);
begin
	inherited Create (TWordList);
	FColoring := AColoring;
end;

function TWordLists.FindList(const S: string): TWordList;
var
	I: Integer;
begin
	Result := nil;
	for I := 0 to Count - 1 do
		if Items[I].WordInList (S) then begin
			Result := Items [I];
			Break;
		end;
end;

function TWordLists.GetItem(Index: Integer): TWordList;
begin
	Result := TWordList (inherited GetItem (Index));
end;

function TWordLists.GetOwner: TPersistent;
begin
	Result := FColoring;
end;

procedure TWordLists.SetItem(Index: Integer; Value: TWordList);
begin
	inherited SetItem (Index, Value);
end;

procedure TWordLists.Update(Item: TCollectionItem);
begin
	if Assigned (Item) then
		TWordList(Item).ListChange
	else
		if Assigned (FColoring) then
			FColoring.ColoringChange;
end;

{ TWordList }

procedure TWordList.Assign(Source: TPersistent);
begin
	if Source is TWordList then begin
		Caption := TWordList(Source).Caption;
		FCustomColor := TWordList(Source).CustomColor;
		FColor := TWordList(Source).Color;
		FCustomStyle := TWordList(Source).CustomStyle;
		FStyle := TWordList(Source).Style;
		FCaseSensitive := TWordList(Source).CaseSensitive;
		FWords.Assign (TWordList(Source).Words);
		ListChange;
	end else
		inherited Assign (Source);
end;

procedure TWordList.ChangeNotification(Sender: TObject);
begin
	ListChange;
end;

constructor TWordList.Create(Collection: TCollection);
begin
	inherited;
	Font := TFont.Create;
	FWords := TStringList.Create;
	FWords.Sorted := True;
	FWords.Duplicates := dupAccept;
	FWords.OnChange := ChangeNotification;
	FColor := clBlue;
	FCustomColor := True;
	FCaseSensitive := True;
end;

destructor TWordList.Destroy;
begin
	FWords.Free;
	Font.Free;
	inherited;
end;

function TWordList.GetDisplayName: string;
begin
	if FDisplayName = '' then
		Result := inherited GetDisplayName
	else
		Result := FDisplayName;
end;

procedure TWordList.ListChange;
begin
	if Assigned (Collection) then
		with TWordLists (Collection) do
			if Assigned (FColoring) then
				FColoring.ColoringChange;
end;

procedure TWordList.SetCaseSensitive(const Value: Boolean);
begin
	if FCaseSensitive <> Value then begin
		FCaseSensitive := Value;
		ListChange;
	end;
end;

procedure TWordList.SetColor(const Value: TColor);
begin
	if FColor <> Value then begin
		FColor := Value;
		ListChange;
	end;
end;

procedure TWordList.SetCustomColor(const Value: Boolean);
begin
	if FCustomColor <> Value then begin
		FCustomColor := Value;
		ListChange;
	end;
end;

procedure TWordList.SetCustomStyle(const Value: Boolean);
begin
	if FCustomStyle <> Value then begin
		FCustomStyle := Value;
		ListChange;
	end;
end;

procedure TWordList.SetDisplayName(const Value: string);
begin
	if FDisplayName <> Value then begin
		FDisplayName := Value;
		inherited;
	end;
end;

procedure TWordList.SetStyle(const Value: TFontStyles);
begin
	if FStyle <> Value then begin
		FStyle := Value;
		ListChange;
	end;
end;

procedure TWordList.SetWords(const Value: TStringList);
begin
	FWords.Assign (Value);
	ListChange;
end;

function TWordList.WordInList(S: string): Boolean;
var
	I: Integer;
begin
	if CaseSensitive then
		Result := Words.Find (S, I) and (I >= 0) and (I < Words.Count) and (S = Words.Strings [I])
	else
		Result := Words.Find (S, I) or ((I >= 0) and (I < Words.Count) and (UpperCase (S) = UpperCase (Words.Strings [I])));
end;

{ TCustomStyles }

function TCustomStyles.Add: TCustomStyle;
begin
	Result := TCustomStyle (inherited Add);
end;

constructor TCustomStyles.Create(AColoring: TSyntaxColoring);
begin
	inherited Create (TCustomStyle);
	FColoring := AColoring;
end;

function TCustomStyles.FindStyle(const S: string): TCustomStyle;
var
	I: Integer;
begin
	Result := nil;
	if S <> '' then
		for I := 0 to Count - 1 do
			if Items[I].BeginText = Copy (S, 1, Length (Items[I].BeginText)) then begin
				Result := Items [I];
				Break;
			end;
end;

function TCustomStyles.GetItem(Index: Integer): TCustomStyle;
begin
	Result := TCustomStyle (inherited GetItem (Index));
end;

function TCustomStyles.GetOwner: TPersistent;
begin
	Result := FColoring;
end;

procedure TCustomStyles.SetItem(Index: Integer; Value: TCustomStyle);
begin
	inherited SetItem (Index, Value);
end;

procedure TCustomStyles.Update(Item: TCollectionItem);
begin
	if Assigned (FColoring) then
		FColoring.ColoringChange;
end;

{ TCustomStyle }

procedure TCustomStyle.Assign(Source: TPersistent);
begin
	if Source is TCustomStyle then begin
		Caption := TCustomStyle(Source).Caption;
		FCustomColor := TCustomStyle(Source).CustomColor;
		FColor := TCustomStyle(Source).Color;
		FCustomStyle := TCustomStyle(Source).CustomStyle;
		FStyle := TCustomStyle(Source).Style;
		FBeginText := TCustomStyle(Source).BeginText;
		FEndText := TCustomStyle(Source).EndText;
		FIgnoreChar := TCustomStyle(Source).IgnoreChar;
		FSwitchable := TCustomStyle(Source).Switchable;
		FLineStartOnly := TCustomStyle(Source).LineStartOnly;
		FIgnoreLeadingBlanks := TCustomStyle(Source).IgnoreLeadingBlanks;
		StyleChange;
	end else
		inherited Assign (Source);
end;

constructor TCustomStyle.Create(Collection: TCollection);
begin
	inherited;
	Font := TFont.Create;
	FColor := clMaroon;
	FCustomColor := True;
end;

destructor TCustomStyle.Destroy;
begin
	Font.Free;
	inherited;
end;

function TCustomStyle.GetDisplayName: string;
begin
	if FDisplayName = '' then
		Result := inherited GetDisplayName
	else
		Result := FDisplayName;
end;

procedure TCustomStyle.SetBeginText(Value: string);
begin
	if Value = '#13' then
		Value := #13;
	if FBeginText <> Value then begin
		FBeginText := Value;
		StyleChange;
	end;
end;

procedure TCustomStyle.SetColor(const Value: TColor);
begin
	if FColor <> Value then begin
		FColor := Value;
		StyleChange;
	end;
end;

procedure TCustomStyle.SetCustomColor(const Value: Boolean);
begin
	if FCustomColor <> Value then begin
		FCustomColor := Value;
		StyleChange;
	end;
end;

procedure TCustomStyle.SetCustomStyle(const Value: Boolean);
begin
	if FCustomStyle <> Value then begin
		FCustomStyle := Value;
		StyleChange;
	end;
end;

procedure TCustomStyle.SetDisplayName(const Value: string);
begin
	FDisplayName := Value;
end;

procedure TCustomStyle.SetEndText(Value: string);
begin
	if Value = '#13' then
		Value := #13;
	if FEndText <> Value then begin
		FEndText := Value;
		StyleChange;
	end;
end;

procedure TCustomStyle.SetIgnoreChar(const Value: TIgnoreChar);
begin
	if FIgnoreChar <> Value then begin
		FIgnoreChar := Value;
		StyleChange;
	end;
end;

procedure TCustomStyle.SetIgnoreLeadingBlanks(const Value: Boolean);
begin
	if FIgnoreLeadingBlanks <> Value then begin
		FIgnoreLeadingBlanks := Value;
		StyleChange;
	end;
end;

procedure TCustomStyle.SetLineStartOnly(const Value: Boolean);
begin
	if FLineStartOnly <> Value then begin
		FLineStartOnly := Value;
		StyleChange;
	end;
end;

procedure TCustomStyle.SetStyle(const Value: TFontStyles);
begin
	if FStyle <> Value then begin
		FStyle := Value;
		StyleChange;
	end;
end;

procedure TCustomStyle.SetSwitchable(const Value: Boolean);
begin
	if FSwitchable <> Value then begin
		FSwitchable := Value;
		StyleChange;
	end;
end;

procedure TCustomStyle.StyleChange;
begin
	if Assigned (Collection) then
		with TCustomStyles (Collection) do
			if Assigned (FColoring) then
				FColoring.ColoringChange;
end;

{ TSyntaxColoringCopy }

procedure TSyntaxColoringCopy.Assign(Source: TPersistent);
begin
	if Source is TSyntaxColoring then begin
		FEnabled := TSyntaxColoring(Source).Enabled;
		FSymbolColor := TSyntaxColoring(Source).SymbolColor;
		FSymbolStyle := TSyntaxColoring(Source).SymbolStyle;
		FSymbolCustomStyle := TSyntaxColoring(Source).SymbolCustomStyle;
		FNumberColor := TSyntaxColoring(Source).NumberColor;
		FNumberStyle := TSyntaxColoring(Source).NumberStyle;
		FNumberCustomStyle := TSyntaxColoring(Source).NumberCustomStyle;
		FWordLists.Assign (TSyntaxColoring(Source).WordLists);
		FCustomStyles.Assign (TSyntaxColoring(Source).CustomStyles);
		FParenthesisColors.Assign (TSyntaxColoring(Source).ParenthesisColors);
		FParenthesisStyle := TSyntaxColoring(Source).ParenthesisStyle;
		FParenthesisCustomStyle := TSyntaxColoring(Source).ParenthesisCustomStyle;
	end else
		inherited Assign (Source);
end;

constructor TSyntaxColoringCopy.Create(AOwner: TComponent);
begin
	inherited;
	FWordLists := TWordLists.Create (nil);
	FCustomStyles := TCustomStyles.Create (nil);
	FParenthesisColors := TStringList.Create;
	FParenthesisColors.Duplicates := dupAccept;
	FParenthesisColors.Add ('$000000');
	FNumberColor := clGreen;
	FSymbolColor := clOlive;
	FEnabled := True;
end;

destructor TSyntaxColoringCopy.Destroy;
begin
	FParenthesisColors.Free;
	FCustomStyles.Free;
	FWordLists.Free;
	inherited;
end;

procedure TSyntaxColoringCopy.SetCustomStyles(const Value: TCustomStyles);
begin
	FCustomStyles.Assign (Value);
end;

procedure TSyntaxColoringCopy.SetParenthesisColors(
	const Value: TStringList);
begin
	FParenthesisColors.Assign (Value);
end;

procedure TSyntaxColoringCopy.SetWordLists(const Value: TWordLists);
begin
	FWordLists.Assign (Value);
end;

{ TSyntaxRange }

destructor TSyntaxRange.Destroy;
begin
	if Assigned (Collection) and (not (Collection as TMCRanges).FDestroying) then begin
		if Assigned (Editor) and ((Editor as TSourceEdit).SyntaxStartRange = Self) then
			(Editor as TSourceEdit).SyntaxStartRange := nil;
		if Assigned (PrevRange) then
			PrevRange.NextRange := NextRange
		else if Assigned (Editor) then
			(Editor as TSourceEdit).FirstSyntaxRange := NextRange;
		if Assigned (NextRange) then
			NextRange.PrevRange := PrevRange
		else if Assigned (Editor) then
			(Editor as TSourceEdit).LastSyntaxRange := PrevRange;
	end;
	inherited;
end;

class function TSyntaxRange.EqualEndings(Range1,
	Range2: TSyntaxRange): Boolean;
begin
	Result := Assigned (Range1) and Assigned (Range2) and Range1.EqualEndingsWith (Range2);
end;

function TSyntaxRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
begin
	Result := REnd = Range.REnd;
end;

function TSyntaxRange.GetColor: TColor;
begin
	if Assigned (Editor) then
		Result := Editor.Color
	else
		Result := clWindow;
end;

function TSyntaxRange.GetNextParenthesisLevel: Integer;
begin
	Result := ParenthesisLevel;
end;

function TSyntaxRange.InsertAfter(RangeClass: TSyntaxRangeClass):
	TSyntaxRange;
begin
	Result := InsertRangeBefore (NextRange, RangeClass, Editor as TSourceEdit);
end;

function TSyntaxRange.InsertBefore(RangeClass: TSyntaxRangeClass):
	TSyntaxRange;
begin
	Result := InsertRangeBefore (Self, RangeClass, Editor as TSourceEdit);
end;

class function TSyntaxRange.InsertRangeBefore(Range: TSyntaxRange;
	RangeClass: TSyntaxRangeClass; Editor: TSourceEdit): TSyntaxRange;
	// If Range is nil, new item is inserted at the end.
begin
	if Assigned (Editor) then begin
		Result := RangeClass.Create (Editor.TrackedRanges);
		Result.OnOverwrite := Editor.OverwriteRange;
		if Assigned (Range) then
			Result.PrevRange := Range.PrevRange
		else
			Result.PrevRange := Editor.LastSyntaxRange;
		Result.NextRange := Range;
		if Assigned (Range) then begin
			if Assigned (Range.PrevRange) then
				Range.PrevRange.NextRange := Result
			else
				Editor.FirstSyntaxRange := Result;
		end else begin
			if not Assigned (Editor.FirstSyntaxRange) then
				Editor.FirstSyntaxRange := Result;
			if Assigned (Editor.LastSyntaxRange) then
				Editor.LastSyntaxRange.NextRange := Result;
			Editor.LastSyntaxRange := Result;
		end;
		if Assigned (Range) then
			Range.PrevRange := Result;
	end else
		raise ESourceEdit.Create (SSourceEditError);
end;

class function TSyntaxRange.NewRangeInsertedAfter(Range: TSyntaxRange;
	Editor: TSourceEdit): TSyntaxRange;
begin
	if Assigned (Range) then
		Result := InsertRangeBefore (Range.NextRange, Self, Editor)
	else
		Result := nil;
end;

class function TSyntaxRange.NewRangeInsertedBefore(Range: TSyntaxRange;
	Editor: TSourceEdit): TSyntaxRange;
begin
	Result := InsertRangeBefore (Range, Self, Editor);
end;

function TSyntaxRange.ReplaceSyntaxRanges(var StartRange: TSyntaxRange):
	Boolean;
begin
	if Assigned (Editor) and (Editor is TSourceEdit) then
		Result := TSourceEdit(Editor).ReplaceSyntaxRanges (Self, StartRange)
	else
		Result := False;
end;

procedure TSyntaxRange.SetNewParenthesisLevel;
begin
	if Assigned (PrevRange) then
		ParenthesisLevel := PrevRange.NextParenthesisLevel
	else
		ParenthesisLevel := 0;
end;

procedure TSyntaxRange.UpdateParenthesisLevel;
begin
	SetNewParenthesisLevel;
end;

{ TNormalTextRange }

function TNormalTextRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
begin
	Result := (Range is TNormalTextRange) and (inherited EqualEndingsWith (Range));
end;

function TNormalTextRange.GetFont: TFont;
begin
	if Assigned (Editor) then
		Result := Editor.Font
	else
		Result := nil;
end;

{ TCustomStyleRange }

function TCustomStyleRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
begin
	Result := (Range is TCustomStyleRange) and (inherited EqualEndingsWith (Range)) and (Style = TCustomStyleRange(Range).Style);
end;

function TCustomStyleRange.GetFont: TFont;
begin
	if Assigned (Style) then
		Result := Style.Font
	else
		Result := nil;
end;

{ TWordListRange }

function TWordListRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
begin
	Result := (Range is TWordListRange) and (inherited EqualEndingsWith (Range)) and (WordList = TWordListRange(Range).WordList);
end;

function TWordListRange.GetFont: TFont;
begin
	Result := WordList.Font;
end;

{ TSymbolRange }

function TSymbolRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
begin
	Result := (Range is TSymbolRange) and (inherited EqualEndingsWith (Range)) and (Symbol = TSymbolRange(Range).Symbol);
end;

function TSymbolRange.GetFont: TFont;
begin
	if Assigned (Editor) then begin
		with Editor as TSourceEdit do
			if SyntaxColoring.Enabled then
				Result := SyntaxColoring.SymbolFont
			else
				Result := Font;
	end else
		Result := nil;
end;

{ TNumberRange }

function TNumberRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
begin
	Result := (Range is TNumberRange) and (inherited EqualEndingsWith (Range)) and (Number = TNumberRange(Range).Number);
end;

function TNumberRange.GetFont: TFont;
begin
	if Assigned (Editor) then begin
		with Editor as TSourceEdit do
			if SyntaxColoring.Enabled then
				Result := SyntaxColoring.NumberFont
			else
				Result := Font;
	end else
		Result := nil;
end;

{ TParenthesisRange }

function TParenthesisRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
begin
	Result := (Range is TParenthesisRange) and (inherited EqualEndingsWith (Range)) and (Style = TParenthesisRange(Range).Style);
end;

function TParenthesisRange.GetFont: TFont;
begin
	if Assigned (Editor) then begin
		with Editor as TSourceEdit do
			if SyntaxColoring.Enabled then begin
				Result := SyntaxColoring.ParenthesisFont;
				Result.Color := SyntaxColoring.GetParenthesisColor (ParenthesisLevel - 1);
			end else
				Result := Font;
	end else
		Result := nil;
end;

function TParenthesisRange.GetNextParenthesisLevel: Integer;
begin
	if Style = psOpening then
		Result := inherited GetNextParenthesisLevel
	else
		Result := inherited GetNextParenthesisLevel - 1;
end;

procedure TParenthesisRange.SetNewParenthesisLevel;
begin
	if Style = psClosing then
		inherited SetNewParenthesisLevel
	else
		if Assigned (PrevRange) then
			ParenthesisLevel := PrevRange.NextParenthesisLevel + 1
		else
			ParenthesisLevel := 1;
end;

procedure TParenthesisRange.UpdateParenthesisLevel;
var
	Lev: Integer;
begin
	Lev := ParenthesisLevel;
	inherited;
	if Lev <> ParenthesisLevel then
		DrawRange;
end;

{ TCustomTextRange }

function TCustomTextRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
begin
	Result := (Range is TCustomTextRange) and (inherited EqualEndingsWith (Range));
end;

function TCustomTextRange.GetFont: TFont;
begin
	if Assigned (Editor) then
		Result := Editor.Font
	else
		Result := nil;
end;

end.
