Стартовый пул

EControl/.gitignore

@@ -0,0 +1,26 @@
+*.exe
+*.rar
+*.zip
+*.dbg
+*.ico
+*.dll
+*.bpl
+*.bpi
+*.dcp
+*.so
+*.apk
+*.drc
+*.map
+*.dres
+*.rsm
+*.tds
+*.dcu
+*.dof
+*.deb
+*.ppu
+*.bak
+*.lps
+*.ini
+
+lib/
+backup/

EControl/ec/eclists.pas

@@ -0,0 +1,612 @@
+{ *************************************************************************** }
+{                                                                             }
+{ EControl Common Library                                                     }
+{                                                                             }
+{ Copyright (c) 2004 - 2015 EControl Ltd., Zaharov Michael                    }
+{     www.econtrol.ru                                                         }
+{     support@econtrol.ru                                                     }
+{                                                                             }
+{ *************************************************************************** }
+
+{$mode delphi}
+{$define EC_UNICODE}
+
+unit ecLists;
+
+interface
+
+uses Classes;
+
+type
+  TSortedItem = class
+  protected
+    function GetKey: integer; virtual; abstract;
+  end;
+
+  TSortedList = class
+  private
+    FList: TList;
+    function GetCount: integer;
+    function GetItem(Index: integer): TSortedItem;
+  public
+    constructor Create(OwnObjects: Boolean);
+    destructor Destroy; override;
+
+    function Add(Item: TSortedItem): integer;
+    procedure Delete(Index: integer);
+    procedure Remove(Item: TSortedItem);
+    procedure Clear;
+    function PriorAt(Pos: integer): integer;
+    function GetAt(Pos: integer): TSortedItem;
+    function GetIndexAt(Pos: integer): integer;
+
+    property Items[Index: integer]: TSortedItem read GetItem; default;
+    property Count: integer read GetCount;
+  end;
+
+  TRange = class(TSortedItem)
+  private
+    function GetLength: integer;
+  {$IFDEF EC_DOTNET}
+  public
+  {$ELSE}
+  protected
+  {$ENDIF}
+    FStartPos: integer;
+    FEndPos: integer;
+  protected
+    function GetKey: integer; override;
+  public
+    constructor Create(AStartPos, AEndPos: integer);
+    property StartPos: integer read FStartPos;
+    property EndPos: integer read FEndPos;
+    property Size: integer read GetLength;
+  end;
+
+  // Array of sorted ranges
+  TRangeList = class
+  private
+    FList: TList;
+    FUnionSiblings: Boolean;
+    FPrevIdx: integer;
+    function GetCount: integer;
+    function GetItems(Index: integer): TRange;
+  protected
+    // Union ranges with the [Index] and [Index + 1]
+    // returns new range index (or union result)
+    function UnionRanges(Index: integer): integer; virtual;
+    function IsGreater(I1, I2: integer): Boolean;
+    // Try to add range if there are no intersections
+    function TryAdd(Range: TRange): Boolean;
+  public
+    constructor Create(UnionSiblings: Boolean = True);
+    destructor Destroy; override;
+    function Add(Range: TRange): integer; virtual;
+    procedure Delete(Index: integer);
+    procedure Clear; virtual;
+    function ClearFromPos(APos: integer; CopyTo: TRangeList = nil): integer; virtual;
+    // Deletes ranges that intersect the bounds, returns number of deleted items
+    function DeleteIntersected(AStart, AEnd: integer): integer;
+    function SplitRange(RangeIdx, SplitPos: integer): Boolean;
+
+    // Content has been changed, updates ranges upper Pos
+    // Removes affected ranges
+    function ContentChanged(Pos, Count: integer): Boolean;
+    // Exactly at position
+    function RangeAt(APos: integer): integer;
+    // At position or next
+    function NextAt(APos: integer): integer;
+    // At position or prior
+    function PriorAt(APos: integer): integer;
+
+    property Count: integer read GetCount;
+    property Items[Index: integer]: TRange read GetItems; default;
+  end;
+
+  // collection of overlapped ranges
+  // all ranges are sorted for quick search
+  TRangeCollection = class
+  private
+    FRangeArrays: TList;
+    function GetLevelCount: integer;
+    function GetLevels(Index: integer): TRangeList;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Add(Range: TRange);
+    procedure Clear;
+    procedure ClearFromPos(APos: integer);
+    function GetRangesAtPos(List: TList; Pos: integer): integer;
+    function GetRangesAtRange(List: TList; StartPos, EndPos: integer): integer;
+    property LevelCount: integer read GetLevelCount;
+    property Levels[Index: integer]: TRangeList read GetLevels; default;
+  end;
+
+// List[Index] > Key  =>  Result > 0
+// List[Index] = Key  =>  Result = 0
+// List[Index] < Key  =>  Result < 0
+TCompareProc = function(const List: TList; Index: integer; Key: TObject): integer;
+// Search in sorted list
+function QuickSearch(const List: TList; CompProc: TCompareProc;
+                     Key: TObject; var Index: integer): Boolean;
+
+implementation
+
+uses SysUtils, Contnrs;
+
+function QuickSearch(const List: TList; CompProc: TCompareProc;
+                     Key: TObject; var Index: integer): Boolean;
+var
+  L, H, I, C: Integer;
+begin
+  Result := False;
+  if List.Count = 0 then
+   begin
+    Index := -1;
+    Exit;
+   end;
+
+  L := 0;
+  H := List.Count - 1;
+  while L <= H do
+  begin
+    I := (L + H) shr 1;
+    C := CompProc(List, I, Key);
+    if C < 0 then L := I + 1 else
+    begin
+      if C = 0 then
+      begin
+        Result := True;
+        Index := I;
+        Exit;
+      end;
+      H := I - 1;
+    end;
+  end;
+  Index := L;
+  if Index >= List.Count then Index := List.Count - 1;
+  if Index >= 0 then
+   if CompProc(List, Index, Key) > 0 then
+    dec(Index);
+end;
+
+{ TRange }
+
+constructor TRange.Create(AStartPos, AEndPos: integer);
+begin
+  inherited Create;
+  FStartPos := AStartPos;
+  FEndPos := AEndPos;
+end;
+
+function TRange.GetKey: integer;
+begin
+  Result := FStartPos;
+end;
+
+function TRange.GetLength: integer;
+begin
+  Result := FEndPos - FStartPos;
+end;
+
+{ TRangeList }
+
+constructor TRangeList.Create(UnionSiblings: Boolean);
+begin
+  inherited Create;
+  FList := TObjectList.Create;
+  FUnionSiblings := UnionSiblings;
+end;
+
+destructor TRangeList.Destroy;
+begin
+  FreeAndNil(FList); //AT
+  inherited;
+end;
+
+procedure TRangeList.Clear;
+begin
+  FList.Clear;
+end;
+
+function TRangeList.UnionRanges(Index: integer): integer;
+begin
+  // Default action - union of ranges
+  if Items[Index].FEndPos < Items[Index + 1].FEndPos then
+    Items[Index].FEndPos := Items[Index + 1].FEndPos;
+  FList.Delete(Index + 1);
+  Result := Index;
+end;
+
+function TRangeList.IsGreater(I1, I2: integer): Boolean;
+begin
+  if FUnionSiblings then
+    Result := I1 >= I2
+  else
+    Result := I1 > I2;
+end;
+
+function TRangeList.TryAdd(Range: TRange): Boolean;
+var idx: integer;
+begin
+  Result := True;
+  if (Count = 0) or (Items[Count - 1].EndPos <= Range.StartPos) then
+    FList.Add(Range)
+  else
+  if Items[Count - 1].StartPos <= Range.StartPos then
+   Result := False
+  else
+   begin
+     idx := NextAt(Range.StartPos);
+     if idx = -1 then FList.Add(Range) else
+     if (Items[idx].StartPos >= Range.EndPos) and
+        ((idx = 0) or (Items[idx - 1].EndPos <= Range.StartPos)) then
+        FList.Insert(idx, Range)
+     else
+       Result := False;
+   end;
+end;
+
+function TRangeList.Add(Range: TRange): integer;
+var idx, k: integer;
+begin
+  // Stream adding
+  if (Count = 0) or (Items[Count - 1].EndPos < Range.StartPos) then
+   begin
+    Result := Count;
+    FList.Add(Range);
+    Exit;
+   end;
+
+  idx := PriorAt(Range.StartPos);
+  if idx = Count - 1 then FList.Add(Range)
+   else FList.Insert(idx + 1, Range);
+  // Lower range check
+  if (idx <> -1) and IsGreater(Items[idx].EndPos, Range.StartPos) then
+    idx := UnionRanges(idx)
+  else
+    idx := idx + 1;
+  k := idx + 1;
+  while (k < Count) and IsGreater(Items[idx].EndPos, Items[k].StartPos) do
+   begin
+    idx := UnionRanges(idx);
+    k := idx + 1;
+   end;
+
+  Result := idx;
+end;
+
+procedure TRangeList.Delete(Index: integer);
+begin
+  FList.Delete(Index);
+end;
+
+function TRangeList.GetCount: integer;
+begin
+  Result := FList.Count;
+end;
+
+function TRangeList.GetItems(Index: integer): TRange;
+begin
+  Result := TRange(FList[Index]);
+end;
+
+function TRangeList.RangeAt(APos: integer): integer;
+begin
+  Result := PriorAt(APos);
+  if (Result <> -1) and (Items[Result].EndPos <= APos) then
+    Result := -1;
+end;
+
+function TRangeList.NextAt(APos: integer): integer;
+begin
+  Result := PriorAt(APos);
+  if Result = -1 then
+   begin
+     if Count > 0 then Result := 0
+   end else
+   if Items[Result].EndPos <= APos then
+    if Result < Count - 1 then Inc(Result)
+     else Result := -1;
+end;
+
+function RangeCmp(const List: TList; Index: integer; Key: TObject): integer;
+begin
+ with TRange(List[Index]) do
+  if FStartPos > integer(Key) then Result := 1 else
+   if (FStartPos <= integer(Key)) and (FEndPos > integer(Key)) then Result:= 0
+     else Result := -1;
+end;
+
+function TRangeList.PriorAt(APos: integer): integer;
+begin
+  if (FPrevIdx >= 0) and (FPrevIdx < FList.Count - 1) then
+   begin
+     if TRange(FList[FPrevIdx]).StartPos <= APos then
+      if (FPrevIdx >= FList.Count - 1) or
+         (TRange(FList[FPrevIdx + 1]).StartPos > APos) then
+       begin
+        Result := FPrevIdx;
+        Exit;
+       end else
+      if (FPrevIdx >= FList.Count - 2) or
+         (TRange(FList[FPrevIdx + 2]).StartPos > APos) then
+       begin
+        Result := FPrevIdx + 1;
+        Exit;
+       end;
+   end;
+  QuickSearch(FList, RangeCmp, TObject(APos), Result);
+  FPrevIdx := Result;
+end;
+
+function TRangeList.ContentChanged(Pos, Count: integer): Boolean;
+var idx: integer;
+begin
+  idx := PriorAt(Pos);
+  if (idx <> -1) and (Items[idx].EndPos >= Pos) then Delete(idx)
+   else
+    begin
+     Inc(idx);
+     if idx >= FList.Count then // No change
+      begin
+       Result := False;
+       Exit;
+      end;
+    end;
+
+  if Count < 0 then
+   while (idx < FList.Count) and (Items[idx].StartPos <= Pos - Count) do
+    Delete(idx);
+
+  while idx < FList.Count do
+    begin
+      Inc(Items[idx].FStartPos, Count);
+      Inc(Items[idx].FEndPos, Count);
+      Inc(idx);
+    end;
+  Result := True;
+end;
+
+function TRangeList.ClearFromPos(APos: integer; CopyTo: TRangeList): integer;
+var idx, i: integer;
+begin
+  Result := APos;
+  idx := NextAt(APos);
+  if idx <> -1 then
+   begin
+     if Items[idx].StartPos < APos then
+       Result := Items[idx].StartPos;
+     if CopyTo <> nil then
+      begin
+        CopyTo.Clear;
+        CopyTo.FList.Capacity := Count - idx;
+        for i := idx to Count - 1 do
+         begin
+           CopyTo.FList.Add(FList[i]);
+           FList.List[i] := nil;
+         end;
+//        N := Count - idx;
+//        CopyTo.FList.Count := N;
+//        Move(FList.List[idx], CopyTo.FList.List[0], N * sizeof(pointer));
+//        for i := Count - 1 downto idx do
+//          FList.List[idx] := nil;
+      end;
+     for i := Count - 1 downto idx do
+       Delete(i);
+   end;
+end;
+
+function TRangeList.DeleteIntersected(AStart, AEnd: integer): integer;
+var idx: integer;
+begin
+  idx := NextAt(AStart);
+  if idx = -1 then idx := Count - 1 else
+   if Items[idx].StartPos >= AEnd then Dec(idx);
+  Result := 0;
+  while (idx >= 0) and (idx < Count) and (Items[idx].EndPos > Astart) do
+   begin
+    Inc(Result);
+    Delete(idx);
+   end;
+end;
+
+type
+  TRangeClass = class of TRange;
+
+function TRangeList.SplitRange(RangeIdx, SplitPos: integer): Boolean;
+var R: TRange;
+    sp: integer;
+begin
+  R := Items[RangeIdx];
+  Result := (SplitPos > R.StartPos) and (SplitPos < R.EndPos);
+  if Result then
+    begin
+      sp := R.StartPos;
+      R.FStartPos := SplitPos;
+      R := TRangeClass(R.ClassType).Create(sp, SplitPos);
+      FList.Insert(RangeIdx, R);
+    end;
+end;
+
+{ TRangeCollection }
+
+constructor TRangeCollection.Create;
+begin
+  inherited;
+  FRangeArrays := TObjectList.Create;
+end;
+
+destructor TRangeCollection.Destroy;
+begin
+  Clear;
+  FreeAndNil(FRangeArrays);
+end;
+
+procedure TRangeCollection.Clear;
+begin
+  FRangeArrays.Clear;
+end;
+
+procedure TRangeCollection.Add(Range: TRange);
+var i: integer;
+    R: TRangeList;
+begin
+  for i := 0 to FRangeArrays.Count - 1 do
+    if TRangeList(FRangeArrays[i]).TryAdd(Range) then Exit;
+  R := TRangeList.Create(False);
+  FRangeArrays.Add(R);
+  R.Add(Range);
+end;
+
+procedure TRangeCollection.ClearFromPos(APos: integer);
+var i: integer;
+    R: TRangeList;
+begin
+  for i := FRangeArrays.Count - 1 downto 0 do
+   begin
+     R := TRangeList(FRangeArrays[i]);
+     R.ClearFromPos(APos);
+     if R.Count = 0 then
+       FRangeArrays.Delete(i);
+   end;
+end;
+
+function TRangeCollection.GetRangesAtPos(List: TList; Pos: integer): integer;
+var i, idx: integer;
+    R: TRangeList;
+begin
+  Result := -1;
+  for i := 0 to FRangeArrays.Count - 1 do
+   begin
+     R := TRangeList(FRangeArrays[i]);
+     idx := R.NextAt(Pos);
+     if idx <> -1 then
+      begin
+       if R[idx].StartPos <= Pos then
+        begin
+         List.Add(R[idx]);
+         if (Result = -1) or (Result > R[idx].EndPos) then
+           Result := R[idx].EndPos;
+        end else
+         if (Result = -1) or (Result > R[idx].StartPos) then
+           Result := R[idx].StartPos;
+      end;
+   end;
+end;
+
+function TRangeCollection.GetRangesAtRange(List: TList; StartPos,
+  EndPos: integer): integer;
+var i, idx: integer;
+    R: TRangeList;
+begin
+  Result := -1;
+  for i := 0 to FRangeArrays.Count - 1 do
+   begin
+     R := TRangeList(FRangeArrays[i]);
+     idx := R.NextAt(StartPos);
+     if (idx <> -1) then
+      while (Idx < R.Count) and (R[idx].StartPos < EndPos) do
+       begin
+        List.Add(R[idx]);
+        Inc(Idx);
+       end;
+   end;
+end;
+
+function TRangeCollection.GetLevelCount: integer;
+begin
+  Result := FRangeArrays.Count;
+end;
+
+function TRangeCollection.GetLevels(Index: integer): TRangeList;
+begin
+  Result := TRangeList(FRangeArrays[Index]);
+end;
+
+{ TSortedList }
+
+function TSortedList.Add(Item: TSortedItem): integer;
+begin
+  if (Count = 0) or (Items[Count - 1].GetKey <= Item.GetKey) then
+   begin
+    Result := Count;
+    FList.Add(Item);
+   end else
+   begin
+    Result := PriorAt(Item.GetKey);
+    Inc(Result);
+    if Result = Count then FList.Add(Item)
+     else FList.Insert(Result, Item);
+   end;
+end;
+
+procedure TSortedList.Clear;
+begin
+  FList.Clear;
+end;
+
+constructor TSortedList.Create(OwnObjects: Boolean);
+begin
+  inherited Create;
+  if OwnObjects then
+    FList := TObjectList.Create
+  else
+    FList := TList.Create;
+end;
+
+procedure TSortedList.Delete(Index: integer);
+begin
+  FList.Delete(Index);
+end;
+
+destructor TSortedList.Destroy;
+begin
+  FreeAndNil(FList);//AT
+  inherited;
+end;
+
+function TSortedList.GetAt(Pos: integer): TSortedItem;
+var idx: integer;
+begin
+  idx := GetIndexAt(Pos);
+  if idx = -1 then Result := nil
+   else Result := Items[idx];
+end;
+
+function TSortedList.GetIndexAt(Pos: integer): integer;
+begin
+  Result := PriorAt(Pos);
+  if (Result <> -1) and (Items[Result].GetKey <> Pos) then
+    Result := -1;
+end;
+
+function TSortedList.GetCount: integer;
+begin
+  if FList<>nil then//AT
+    Result := FList.Count
+  else
+    Result:= 0;//AT
+end;
+
+function TSortedList.GetItem(Index: integer): TSortedItem;
+begin
+  Result := TSortedItem(FList[Index]);
+end;
+
+function ItemCmp(const List: TList; Index: integer; Key: TObject): integer;
+begin
+  Result := TSortedItem(List[Index]).GetKey - integer(Key);
+end;
+
+function TSortedList.PriorAt(Pos: integer): integer;
+begin
+  QuickSearch(FList, ItemCmp, TObject(Pos), Result);
+end;
+
+procedure TSortedList.Remove(Item: TSortedItem);
+begin
+  FList.Remove(Item);
+end;
+
+end.

EControl/ec/econtrol_package.lpk

@@ -0,0 +1,70 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <Package Version="4">
+    <PathDelim Value="\"/>
+    <Name Value="econtrol_package"/>
+    <Type Value="RunTimeOnly"/>
+    <Author Value="A. Torgashin"/>
+    <CompilerOptions>
+      <Version Value="11"/>
+      <PathDelim Value="\"/>
+      <SearchPaths>
+        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+      </SearchPaths>
+    </CompilerOptions>
+    <Description Value="Core of EControl Syntax Editor SDK"/>
+    <License Value="Licensed for open-source only. See readme.txt."/>
+    <Version Major="1"/>
+    <Files Count="8">
+      <Item1>
+        <Filename Value="eclists.pas"/>
+        <UnitName Value="ecLists"/>
+      </Item1>
+      <Item2>
+        <Filename Value="ecstrutils.pas"/>
+        <UnitName Value="ecStrUtils"/>
+      </Item2>
+      <Item3>
+        <Filename Value="ecsyntanal.pas"/>
+        <UnitName Value="ecSyntAnal"/>
+      </Item3>
+      <Item4>
+        <Filename Value="ecsyntgramma.pas"/>
+        <UnitName Value="ecSyntGramma"/>
+      </Item4>
+      <Item5>
+        <Filename Value="ecsysutils.pas"/>
+        <UnitName Value="ecSysUtils"/>
+      </Item5>
+      <Item6>
+        <Filename Value="eczregexpr.pas"/>
+        <UnitName Value="ecZRegExpr"/>
+      </Item6>
+      <Item7>
+        <Filename Value="proc_lexer.pas"/>
+        <UnitName Value="proc_lexer"/>
+      </Item7>
+      <Item8>
+        <Filename Value="proc_streamcomponent.pas"/>
+        <UnitName Value="proc_StreamComponent"/>
+      </Item8>
+    </Files>
+    <RequiredPkgs Count="3">
+      <Item1>
+        <PackageName Value="atsynedit_package"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="FCL"/>
+      </Item3>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+  </Package>
+</CONFIG>

EControl/ec/econtrol_package.pas

@@ -0,0 +1,15 @@
+{ This file was automatically created by Lazarus. Do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit econtrol_package;
+
+interface
+
+uses
+  ecLists, ecStrUtils, ecSyntAnal, ecSyntGramma, ecSysUtils, ecZRegExpr, 
+  proc_lexer, proc_StreamComponent;
+
+implementation
+
+end.

EControl/ec/ecstrutils.pas

@@ -0,0 +1,400 @@
+{ *************************************************************************** }
+{                                                                             }
+{ EControl Common Library                                                     }
+{                                                                             }
+{ Copyright (c) 2004 - 2015 EControl Ltd., Zaharov Michael                    }
+{     www.econtrol.ru                                                         }
+{     support@econtrol.ru                                                     }
+{                                                                             }
+{ *************************************************************************** }
+
+{$mode delphi}
+
+unit ecStrUtils;
+
+interface
+
+uses SysUtils, Classes, Graphics;
+
+type
+  ecString = UnicodeString;
+  ecChar = WideChar;
+  UCString = UnicodeString;
+  UCChar = WideChar;
+
+type
+  TzStringList = class(TStringList)
+  private
+    FDelimiter: Char;
+    FCaseSensitive: Boolean;
+    function GetDelimitedText: string;
+    procedure SetDelimitedText(const Value: string);
+    procedure SetCaseSensitive(const Value: Boolean);
+  public
+    function Find(const S: string; out Index: Integer): Boolean; override;
+    procedure Sort; override;
+    property Delimiter: Char read FDelimiter write FDelimiter;
+    property DelimitedText: string read GetDelimitedText write SetDelimitedText;
+    property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
+  private
+    function GetValueFromIndex(Index: Integer): string;
+    procedure SetValueFromIndex(Index: Integer; const Value: string);
+  public
+    property ValueFromIndex[Index: Integer]: string read GetValueFromIndex write SetValueFromIndex;
+  end;
+
+function IsDigitChar(const c: UCChar): Boolean; overload;
+function IsHexDigitChar(const c: UCChar): Boolean; overload;
+function IsLineBreakChar(const c: UCChar): Boolean; overload;
+function IsWordChar(const c: UCChar): Boolean; overload;
+function IsSpaceChar(const c: UCChar): Boolean; overload;
+function IsAlphaChar(const c: UCChar): Boolean; overload;
+
+function IsIdentChar(const C: UCChar): Boolean; overload;
+function IsIdentDigitChar(const C: UCChar): Boolean; overload;
+function IsIdentLetterChar(const C: UCChar): Boolean; overload;
+function IsWordBreak(aPos: integer; const Text: UCString): Boolean; overload;
+
+function ecUpCase(const C: UCChar): UCChar; overload;
+function SkipSpaces(const Source: ecString; var APos: integer): integer;
+function SkipSpacesNoLineBreak(const Source: ecString; var APos: integer): integer;
+function ecEncodeString(const S: string): string;
+function ecDecodeString(const S: string): string;
+function ecPosEx(const SubStr, S: ecString; Offset: Cardinal = 1): Integer;
+
+implementation
+
+uses
+  Controls, Forms;
+
+function TzStringList.GetDelimitedText: string;
+var
+  S: string;
+  P: PChar;
+  I, NCount: Integer; //renamed Count
+begin
+  NCount := GetCount;
+  if (NCount = 1) and (Get(0) = '') then
+    Result := QuoteChar + QuoteChar
+  else
+  begin
+    Result := '';
+    for I := 0 to NCount - 1 do
+    begin
+      S := Get(I);
+      P := PChar(S);
+      while not (P^ in [#0..' ', QuoteChar, Delimiter]) do
+        Inc(P);
+      if (P^ <> #0) then S := AnsiQuotedStr(S, QuoteChar);
+      Result := Result + S + Delimiter;
+    end;
+      System.Delete(Result, Length(Result), 1);
+  end;
+end;
+
+procedure TzStringList.SetCaseSensitive(const Value: Boolean);
+begin
+  if Value <> FCaseSensitive then
+  begin
+    FCaseSensitive := Value;
+    if Sorted then Sort;
+  end;
+end;
+
+procedure TzStringList.SetDelimitedText(const Value: string);
+var
+  P, P1: PChar;
+  S: string;
+begin
+  BeginUpdate;
+  try
+    Clear;
+    P := PChar(Value);
+    while P^ in [#1..' '] do
+      Inc(P);
+    while P^ <> #0 do
+    begin
+      P1 := P;
+      while (P^ > ' ') and (P^ <> Delimiter) do
+        Inc(P);
+      SetString(S, P1, P - P1);
+      Add(S);
+      while P^ in [#1..' '] do
+        Inc(P);
+      if P^ = Delimiter then
+      begin
+        P1 := P;
+        Inc(P1);
+        if P1^ = #0 then
+          Add('');
+        repeat
+          Inc(P);
+        until not (P^ in [#1..' ']);
+      end;
+    end;
+  finally
+    EndUpdate;
+  end;
+end;
+
+function StrAnsiCompare(List: TStringList; const S1, S2: string): Integer;
+begin
+  with TzStringList(List) do
+   if CaseSensitive then
+     Result := AnsiCompareStr(S1, S2)
+   else
+     Result := AnsiCompareText(S1, S2);
+end;
+
+function StringListAnsiCompare(List: TStringList; Index1, Index2: Integer): Integer;
+begin
+  Result := StrAnsiCompare(List, List[Index1], List[Index2]);
+end;
+
+function TzStringList.Find(const S: string; out Index: Integer): Boolean;
+var
+  L, H, I, C: Integer;
+begin
+  Result := False;
+  L := 0;
+  H := Count - 1;
+  while L <= H do
+  begin
+    I := (L + H) shr 1;
+    C := StrAnsiCompare(Self, Strings[I], S);
+    if C < 0 then L := I + 1 else
+    begin
+      H := I - 1;
+      if C = 0 then
+      begin
+        Result := True;
+        if Duplicates <> dupAccept then L := I;
+      end;
+    end;
+  end;
+  Index := L;
+end;
+
+procedure TzStringList.Sort;
+begin
+  CustomSort(StringListAnsiCompare);
+end;
+
+function TzStringList.GetValueFromIndex(Index: Integer): string;
+begin
+  if Index >= 0 then
+    Result := Copy(Get(Index), Length(Names[Index]) + 2, MaxInt) else
+    Result := '';
+end;
+
+procedure TzStringList.SetValueFromIndex(Index: Integer; const Value: string);
+begin
+  if Value <> '' then
+  begin
+    if Index < 0 then Index := Add('');
+    Put(Index, Names[Index] + '=' + Value);
+  end
+  else
+    if Index >= 0 then Delete(Index);
+end;
+
+//==============================================================================
+//  Routines
+//==============================================================================
+function IsSpaceChar(const c: UCChar): Boolean;
+begin
+  Result := c = ' ';
+end;
+
+function IsLineBreakChar(const c: UCChar): Boolean;
+begin
+   case C of
+     #$000A, #$000D,
+     #$2028, #$2029, #$0085: Result := True;
+     else Result := False;
+   end;
+end;
+
+function IsDigitChar(const C: UCChar): Boolean;
+begin
+  Result := Pos(c, '1234567890') > 0;
+end;
+
+function IsHexDigitChar(const C: UCChar): Boolean;
+begin
+  Result := Pos(c, '1234567890abcdefABCDEF') > 0;
+end;
+
+function IsWordChar(const C: UCChar): Boolean;
+begin
+  if IsDigitChar(C) then Result := True
+  else
+  if (C >= 'a') and (C <= 'z') then Result := True
+  else
+  if (C >= 'A') and (C <= 'Z') then Result := True
+  else
+  if (C = '_')
+    or (C = #$0301) //AT
+    or (C = #$00B4) //AT
+    or (C = #$02B9) //AT
+    or (C = #$02CA) //AT
+    or (C = #$0384) then Result := True
+  else
+    Result := False;
+end;
+
+function IsAlphaChar(const C: UCChar): Boolean;
+begin
+  Result :=
+    ((C >= 'a') and (C <= 'z')) or
+    ((C >= 'A') and (C <= 'Z'));
+end;
+
+function IsIdentChar(const C: UCChar): Boolean;
+begin
+  Result := IsIdentLetterChar(C) or IsIdentDigitChar(C);
+end;
+
+function IsIdentLetterChar(const C: UCChar): Boolean;
+begin
+  Result :=
+    ((C >= 'a') and (C <= 'z')) or
+    ((C >= 'A') and (C <= 'Z')) or
+    (C = '_');
+end;
+
+function IsIdentDigitChar(const C: UCChar): Boolean;
+begin
+  Result := (C >= '0') and (C <= '9');
+end;
+
+function IsWordBreak(aPos: integer; const Text: UCString): Boolean;
+begin
+  Result := (aPos = 1) or (aPos > Length(Text)) or
+            (IsWordChar(Text[aPos]) xor IsWordChar(Text[aPos - 1]));
+end;
+
+function ecUpCase(const C: UCChar): UCChar;
+begin
+  Result := UpCase(C);
+end;
+
+function SkipSpacesNoLineBreak(const Source: ecString; var APos: integer): integer;
+var N: integer;
+begin
+  Result := 0;
+  N := Length(Source);
+  while (APos <= N) and IsSpaceChar(Source[APos]) and not IsLineBreakChar(Source[APos]) do
+    inc(APos);
+  if APos > N then Result := -1;
+end;
+
+function SkipSpaces(const Source: ecString; var APos: integer): integer;
+var N: integer;
+begin
+  Result := 0;
+  N := Length(Source);
+  while (APos <= N) and IsSpaceChar(Source[APos]) do
+   begin
+    if Source[APos] = #10 then inc(Result);
+    inc(APos);
+   end;
+  if APos > N then Result := -1;
+end;
+
+function ecEncodeString(const S: string): string;
+var I, L, K: integer;
+begin
+  Result := '';
+  L := Length(S);
+  I := 1;
+  while I <= L do
+    if (S[I] >= ' ') and (S[I] <> '''') then
+     begin
+       K := I;
+       repeat
+         Inc(I)
+       until (I > L) or (S[I] < ' ') or (S[I] = '''');
+       Result := Result + '''' + Copy(S, K, I - K) + '''';
+     end else
+     begin
+      Result := Result + '#' + IntToStr(Ord(S[I]));
+      Inc(I);
+     end;
+end;
+
+function ecDecodeString(const S: string): string;
+var I, L, K: integer;
+begin
+  Result := '';
+  L := Length(S);
+  I := 1;
+  while I <= L do
+   if S[I] = '''' then
+     begin
+       K := I;
+       repeat
+         Inc(I);
+       until (I > L) or (S[i] = '''');
+       Result := Result + Copy(S, K + 1, I - K - 1);
+       Inc(I);
+     end else
+   if S[I] = '#' then
+     begin
+       K := I + 1;
+       repeat
+         Inc(I)
+       until (I > L) or not IsIdentDigitChar(S[I]);
+       if (K = I) or ((I - K) > 3) then
+         raise Exception.Create('Invalid character code');
+       Result := Result + Chr(StrToInt(Copy(S, K, I - K)));
+     end else Exit;
+//   else raise Exception.Create('Invalid property data');
+end;
+
+function ecPosEx(const SubStr, S: ecString; Offset: Cardinal = 1): Integer;
+var
+  I,X: Integer;
+  Len, LenSubStr: Integer;
+begin
+  if Offset = 1 then
+    Result := Pos(SubStr, S)
+  else
+  begin
+    I := Offset;
+    LenSubStr := Length(SubStr);
+    Len := Length(S) - LenSubStr + 1;
+    while I <= Len do
+    begin
+      if S[I] = SubStr[1] then
+      begin
+        X := 1;
+        while (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) do
+          Inc(X);
+        if (X = LenSubStr) then
+        begin
+          Result := I;
+          exit;
+        end;
+      end;
+      Inc(I);
+    end;
+    Result := 0;
+  end;
+end;
+
+function ChangeComponentReference(This, NewRef: TComponent; var RefVar: TComponent): Boolean;
+begin
+  Result := (RefVar <> NewRef) and Assigned(This);
+  if Result then
+    begin
+      if Assigned(RefVar) then
+        RefVar.RemoveFreeNotification(This);
+      RefVar := NewRef;
+      if Assigned(RefVar) then
+        RefVar.FreeNotification(This);
+    end;
+end;
+
+
+end.

EControl/ec/ecsyntgramma.pas

@@ -0,0 +1,812 @@
+{ *************************************************************************** }
+{                                                                             }
+{ EControl Syntax Editor SDK                                                  }
+{                                                                             }
+{ Copyright (c) 2004 - 2015 EControl Ltd., Zaharov Michael                    }
+{     www.econtrol.ru                                                         }
+{     support@econtrol.ru                                                     }
+{                                                                             }
+{ *************************************************************************** }
+
+{$mode delphi}
+
+unit ecSyntGramma;
+
+interface
+
+uses
+  Classes,
+  Dialogs,
+  ecStrUtils,
+  ATStringProc_TextBuffer;
+
+type
+  TParserRuleItem = class;
+  TParserRule = class;
+  TParserRuleBranch = class;
+
+  TParserItemType = (itTerminal,           // "aaa"
+                     itTerminalNoCase,     // 'aaa'
+                     itTokenRule,          // <aaa>
+                     itParserRule);        //  aaa
+
+  TTokenHolder = class
+  protected
+    function GetTokenCount: integer; virtual; abstract;
+    function GetTokenType(Index: integer): integer; virtual; abstract;
+    function GetTokenStr(Index: integer): ecString; virtual; abstract;
+  end;
+
+  TParserNode = class
+  protected
+    function GetCount: integer; virtual; abstract;
+    function GetNodes(Index: integer): TParserNode; virtual; abstract;
+    function GetFirstToken: integer; virtual; abstract;
+    function GetLastToken: integer; virtual; abstract;
+  public
+    property Count: integer read GetCount;
+    property Nodes[Index: integer]: TParserNode read GetNodes; default;
+    property FirstToken: integer read GetFirstToken;
+    property LastToken: integer read GetLastToken;
+  end;
+
+  TParserBranchNode = class(TParserNode)
+  private
+    FNodes: TList;
+    FRule: TParserRuleBranch;
+  protected
+    function GetCount: integer; override;
+    function GetNodes(Index: integer): TParserNode; override;
+    function GetFirstToken: integer; override;
+    function GetLastToken: integer; override;
+  public
+    constructor Create(ARule: TParserRuleBranch);
+    destructor Destroy; override;
+    procedure Add(Node: TParserNode);
+    property Rule: TParserRuleBranch read FRule;
+  end;
+
+  TParserTermNode = class(TParserNode)
+  private
+    FRule: TParserRuleItem;
+    FTokenIndex: integer;
+  protected
+    function GetCount: integer; override;
+    function GetNodes(Index: integer): TParserNode; override;
+    function GetFirstToken: integer; override;
+    function GetLastToken: integer; override;
+  public
+    constructor Create(ARule: TParserRuleItem; ATokenIndex: integer);
+    property Rule: TParserRuleItem read FRule;
+  end;
+
+  TParserRuleItem = class
+  private
+    FItemType: TParserItemType;
+    FTerminal: string;
+    FTokenType: integer;
+    FParserRule: TParserRule;
+    FBranch: TParserRuleBranch;
+    FRepMin: integer;
+    FRepMax: integer;
+    FOwnRule: Boolean;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function IsValid: Boolean;
+
+    property ItemType: TParserItemType read FItemType;
+    property Terminal: string read FTerminal;
+    property TokenType: integer read FTokenType;
+    property ParserRule: TParserRule read FParserRule;
+    property Branch: TParserRuleBranch read FBranch;
+    property RepMin: integer read FRepMin;
+    property RepMax: integer read FRepMax;
+    property IsSubRule: Boolean read FOwnRule;
+  end;
+
+  TParserRuleBranch = class
+  private
+    FItems: TList;
+    FRule: TParserRule;
+    function GetCount: integer;
+    function GetItems(Index: integer): TParserRuleItem;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function IsValid: Boolean;
+
+    property Count: integer read GetCount;
+    property Items[Index: integer]: TParserRuleItem read GetItems;
+    property Rule: TParserRule read FRule;
+  end;
+
+  TParserRule = class
+  private
+    FBranches: TList;
+    FName: string;
+    FIndex: integer;
+    function GetCount: integer;
+    function GetBranches(Index: integer): TParserRuleBranch;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function IsValid: Boolean;
+
+    property Count: integer read GetCount;
+    property Branches[Index: integer]: TParserRuleBranch read GetBranches;
+    property Name: string read FName;
+  end;
+
+  TGrammaAnalyzer = class(TPersistent)
+  private
+    FGrammaRules: TList;
+    FGrammaDefs: TATStringBuffer;
+
+    FRoot: TParserRule;
+    FSkipRule: TParserRule;
+    FOnChange: TNotifyEvent;
+
+    function GetGrammaCount: integer;
+    function GetGrammaRules(Index: integer): TParserRule;
+    function GetGramma: ecString;
+    procedure SetGramma(const Value: ecString);
+  protected
+    function GetGrammaLines: TATStringBuffer;
+    procedure Changed; dynamic;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Assign(Source: TPersistent); override;
+    procedure Clear;
+
+    function ParserRuleByName(const AName: string): TParserRule;
+    function IndexOfRule(Rule: TParserRule): integer;
+    function CompileGramma(TokenNames: TStrings): Boolean;
+    function ParseRule(FromIndex: integer; Rule: TParserRule; Tags: TTokenHolder): TParserNode;
+    function TestRule(FromIndex: integer; Rule: TParserRule; Tags: TTokenHolder): integer;
+
+    property GrammaCount: integer read GetGrammaCount;
+    property GrammaRules[Index : integer]: TParserRule read GetGrammaRules; default;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+  published
+    property Gramma: ecString read GetGramma write SetGramma;
+  end;
+
+
+  TTraceParserProc = procedure(Sender: TObject; CurIdx: integer; const TraceStr: string) of object;
+var
+  TraceParserProc: TTraceParserProc;
+
+implementation
+
+uses SysUtils, Contnrs, ecSyntAnal;
+
+{ TParserRuleItem }
+
+constructor TParserRuleItem.Create;
+begin
+  inherited Create;
+  FTokenType := -1;
+  FRepMin := 1;
+  FRepMax := 1;
+  FOwnRule := False;
+end;
+
+destructor TParserRuleItem.Destroy;
+begin
+  if FOwnRule then
+    FParserRule.Free;
+  inherited;
+end;
+
+function TParserRuleItem.IsValid: Boolean;
+begin
+  case FItemType of
+    itTerminal,
+    itTerminalNoCase: Result := FTerminal <> '';
+    itTokenRule: Result := FTokenType <> -1;
+    itParserRule: Result := FParserRule <> nil;
+    else Result := False;
+  end;
+end;
+
+{ TParserRuleBranch }
+
+constructor TParserRuleBranch.Create;
+begin
+  inherited Create;
+  FItems := TObjectList.Create;
+end;
+
+destructor TParserRuleBranch.Destroy;
+begin
+  FItems.Free;
+  inherited;
+end;
+
+function TParserRuleBranch.GetCount: integer;
+begin
+  Result := FItems.Count;
+end;
+
+function TParserRuleBranch.GetItems(Index: integer): TParserRuleItem;
+begin
+  Result := TParserRuleItem(FItems[Index]);
+end;
+
+function TParserRuleBranch.IsValid: Boolean;
+var i: integer;
+begin
+  for i := 0 to FItems.Count - 1 do
+   if not Items[i].IsValid then
+     begin
+      Result := False;
+      Exit;
+     end;
+  Result := True;
+end;
+
+{ TParserRule }
+
+constructor TParserRule.Create;
+begin
+  inherited Create;
+  FBranches := TObjectList.Create;
+end;
+
+destructor TParserRule.Destroy;
+begin
+  FBranches.Free;
+  inherited;
+end;
+
+function TParserRule.GetBranches(Index: integer): TParserRuleBranch;
+begin
+  Result := TParserRuleBranch(FBranches[Index]);
+end;
+
+function TParserRule.GetCount: integer;
+begin
+  Result := FBranches.Count;
+end;
+
+function TParserRule.IsValid: Boolean;
+var i: integer;
+begin
+  for i := 0 to Count - 1 do
+   if not Branches[i].IsValid then
+    begin
+     Result := False;
+     Exit;
+    end;
+  Result := (Count > 1) or (Count = 1) and (Branches[0].Count > 0);
+end;
+
+{ TParserNode }
+
+procedure TParserBranchNode.Add(Node: TParserNode);
+begin
+  if FNodes = nil then FNodes := TObjectList.Create;
+  FNodes.Add(Node);
+end;
+
+constructor TParserBranchNode.Create(ARule: TParserRuleBranch);
+begin
+  inherited Create;
+  FRule := ARule;
+end;
+
+destructor TParserBranchNode.Destroy;
+begin
+  if FNodes <> nil then FNodes.Free;
+  inherited;
+end;
+
+function TParserBranchNode.GetCount: integer;
+begin
+  if FNodes = nil then Result := 0
+   else Result := FNodes.Count;
+end;
+
+function TParserBranchNode.GetFirstToken: integer;
+begin
+  if Count > 0 then
+   Result := Nodes[Count - 1].FirstToken
+  else
+   Result := -1;
+end;
+
+function TParserBranchNode.GetLastToken: integer;
+begin
+  if Count > 0 then
+   Result := Nodes[0].LastToken
+  else
+   Result := -1;
+end;
+
+function TParserBranchNode.GetNodes(Index: integer): TParserNode;
+begin
+  if FNodes <> nil then
+    Result := TParserNode(FNodes[Index])
+  else
+   Result := nil;
+end;
+
+{ TParserTermNode }
+
+constructor TParserTermNode.Create(ARule: TParserRuleItem;
+  ATokenIndex: integer);
+begin
+  inherited Create;
+  FRule := ARule;
+  FTokenIndex := ATokenIndex;
+end;
+
+function TParserTermNode.GetCount: integer;
+begin
+  Result := 0;
+end;
+
+function TParserTermNode.GetFirstToken: integer;
+begin
+  Result := FTokenIndex;
+end;
+
+function TParserTermNode.GetLastToken: integer;
+begin
+  Result := FTokenIndex;
+end;
+
+function TParserTermNode.GetNodes(Index: integer): TParserNode;
+begin
+  Result := nil;
+end;
+
+{ TGrammaAnalyzer }
+
+constructor TGrammaAnalyzer.Create;
+begin
+  inherited;
+  FGrammaRules := TObjectList.Create;
+  FGrammaDefs := TATStringBuffer.Create;
+end;
+
+destructor TGrammaAnalyzer.Destroy;
+begin
+  Clear;
+  FGrammaDefs.Free;
+  FGrammaRules.Free;
+  inherited;
+end;
+
+procedure TGrammaAnalyzer.Clear;
+begin
+  FGrammaRules.Clear;
+  FGrammaDefs.Clear;
+  FRoot := nil;
+  FSkipRule := nil;
+end;
+
+procedure TGrammaAnalyzer.Assign(Source: TPersistent);
+begin
+  if Source is TGrammaAnalyzer then
+   Gramma := (Source as TGrammaAnalyzer).Gramma;
+end;
+
+function TGrammaAnalyzer.ParserRuleByName(const AName: string): TParserRule;
+var i : integer;
+begin
+  if AName <> '' then
+   for i := 0 to FGrammaRules.Count - 1 do
+    if SameText(AName, GrammaRules[i].Name) then
+     begin
+       Result := GrammaRules[i];
+       Exit;
+     end;
+  Result := nil;
+end;
+
+function TGrammaAnalyzer.GetGrammaCount: integer;
+begin
+  Result := FGrammaRules.Count;
+end;
+
+function TGrammaAnalyzer.GetGrammaRules(Index: integer): TParserRule;
+begin
+  Result := TParserRule(FGrammaRules[Index]);
+end;
+
+function TGrammaAnalyzer.IndexOfRule(Rule: TParserRule): integer;
+begin
+  Result := FGrammaRules.IndexOf(Rule);
+end;
+
+function TGrammaAnalyzer.GetGramma: ecString;
+begin
+  Result := FGrammaDefs.FText;
+end;
+
+procedure TGrammaAnalyzer.SetGramma(const Value: ecString);
+begin
+  FGrammaDefs.SetupSlow(Value);
+  Changed;
+end;
+
+function TGrammaAnalyzer.GetGrammaLines: TATStringBuffer;
+begin
+  Result := FGrammaDefs;
+end;
+
+// Compiling Gramma rules
+function TGrammaAnalyzer.CompileGramma(TokenNames: TStrings): Boolean;
+var Lex: TecSyntAnalyzer;
+    Res: TecClientSyntAnalyzer;
+    Cur, i: integer;
+    Rule: TParserRule;
+
+  procedure AddTokenRule(ATokenType: integer; Expr: string);
+  var TokenRule: TecTokenRule;
+  begin
+    TokenRule := Lex.TokenRules.Add;
+    TokenRule.TokenType := ATokenType;
+    TokenRule.Expression := Expr;
+  end;
+
+  function ValidCur: Boolean;
+  begin
+    Result := Cur < Res.TagCount;
+  end;
+
+  procedure SkipComments;
+  begin
+    while ValidCur do
+     if Res.Tags[Cur].TokenType = 0 then Inc(Cur)
+      else Exit;
+  end;
+
+  procedure ReadRepeater(RuleItem: TParserRuleItem);
+  var s: string;
+  begin
+    if not ValidCur then Exit;
+    if Res.Tags[Cur].TokenType = 8 then
+     begin
+       s := Res.TagStr[Cur];
+       if s = '+' then RuleItem.FRepMax := -1 else
+        if s = '?' then RuleItem.FRepMin := 0 else
+         if s = '*' then
+          begin
+           RuleItem.FRepMin := 0;
+           RuleItem.FRepMax := -1;
+          end;
+       Inc(Cur);
+     end;
+  end;
+
+  function ExtractRule: TParserRule; forward;
+
+  function ExtractItem: TParserRuleItem;
+  var t: TParserItemType;
+      s: string;
+      R: TParserRule;
+  begin
+    Result := nil;
+    SkipComments;
+    if not ValidCur then Exit;
+
+    R := nil;
+    case Res.Tags[Cur].TokenType of
+      1: t := itTerminal;
+      2: t := itTerminalNoCase;
+      3: t := itTokenRule;
+      4: t := itParserRule;
+      9: begin // extract sub-rule
+          t := itParserRule;
+          R := ExtractRule;
+          if not ValidCur or (R = nil) or
+            (Res.Tags[Cur].TokenType <> 10) then Exit;
+         end;
+      else Exit;
+    end;
+    s := Res.TagStr[cur];
+    if t <> itParserRule then
+     begin
+       if Length(s) <= 2 then Exit;
+       Delete(s, Length(s), 1);
+       Delete(s, 1, 1);
+     end;
+    Result := TParserRuleItem.Create;
+    Result.FItemType := t;
+    Result.FTerminal := s;
+    Result.FParserRule := R;
+    Result.FOwnRule := R <> nil;
+    Inc(Cur);
+    ReadRepeater(Result);
+  end;
+
+  function ExtractBranch: TParserRuleBranch;
+  var Item, last: TParserRuleItem;
+      apos, sv_pos: integer;
+  begin
+    Result := TParserRuleBranch.Create;
+    last := nil;
+    sv_pos := 0; // to avoid warning
+    while ValidCur do
+     begin
+      apos := Cur;
+      Item := ExtractItem;
+      if Item <> nil then
+       begin
+        sv_pos := apos;
+        Result.FItems.Add(Item);
+        Item.FBranch := Result;
+        last := item
+       end else
+        if ValidCur then
+         if (Res.Tags[Cur].TokenType = 7) or
+            (Res.Tags[Cur].TokenType = 6) or
+            (Res.Tags[Cur].TokenType = 10) then Exit
+          else
+           begin
+            if (Res.Tags[Cur].TokenType = 5) and (last <> nil) and
+               (last.ItemType = itParserRule) then
+             begin
+               Cur := sv_pos;
+               Result.FItems.Delete(Result.FItems.Count - 1);
+               Exit;
+             end;
+            Break;
+           end;
+     end;
+    Result.Free;
+    Result := nil;
+  end;
+
+  function ExtractRule: TParserRule;
+  var Branch: TParserRuleBranch;
+      s: string;
+  begin
+    Result := nil;
+    SkipComments;
+    S := '';
+    if not ValidCur then Exit;
+    case Res.Tags[Cur].TokenType of
+      4: begin
+          s := Res.TagStr[Cur];
+          Inc(Cur);
+          SkipComments;
+          if not ValidCur or (Res.Tags[Cur].TokenType <> 5) then Exit;
+          Inc(Cur);
+         end;
+      9: Inc(Cur);
+      else Exit;
+    end;
+
+    Result := TParserRule.Create;
+    Result.FName := s;
+    while ValidCur do
+     begin
+       Branch := ExtractBranch;
+       if Branch = nil then Break;
+       Result.FBranches.Add(Branch);
+       Branch.FRule := Result;
+       if Res.Tags[Cur].TokenType = 6 then Inc(Cur) else
+       if Res.Tags[Cur].TokenType = 7 then
+        begin
+         Inc(Cur);
+         Exit;
+        end else
+       if Res.Tags[Cur].TokenType = 10 then Exit else
+       if Result.Count > 0 then Exit else break;
+     end;
+    Result.Free;
+    Result := nil;
+  end;
+
+  procedure LinkRuleItems(Rule: TParserRule);
+  var j, k: integer;
+      Item: TParserRuleItem;
+  begin
+    for j := 0 to Rule.Count - 1 do
+     for k := 0 to Rule.Branches[j].Count - 1 do
+       begin
+         Item := Rule.Branches[j].Items[k];
+         case Item.ItemType of
+           itTokenRule: Item.FTokenType := TokenNames.IndexOf(Item.Terminal);
+           itParserRule: if Item.IsSubRule then
+                          LinkRuleItems(Item.FParserRule)
+                         else
+                          Item.FParserRule := ParserRuleByName(Item.Terminal);
+         end;
+       end;
+  end;
+
+begin
+  Result := True;
+  FGrammaRules.Clear;
+  FRoot := nil;
+  FSkipRule := nil;
+
+  if GetGrammaLines.Count > 0 then
+    begin
+      Lex := TecSyntAnalyzer.Create(nil);
+      try
+        Res := Lex.AddClient(nil, GetGrammaLines);
+        if Res <> nil then
+          try
+            // Prepare Lexer
+            AddTokenRule(0, '//.*');                 // comment
+            AddTokenRule(0, '(?s)/\*.*?(\*/|\Z)');   // comment
+            AddTokenRule(1, '".*?"');                // Terminal
+            AddTokenRule(2, #39'.*?'#39);            // Terminal No case
+            AddTokenRule(3, '<.*?>');                // Terminal -> Token rule
+            AddTokenRule(4, '\w+');                  // Rule
+            AddTokenRule(5, '=');                    // Equal
+            AddTokenRule(6, '\|');                   // Or
+            AddTokenRule(7, ';');                    // Rule stop
+            AddTokenRule(8, '[\*\+\?]');             // Repeaters
+            AddTokenRule(9, '[\(]');                 // Open sub-rule
+            AddTokenRule(10,'[\)]');                 // Close sub-rule
+            // Extract all tokens
+            Res.Analyze;
+            // extract rules
+            Cur := 0;
+            while ValidCur do
+              begin
+                Rule := ExtractRule;
+                if Rule <> nil then
+                  begin
+                   Rule.FIndex := FGrammaRules.Count;
+                   FGrammaRules.Add(Rule);
+                  end
+                else Break;
+              end;
+            // performs linking
+            for i := 0 to FGrammaRules.Count - 1 do
+             LinkRuleItems(TParserRule(FGrammaRules[i]));
+          finally
+            Res.Free;
+          end;
+      finally
+        Lex.Free;
+      end;
+
+      FRoot := ParserRuleByName('Root');
+      FSkipRule := ParserRuleByName('Skip');
+    end;
+end;
+
+function TGrammaAnalyzer.TestRule(FromIndex: integer; Rule: TParserRule; Tags: TTokenHolder): integer;
+var FRootProgNode: TParserNode; // Results of Gramma analisys
+begin
+  FRootProgNode := ParseRule(FromIndex, Rule, Tags);
+  if Assigned(FRootProgNode) then
+    begin
+      Result := FRootProgNode.FirstToken;
+      FRootProgNode.Free;
+    end else
+      Result := -1;
+end;
+
+function TGrammaAnalyzer.ParseRule(FromIndex: integer; Rule: TParserRule; Tags: TTokenHolder): TParserNode;
+var CurIdx: integer;
+    CallStack: TList;
+    In_SkipRule: Boolean;
+
+  function RuleProcess(Rule: TParserRule): TParserNode; forward;
+
+  procedure SipComments;
+  var skipped: TParserNode;
+  begin
+    if not In_SkipRule and (FSkipRule <> nil) then
+     try
+       In_SkipRule := True;
+       skipped := RuleProcess(FSkipRule);
+       if skipped <> nil then skipped.Free;
+     finally
+       In_SkipRule := False;
+     end;
+  end;
+
+  function ItemProcess(Item: TParserRuleItem): TParserNode;
+  begin
+    Result := nil;
+    if CurIdx >= 0 then
+     if Item.FItemType = itParserRule then
+          Result := RuleProcess(Item.FParserRule)
+      else
+      begin
+        case Item.FItemType of
+          itTerminal:
+            if Tags.GetTokenStr(CurIdx) = Item.FTerminal then
+              Result := TParserTermNode.Create(Item, CurIdx);
+          itTerminalNoCase:
+            if SameText(Tags.GetTokenStr(CurIdx), Item.FTerminal) then
+              Result := TParserTermNode.Create(Item, CurIdx);
+          itTokenRule:
+            if (Item.FTokenType = 0) or (Tags.GetTokenType(CurIdx) = Item.FTokenType) then
+              Result := TParserTermNode.Create(Item, CurIdx);
+        end;
+        if Result <> nil then
+         begin
+          Dec(CurIdx);
+          SipComments;
+         end;
+      end;
+  end;
+
+  function BranchProcess(Branch: TParserRuleBranch): TParserNode;
+  var i, sv_idx, rep_cnt: integer;
+      node: TParserNode;
+  begin
+    if Branch.Count = 0 then
+     begin
+      Result := nil;
+      Exit;
+     end;
+
+    sv_idx := CurIdx;
+    Result := TParserBranchNode.Create(Branch);
+    for i := Branch.Count - 1 downto 0 do
+     begin
+       rep_cnt := 0;
+       node := nil;
+       while ((rep_cnt = 0) or (node <> nil)) and
+             ((Branch.Items[i].FRepMax = -1) or (rep_cnt < Branch.Items[i].FRepMax)) do
+        begin
+         node := ItemProcess(Branch.Items[i]);
+         if node <> nil then TParserBranchNode(Result).Add(node) else
+          if rep_cnt < Branch.Items[i].FRepMin then
+          begin
+            CurIdx := sv_idx;
+            Result.Free;
+            Result := nil;
+            Exit;
+          end else Break;
+         Inc(rep_cnt);
+        end;
+     end;
+  end;
+
+  function RuleProcess(Rule: TParserRule): TParserNode;
+  var i, handle: integer;
+  begin
+    // Check stack
+    handle := CurIdx shl 16 + Rule.FIndex;
+    if CallStack.IndexOf(TObject(handle)) <> -1 then
+       raise Exception.Create('Circular stack');
+    CallStack.Add(TObject(handle));
+
+    try
+      Result := nil;
+      for i := Rule.Count - 1 downto 0 do
+       begin
+  //       if Assigned(TraceParserProc) and not In_SkipRule then
+  //           TraceParserProc(Self, CurIdx, ' ' + Rule.FName);
+         Result := BranchProcess(Rule.Branches[i]);
+         if Result <> nil then Exit;
+       end;
+    finally
+      CallStack.Delete(CallStack.Count - 1);
+    end;
+  end;
+
+begin
+  CallStack := TList.Create;
+  try
+    CurIdx := FromIndex;
+    Result := RuleProcess(Rule);
+  finally
+    CallStack.Free;
+  end;
+end;
+
+procedure TGrammaAnalyzer.Changed;
+begin
+  if Assigned(FOnChange) then FOnChange(Self);
+end;
+
+initialization
+  TraceParserProc := nil;
+
+end.

EControl/ec/ecsysutils.pas

@@ -0,0 +1,84 @@
+{ *************************************************************************** }
+{                                                                             }
+{ EControl Common Library                                                     }
+{                                                                             }
+{ Copyright (c) 2004 - 2015 EControl Ltd., Zaharov Michael                    }
+{     www.econtrol.ru                                                         }
+{     support@econtrol.ru                                                     }
+{                                                                             }
+{ *************************************************************************** }
+
+{$mode delphi}
+
+unit ecSysUtils;
+
+interface
+
+uses
+  Classes, Controls, Forms;
+
+// 0 - all is ok
+// 1 - application terminated
+// 2 - object destroyed
+function SafeProcessMessages(Sender: TObject): integer;
+procedure SafeDestroying(Sender: TObject);
+
+implementation
+
+uses SysUtils;
+
+function SafeProcessMessages(Sender: TObject): integer;
+begin
+  Application.ProcessMessages;
+  if Application.Terminated then Result:= 1 else Result:= 0; 
+end;
+
+procedure SafeDestroying(Sender: TObject);
+begin
+end;
+
+(*
+// 0 - all is ok
+// 1 - application terminated
+// 2 - object destroyed
+var
+  ProcessCounter: Cardinal;
+  RefList: TList = nil;
+
+function SafeProcessMessages(Sender: TObject): integer;
+begin
+  if RefList = nil then
+    RefList := TList.Create;
+  RefList.Add(Sender);
+  Inc(ProcessCounter);
+  try
+    Application.ProcessMessages;
+    if ProcessCounter mod 10000 = 0 then
+     Application.HandleMessage;
+  finally
+    if RefList.IndexOf(Sender) = -1 then
+      Result := 2
+    else if Application.Terminated then
+      Result := 1
+    else
+      Result := 0;
+    RefList.Remove(Sender);
+  end;
+end;
+
+procedure SafeDestroying(Sender: TObject);
+begin
+  if RefList <> nil then
+    RefList.Remove(Sender);
+end;
+*)
+
+
+initialization
+  //RefList := TList.Create;
+
+finalization
+  //FreeAndNil(RefList);
+
+
+end.

EControl/ec/proc_lexer.pas

@@ -0,0 +1,112 @@
+unit proc_lexer;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils,
+  ecSyntAnal,
+  ecStrUtils,
+  ATStringProc;
+
+function DoFindLexerForFilename(LexLib: TecSyntaxManager; const FileName: string): TecSyntAnalyzer;
+function DoGetLexerFileFilter(an: TecSyntAnalyzer; const AllFilesText: string): string;
+function DoGetLexerDefaultExt(an: TecSyntAnalyzer): string;
+
+implementation
+
+function DoFindLexerForFilename(LexLib: TecSyntaxManager; const FileName: string): TecSyntAnalyzer;
+var
+  fname, ext1, ext2: string;
+  i: integer;
+  st: TzStringList;
+begin
+  Result:= nil;
+
+  fname:= '/' + LowerCase(ExtractFileName(FileName));
+
+  ext1:= LowerCase(ExtractFileExt(FileName));
+  if SBeginsWith(ext1, '.') then Delete(ext1, 1, 1);
+
+  ext2:= '';
+  if ext1<>'' then
+  begin
+    ext2:= LowerCase(ExtractFileExt(ChangeFileExt(FileName, '')));
+    if SBeginsWith(ext2, '.') then Delete(ext2, 1, 1);
+    if ext2<>'' then
+      ext2:= ext2+'.'+ext1;
+  end;
+
+  st:= TzStringList.Create;
+  try
+    st.Delimiter:= ' ';
+
+    //find by double extension
+    if ext2<>'' then
+      for i:= 0 to LexLib.AnalyzerCount-1 do
+        with LexLib.Analyzers[i] do
+          if not Internal then
+          begin
+            st.DelimitedText:= Extentions;
+            if (ext2<>'') and (st.IndexOf(ext2)>=0) then
+            begin
+              Result:= LexLib.Analyzers[i];
+              Exit;
+            end;
+          end;
+
+    //find by usual extension + filename
+    for i:= 0 to LexLib.AnalyzerCount-1 do
+      with LexLib.Analyzers[i] do
+        if not Internal then
+        begin
+          st.DelimitedText:= Extentions;
+          if ((ext1<>'') and (st.IndexOf(ext1)>=0)) or
+                            (st.IndexOf(fname)>=0) then
+          begin
+            Result:= LexLib.Analyzers[i];
+            Exit;
+          end;
+        end;
+  finally
+    st.Free;
+  end;
+end;
+
+function DoGetLexerFileFilter(an: TecSyntAnalyzer; const AllFilesText: string): string;
+var
+  s: string;
+  st: TzStringList;
+  i: integer;
+begin
+  Result:= '';
+  st:= TzStringList.Create;
+  try
+    st.Delimiter:= ' ';
+    st.DelimitedText:= an.Extentions;
+    if st.Count=0 then Exit;
+    Result:= an.LexerName+' ('+an.Extentions+')|';
+    for i:= 0 to st.Count-1 do
+      Result:= Result+'*.'+st[i]+';';
+    Result:= Result+'|';
+  finally
+    st.Free;
+  end;
+
+  if AllFilesText<>'' then
+    Result:= Result+AllFilesText+'|'+AllFilesMask+'|';
+end;
+
+function DoGetLexerDefaultExt(an: TecSyntAnalyzer): string;
+var
+  n: integer;
+begin
+  Result:= an.Extentions;
+  n:= Pos(' ', Result);
+  if n>0 then Delete(Result, n, Maxint);
+end;
+
+
+end.
+

EControl/ec/proc_streamcomponent.pas

@@ -0,0 +1,109 @@
+unit proc_StreamComponent;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+procedure SaveComponentToFile(Component: TComponent; const FileName: string);
+procedure SaveComponentToStream(Component: TComponent; Stream: TStream);
+procedure LoadComponentFromFile(Component: TComponent; const FileName: string; OnError: TReaderError);
+procedure LoadComponentFromStream(Component: TComponent; Stream: TStream; OnError: TReaderError = nil);
+
+
+implementation
+
+
+procedure SaveComponentToStream(Component: TComponent; Stream: TStream);
+var
+  MemSt: TStream;
+  Writer: TWriter;
+begin
+  MemSt := TMemoryStream.Create;
+  try
+    if Component.Owner = nil then
+      MemSt.WriteComponent(Component)
+    else
+      begin
+        Writer := TWriter.Create(MemSt, 4096);
+        try
+          Writer.Root := Component.Owner;
+          //Delphi needs Writer.WriteSignature
+          Writer.WriteComponent(Component);
+        finally
+          FreeAndNil(Writer);
+        end;
+      end;
+    MemSt.Position := 0;
+    ObjectBinaryToText(MemSt, Stream);
+  finally
+    FreeAndNil(MemSt);
+  end
+end;
+
+procedure SaveComponentToFile(Component: TComponent; const FileName: string);
+var
+  Stream: TStream;
+begin
+  Stream := TFileStream.Create(FileName, fmCreate);
+  try
+    SaveComponentToStream(Component, Stream);
+  finally
+    FreeAndNil(Stream);
+  end
+end;
+
+procedure LoadComponentFromStream(Component: TComponent; Stream: TStream; OnError: TReaderError = nil);
+var
+  MemSt: TStream;
+  Reader: TReader;
+  Sign: array[0..3] of char = '    ';
+begin
+   MemSt := TMemoryStream.Create;
+   try
+     ObjectTextToBinary(Stream, MemSt);
+     MemSt.Position := 0;
+     Reader := TReader.Create(MemSt, 4096);
+     Reader.OnError := OnError;
+    try
+      if Component.Owner = nil then
+        Reader.ReadRootComponent(Component)
+      else
+        begin
+            Reader.Root := Component.Owner;
+
+            //Reader.ReadSignature; //AT
+            Reader.Read(Sign, SizeOf(Sign));
+
+            Reader.BeginReferences;
+            try
+              Reader.ReadComponent(Component);
+              Reader.FixupReferences;
+            finally
+              Reader.EndReferences;
+            end;
+        end;
+    finally
+      FreeAndNil(Reader);
+    end;
+  finally
+    FreeAndNil(MemSt);
+  end;
+end;
+
+procedure LoadComponentFromFile(Component: TComponent; const FileName: string; OnError: TReaderError);
+var
+  Stream: TStream;
+begin
+  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+  try
+    LoadComponentFromStream(Component, Stream, OnError);
+  finally
+    FreeAndNil(Stream);
+  end;
+end;
+
+end.
+

EControl/readme.txt

@@ -0,0 +1,21 @@
+
+This is base code of EControl Syntax Editor SDK http://econtrol.ru
+For Lazarus (1.4+), with ATSynEdit
+
+Code contains: 
+- syntax parser (lexer engine), 
+- syntax manager (linked list of lexers),
+- helper lists, 
+- regex engine (lexer needs it, cannot use Lazarus regex).
+Code does not contain: 
+- SyntaxMemo control, 
+- popup lists, 
+- more visual controls.
+
+Code modified! can use it with ATSynEdit only. 
+(ecmemostrings object deleted, replaced with ATStringbuffer object [same methods], less code).
+
+LICENSE
+EControl author [Michael Zakharov] gave permission to use this code (modified for ATSynEdit) only inside **open source** projects. It's NOT ALLOWED to use this code in closed source. For usage in closed source, you must buy license from EControl (for full code).
+Copyright (c) 2004-2015, EControl
+Ported by A. Torgashin, UVviewsoft.com