{ *************************************************************************** }
{                                                                             }
{ EControl Syntax Editor SDK                                                  }
{                                                                             }
{ Copyright (c) 2004 - 2008 EControl Ltd., Zaharov Michael                    }
{     www.econtrol.ru                                                         }
{     support@econtrol.ru                                                     }
{                                                                             }
{ *************************************************************************** }
{$I ecSyntEdit.INC}

unit ecMemoStrings;

interface

uses Windows, Classes, Graphics, SysUtils, ecStrUtils;

type
  TLineState = (lsNormal, lsModified, lsNew, lsSaved);
  TTextOperation = (toInsert, toDelete, toMoveCursor);

  TUndoRec = class
  public
    Operation: TTextOperation;
    Position: integer;      // Caret position before operation
    InsText: ecString;      // Inserted text
    DelText: ecString;      // Deleted text
    CaretChanged: Boolean;  // Caret position changed after operation
    GroupIndex: integer;    // Group index
  end;

  TTextChangedEvent = procedure(Sender: TObject; Pos, Count, LineChange: integer) of object;

  TSyntMemoStrings = class(TecStrings)
  private
    FLines: TList;
    FOnChange: TTextChangedEvent;
    FTextCoding: TTextCoding;
    FUndoList: TList;
    FRedoCount: integer;
    FTextFormat: TTextFormat;
    FSkipSignature: Boolean;
    FObjects: TList;
    FCharSet: TFontCharset;
    FModified: Boolean;
    FUndoCountAfterSave: integer;
    FLineStates: TList;
    FCodePage: integer;
    FOnModifiedChanged: TNotifyEvent;
    FUndoLimit: integer;
    FGroupIndex: integer;   // index of group undo
    FGroupUndoCount: integer;
    procedure UpdateLines;
    function GetChar(Index: integer): ecChar;
    procedure SetChar(Index: integer; const Value: ecChar);
    procedure ReadDataAnsi(Reader: TReader);
    procedure WriteDataAnsi(Writer: TWriter);
    function GetModified: Boolean;
    procedure SetModified(const Value: Boolean);
    function GetLineState(Line: integer): TLineState;
    procedure SetLineState(Line: integer; const Value: TLineState);
    procedure SetRedoCount(const Value: integer);
    procedure SetUndoLimit(const Value: integer);
    procedure CutUndoList;
  protected
    procedure DefineProperties(Filer: TFiler); override;
    function Get(Index: Integer): ecString; override;
    function GetCount: Integer; override;
    function GetTextStr: ecString; override;
    procedure Put(Index: Integer; const S: ecString); override;
    procedure SetTextStr(const Value: ecString); override;
    procedure Changed(Pos, Count, LineChange: integer);
    function GetObject(Index: Integer): TObject; override;
    procedure PutObject(Index: Integer; AObject: TObject); override;
    procedure ModifiedChanged; dynamic;
  public
    FText: ecString;
    constructor Create;
    destructor Destroy; override;
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Insert(Index: Integer; const S: ecString); override;
    procedure AddStrings(Strings: TStrings); override;

    function LineLength(Index: Integer): Integer;
    function LineSpace(Index: integer): integer;
    function LineIndex(Index: Integer): Integer;
    procedure InsertTxt(const s: ecString; Pos: integer);
    procedure DeleteTxt(Pos, Count: integer);
    function SubString(Pos, Count: integer): ecString;
{$IFNDEF EC_DOTNET}
    procedure SaveToStream(Stream: TStream); override;
    procedure LoadFromStream(Stream: TStream); override;
{$ENDIF}
{$IFDEF EC_VCL12_UP}
    procedure LoadFromStream(Stream: TStream; Encoding: TEncoding); overload; override;
    procedure SaveToStream(Stream: TStream; Encoding: TEncoding); overload; override;
{$ENDIF}
    function TextLength: integer;
    function IsNullEnd: Boolean;
    function IsLineEmpty(Line: integer): Boolean;
    function ContainUnicode: Boolean;

    function CaretToStr(const p: TPoint): integer;
    function StrToCaret(p: integer): TPoint;

    function MatchAtPos(StrtPos: integer; const FindText: ecString; CaseSensitive: Boolean): Boolean;
    function Find(var StrtPos, EndPos: integer; const FindText: ecString; Flags: integer): Boolean;

    procedure SetObjectsStore(Enable: Boolean = True; OwnObjects: Boolean = False);

    procedure BeginUndoGroup;
    procedure EndUndoGroup;
    procedure ClearUndo;
    procedure ClearRedo;
    procedure AddUndo(op: TTextOperation; const aInsTxt, aDelTxt: ecString;
      aPos: integer; MovedCaret: Boolean);
    procedure SaveUndoState;
    procedure SaveLineStates;
    procedure ResetLineStates(FromLine: integer = 0; ToLine: integer = -1);
    {$IFDEF EC_MBCS}
    function CharType(Index: integer): TMbcsByteType;
    {$ENDIF}

    property OnChange: TTextChangedEvent read FOnChange write FOnChange;
    property OnModifiedChanged: TNotifyEvent read FOnModifiedChanged write FOnModifiedChanged;
    property Chars[Index: integer]: ecChar read GetChar write SetChar;
    property TextCoding: TTextCoding read FTextCoding write FTextCoding;
    property TextFormat: TTextFormat read FTextFormat write FTextFormat;
    property SkipSignature: Boolean read FSkipSignature write FSkipSignature;
    property UndoList: TList read FUndoList;
    property RedoCount: integer read FRedoCount write SetRedoCount;
    property UndoLimit: integer read FUndoLimit write SetUndoLimit;

    property CharSet: TFontCharset read FCharSet write FCharSet;
    property CodePage: integer read FCodePage write FCodePage;
    property Modified: Boolean read GetModified write SetModified;
    property LineState[Line: integer]: TLineState read GetLineState write SetLineState;
  end;

implementation

uses Clipbrd, Contnrs, {$IFDEF EC_DOTNET}Types,{$ENDIF} ecLists, math;

{ TSyntMemoStrings }

constructor TSyntMemoStrings.Create;
begin
  inherited Create;
  FLines := TList.Create;
  FLineStates := TList.Create;
  FText := '';
  FTextCoding := tcAnsi;
  FUndoList := TObjectList.Create;
  SkipSignature := False;
  FTextFormat := tfDefault;
  UpdateLines;
  FCharSet := DEFAULT_CHARSET;
  FCodePage := CP_ACP;
  FGroupIndex := -1;
end;

destructor TSyntMemoStrings.Destroy;
begin
  FLines.Free;
  FUndoList.Free;
  FLineStates.Free;
  if FObjects <> nil then
    FreeAndNil(FObjects);
  inherited;
end;

procedure TSyntMemoStrings.Clear;
begin
  FText := '';
  UpdateLines;
  Changed(-1, 0, 0);
end;

procedure TSyntMemoStrings.UpdateLines;
begin
  GetLines(FText, FLines);
  if FObjects <> nil then
    FObjects.Count := FLines.Count;
  FLineStates.Count := FLines.Count;
end;

procedure TSyntMemoStrings.Delete(Index: Integer);
var s: integer;
begin
  if (Index = Count - 1) and IsNullEnd then
    begin
      if Index > 0 then S := LineIndex(Index - 1) + LineLength(Index - 1) - 1
        else S := 0;
      DeleteTxt(S, Length(FText) - S + 1);
    end
  else
    DeleteTxt(LineIndex(Index) - 1, LineSpace(Index));
end;

function TSyntMemoStrings.Get(Index: Integer): ecString;
begin
  Result := Copy(FText, LineIndex(Index), LineLength(Index));
end;

function TSyntMemoStrings.GetCount: Integer;
begin
  Result := FLines.Count;
//  if (Result > 0) and (LineLength(Result - 1) = 0) then
//    Dec(Result);
end;

function TSyntMemoStrings.GetTextStr: ecString;
begin
  Result := FText;
end;

function TSyntMemoStrings.TextLength: integer;
begin
  Result := Length(FText);
end;

procedure TSyntMemoStrings.Insert(Index: Integer; const S: ecString);
begin
  if (Index < 0) or (Index > FLines.Count) then
    Error(SecListIndexError, Index);
  try
   if Index = FLines.Count then
    begin // Добавляем строку
     if not IsNullEnd then
      InsertTxt(S + sLineBreak, Length(FText))
     else
      if GetCount > 0 then
       InsertTxt(sLineBreak + S, Length(FText))
      else
       InsertTxt(S, Length(FText));
    end
   else
    InsertTxt(S + sLineBreak, integer(FLines[Index]));
  finally
//   UpdateLines;
  end;
end;

procedure TSyntMemoStrings.Put(Index: Integer; const S: ecString);
var pos: integer;
begin
  Pos := integer(FLines[Index]);
  DeleteTxt(pos, LineLength(Index));
  InsertTxt(S, pos);
end;

procedure TSyntMemoStrings.SetTextStr(const Value: ecString);
begin
  FText := Value;
  UpdateLines;
  Changed(-1, 0, 0);
end;

procedure TSyntMemoStrings.SetUndoLimit(const Value: integer);
begin
  FUndoLimit := Value;
  ClearRedo;
  CutUndoList;
end;

procedure TSyntMemoStrings.CutUndoList;
begin
  if FUndoLimit > 0 then
   while UndoList.Count > FUndoLimit do
    begin
     UndoList.Delete(0);
     FModified := True;
    end;
end;

function TSyntMemoStrings.LineIndex(Index: Integer): Integer;
begin
  //aa: Keep LineIndex within range
  if Index >= FLines.Count then Index := FLines.Count - 1;
  if Index < 0 then Result := 0 else Result := Integer(FLines[Index]) + 1;
end;

function TSyntMemoStrings.LineLength(Index: Integer): Integer;
var st: integer;
begin
  if (FLines.Count = 0) or (Index < 0) or (Index >= FLines.Count) then Result := 0
    else
     begin
      Result := LineSpace(Index);
      st := Integer(FLines[Index]);
      while (Result > 0) and IsLineBreakChar(FText[st + Result]) do
       Dec(Result);
     end;
end;

function TSyntMemoStrings.LineSpace(Index: integer): integer;
begin
  if FLines.Count = 0 then Result := 0 else
  if Index < FLines.Count - 1 then
    Result := Integer(FLines[Index + 1]) - Integer(FLines[Index])
  else
    Result := Length(FText) - Integer(FLines.Last);
end;

procedure TSyntMemoStrings.AddStrings(Strings: TStrings);
var lng, lcnt, i: integer;
begin
  if Strings.Count = 0 then Exit;
  lng := Length(FText);
  if (GetCount > 0) and IsNullEnd then
    FText := FText + sLineBreak;

  lcnt := Count;
  FText := FText + Strings.Text;
  UpdateLines;
  if FObjects <> nil then
    for i := lcnt to Count - 1 do
      PutObject(i, Strings.Objects[i - lcnt]);
  Changed(lng, Length(FText) - lng, Count - lcnt);
end;

{$IFDEF EC_DOTNET}
procedure InsertStr(SubStr: ecString; var S: ecString; aPos: integer );
begin
  Insert(SubStr, S, aPos);
end;

procedure DeleteStr(var S: ecString; aPos, Count: integer);
begin
  Delete(S, aPos, Count);
end;
{$ENDIF}

procedure TSyntMemoStrings.DeleteTxt(Pos, Count: integer);
var lcnt, i, idx: integer;
    p: TPoint;
begin
  lcnt := FLines.Count;
  if lcnt = 0 then Exit;
  p := StrToCaret(Pos);
  {$IFNDEF EC_DOTNET}
  System.Delete(FText, Pos + 1, Count);
  {$ELSE}
  DeleteStr(FText, Pos + 1, Count);
  {$ENDIF}
  if FLineStates[p.Y] <> TObject(lsNew) then
    FLineStates[p.Y] := TObject(lsModified);
  for i := FLines.Count - 1 downto p.Y + 1 do
   begin
    idx := Integer(FLines[i]);
    if idx <= Pos + Count then
     begin
      FLines.Delete(i);
      FLineStates.Delete(i);
      if FObjects <> nil then
        FObjects.Delete(i);
     end
    else FLines[i] := TObject(idx - Count);
   end;
  Changed(Pos, -Count, FLines.Count - lcnt);
end;

procedure TSyntMemoStrings.InsertTxt(const s: ecString; Pos: integer);
var lcnt, i, N: integer;
    p: TPoint;
    NewLines: TList;
  procedure SetAt(Line, Index: integer);
  begin
    if Line >= FLines.Count then
      begin
       FLines.Add(TObject(Index));
       FLineStates.Add(TObject(lsNew));
       if FObjects <> nil then
         FObjects.Add(nil);
      end
     else
      begin
       FLines.Insert(Line, TObject(Index));
       FLineStates.Insert(Line, TObject(lsNew));
       if FObjects <> nil then
         FObjects.Insert(Line, nil);
      end;
  end;
begin
  if S = '' then Exit;

  lcnt := FLines.Count;

  p := StrToCaret(Pos);
  N := Length(S);
  Pos := CaretToStr(p);  // To avoid inserting between #13 and #10
  {$IFNDEF EC_DOTNET}
  if Pos = Length(FText) then
    FText := FText + S
  else
    System.Insert(s, FText, Pos + 1);
  {$ELSE}
  InsertStr(s, FText, Pos + 1);
  {$ENDIF}
  if FLines.Count = 0 then
   begin
    UpdateLines;
    for i := 0 to FLineStates.Count - 1 do
      FLineStates[i] := TObject(lsNew);
    if not IsNullEnd then
      SetAt(FLines.Count, TextLength);
   end else
   begin
    NewLines := TList.Create;
    try
      GetLines(S, NewLines);
      if FLineStates[p.Y] <> TObject(lsNew) then
        FLineStates[p.Y] := TObject(lsModified);
      for i := p.Y + 1 to FLines.Count - 1 do
        FLines[i] := TObject(integer(FLines[i]) + N);
      FLines.Capacity := FLines.Count + NewLines.Count;
      for i := 1 to NewLines.Count - 1 do
        SetAt(p.Y + i, integer(FLines[p.Y]) + P.X + integer(NewLines[i]));
      // Need To Insert
      if (N > 0) and IsLineBreakChar(S[N]) then
       SetAt(p.Y + NewLines.Count, integer(FLines[p.Y]) + P.X + N);
    finally
      NewLines.Free;
    end;
   end;

//  UpdateLines;
  Changed(Pos, N, FLines.Count - lcnt);
end;

function TSyntMemoStrings.SubString(Pos, Count: integer): ecString;
begin
  Result := Copy(FText, Pos, Count);
end;

function TSyntMemoStrings.GetChar(Index: integer): ecChar;
begin
  Result := FText[Index];
end;

procedure TSyntMemoStrings.SetChar(Index: integer; const Value: ecChar);
var isLB: Boolean;
begin
  isLB := IsLineBreakChar(FText[Index]);
  FText[Index] := Value;
  if IsLineBreakChar(Value) or isLB then
    UpdateLines;
  Changed(Index - 1, 0, 0);
end;

procedure TSyntMemoStrings.Changed(Pos, Count, LineChange: integer);
begin
  if Assigned(FOnChange) then  FOnChange(Self, Pos, Count, LineChange);
end;

function TSyntMemoStrings.IsNullEnd: Boolean;
begin
  Result := (FLines.Count = 0) or
           (LineSpace(FLines.Count - 1) = LineLength(FLines.Count - 1));
end;

function TSyntMemoStrings.IsLineEmpty(Line: integer): Boolean;
begin
  Result := IsStringEmpty(Strings[Line]);
end;

{$IFNDEF EC_DOTNET}
procedure TSyntMemoStrings.SaveToStream(Stream: TStream);
type
   PecString = ^ecString;
var LineEnd: ecString;
    i, ss, sl: integer;
    ConvText: ecString;
    pText: PecString;
begin
  // Write signature
  WriteTextSignature(Stream, FTextCoding);

  // Convert text
  if FTextFormat <> tfDefault then
    begin
      case FTextFormat of
        tfCR:   LineEnd := #13;
        tfNL:   LineEnd := #10;
        else    LineEnd := #13#10;
      end;
      ConvText := FText;
      for i := Count - 1 downto 0 do
       begin
         ss := LineIndex(i) + LineLength(i);
         sl := LineSpace(i) - LineLength(i);
         if (Copy(ConvText, ss, sl) <> LineEnd) and (sl > 0) then
          begin
           System.Delete(ConvText, ss, sl);
           System.Insert(LineEnd, ConvText, ss);
          end;
       end;
      pText := @ConvText;
    end else
//    begin
      pText := @FText;
//      LineEnd := #13#10;
//    end;

  WriteStringToStream(pText^, Stream, FTextCoding, FCharSet, FCodePage);
//  if (Count > 0) and (LineSpace(Count - 1) = 0) then
//    Stream.Write(LineEnd[1], Length(LineEnd)*sizeof(ecChar));
end;

procedure TSyntMemoStrings.LoadFromStream(Stream: TStream);
var
  i: Integer;
  LineEnd: ecString;
  TextFmt: TTextFormat;
  TextCd: TTextCoding;

begin
  if Stream.Size = Stream.Position then
   begin
    FTextCoding := tcAnsi;
    Text := '';
    Exit;
  end;
  TextCd := GetStreamFormat(Stream);
  if (TextCd <> tcAnsi) or not FSkipSignature then
    FTextCoding := TextCd;
  ReadStringFromStream(FText, Stream, FTextCoding, FCharSet, FCodePage);
  UpdateLines;
  if not IsNullEnd then
   begin
    FLines.Add(TObject(Length(FText)));
    FLineStates.Add(nil);
    if FObjects <> nil then
      FObjects.Add(nil);
   end;
  // Auto detecting text format
  FTextFormat := tfDefault;
  for i := Count - 1 downto 0 do
   begin
     LineEnd := Copy(FText, LineIndex(i) + LineLength(i), LineSpace(i) - LineLength(i));
     if LineEnd = #13 then TextFmt := tfCR else
      if LineEnd = #10 then TextFmt := tfNL
       else TextFmt := tfDefault;

     if FTextFormat = tfDefault then FTextFormat := TextFmt else
      if FTextFormat <> TextFmt then
       begin
         FTextFormat := tfDefault;  // Merged format => default
         Break;
       end;
   end;
  Changed(-1, 0, 0);
end;
{$ENDIF}

function TSyntMemoStrings.ContainUnicode: Boolean;
{$IFDEF EC_UNICODE}
var i: integer;
{$ENDIF}
begin
{$IFDEF EC_UNICODE}
  for i := 1 to Length(FText) do
   if Ord(FText[i]) > $7F then
    begin
     Result := True;
     Exit;
    end;
{$ENDIF}
  Result := False;
end;

//  Lines coordinates => Character index
function TSyntMemoStrings.CaretToStr(const p: TPoint): integer;
begin
  if p.Y >= Count then Result := TextLength
   else if P.Y < 0 then Result := 0 else
    begin
     Result := LineIndex(p.Y) - 1;
     if p.X > LineLength(p.Y) then
       inc(Result, LineLength(p.Y))
     else
       inc(Result, p.X);
    end;
end;

function CompareLineIndex(const List: TList; Index: integer; Key: TObject): integer;
begin
  Result := integer(List[Index]) - integer(key);
end;

//  Character index => Lines coordinates
function TSyntMemoStrings.StrToCaret(p: integer): TPoint;
begin
  if p <= 0 then Result := Point(0, 0) else
   begin
    QuickSearch(FLines, CompareLineIndex, TObject(p), Result.Y);
    if (Result.Y >= FLines.Count) or (Result.Y < 0) then Result := Point(0, 0) else
     begin
       Result.X := p - integer(FLines[Result.Y]);
       if Result.X > LineLength(Result.Y) then
         Result.X := LineLength(Result.Y);
     end;
   end;
{  if p > TextLength then p := TextLength;
  for i := 0 to Count - 2 do
   begin
    if LineSpace(i) > p then
     begin
       Result.Y := i;
       Result.X := p;
       Exit;
     end else
     dec(p, LineSpace(i));
   end;
  if Count > 0 then
   begin
    Result.Y := Count - 1;
    if p < LineLength(Result.Y) then
      Result.X := p
    else
      Result.X := LineLength(Result.Y);
   end else
    begin
     Result.X := 0;
     Result.Y := 0;
    end;}
end;
// =============================================================================
//  Stores strings only as ANSI strings
// =============================================================================
procedure TSyntMemoStrings.DefineProperties(Filer: TFiler);
  function DoWrite: Boolean;
  begin
    if Filer.Ancestor <> nil then
    begin
      Result := True;
      if Filer.Ancestor is TSyntMemoStrings then
        Result := not Equals(TSyntMemoStrings(Filer.Ancestor))
    end
    else Result := Count > 0;
  end;
begin
  Filer.DefineProperty('Strings', ReadDataAnsi, WriteDataAnsi, DoWrite);
end;

procedure TSyntMemoStrings.ReadDataAnsi(Reader: TReader);
begin
  Reader.ReadListBegin;
  BeginUpdate;
  try
    Clear;
    while not Reader.EndOfList do
    {$IFDEF EC_STRING_UNICODE}
      Add(Reader.ReadString)
    {$ELSE}
      Add(UTF8Decode(Reader.ReadString));
    {$ENDIF}
  finally
    EndUpdate;
  end;
  Reader.ReadListEnd;
end;

procedure TSyntMemoStrings.WriteDataAnsi(Writer: TWriter);
var
  I: Integer;
begin
  Writer.WriteListBegin;
  for I := 0 to Count - 1 do
    {$IFDEF EC_STRING_UNICODE}
    Writer.WriteString(Get(I));
    {$ELSE}
    Writer.WriteString(UTF8Encode(Get(I)));
    {$ENDIF}
  Writer.WriteListEnd;
end;

function TSyntMemoStrings.GetObject(Index: Integer): TObject;
begin
  if FObjects <> nil then
    Result := FObjects[Index]
  else
    Result := nil;
end;

procedure TSyntMemoStrings.PutObject(Index: Integer; AObject: TObject);
begin
  if FObjects <> nil then
    FObjects[Index] := AObject;
end;

procedure TSyntMemoStrings.SetObjectsStore(Enable: Boolean; OwnObjects: Boolean);
begin
  if Enable then
    begin
      if FObjects = nil then
        FObjects := TObjectList.Create(OwnObjects);
    end else
  if FObjects <> nil then
    FreeAndNil(FObjects);
end;

function TSyntMemoStrings.MatchAtPos(StrtPos: integer; const FindText: ecString; CaseSensitive: Boolean): Boolean;
var cmp_fl, L2: integer;
begin
  L2 := Length(FindText);
  if CaseSensitive then cmp_fl := 0
                   else cmp_fl := NORM_IGNORECASE;
  {$IFNDEF EC_DOTNET}
  {$IFDEF EC_UNICODE}
  Result := CompareStringW(LOCALE_SYSTEM_DEFAULT, cmp_fl,
            @FText[StrtPos], L2, PWideChar(FindText), L2) = 2;
  {$ELSE}
  Result := CompareStringA(LOCALE_SYSTEM_DEFAULT, cmp_fl,
            @FText[StrtPos], L2, PChar(FindText), L2) = 2;
  {$ENDIF}
  {$ELSE}
  Result := CompareString(LOCALE_SYSTEM_DEFAULT, cmp_fl,
            FText.Substring(StrtPos), L2, FindText, L2) = 2;
  {$ENDIF}
end;

procedure TSyntMemoStrings.ModifiedChanged;
begin
  if Assigned(FOnModifiedChanged) then
    FOnModifiedChanged(Self);
end;

// Search routine
function TSyntMemoStrings.Find(var StrtPos, EndPos: integer;
              const FindText: ecString;
              Flags: integer): Boolean;
  function DoMatch(Pos: integer): Boolean;
  begin
    Result := (not ((Flags and FF_WHOLEWORD) <> 0) or
              ((Pos <= 1) or not IsWordChar(FText[Pos - 1]) or not IsWordChar(FText[Pos])) and
              ((Pos + Length(FindText) >= Length(FText)) or
              not IsWordChar(FText[Pos + Length(FindText)]) or
              not IsWordChar(FText[Pos + Length(FindText)-1]))) and
              MatchAtPos(Pos, FindText, (Flags and FF_CASESENSITIVE) <> 0);
  end;

var i, L: integer;
begin
  Result := False;
  L := Length(FText);
  if (EndPos < 1) or (EndPos > L) then EndPos := L;
  if StrtPos < 1 then StrtPos := 1 else
   if StrtPos > L then Exit;

  L := Length(FindText);
  if EndPos - StrtPos + 1 < L then Exit;
  if L > 1 then
    dec(EndPos, L - 1);

  if (Flags and FF_BACKWARD) <> 0 then
   begin
     for i := EndPos downto StrtPos do
      if DoMatch(i) and ((L > 0) or (i < EndPos)) then // <== fix
       begin
         Result := true;
         StrtPos := i;
         EndPos := i + L;
         Exit;
       end;
   end else
     for i := StrtPos to EndPos do
      if DoMatch(i) and ((L > 0) or (i > StrtPos)) then // <== fix
       begin
         Result := true;
         StrtPos := i;
         EndPos := i + L;
         Exit;
       end;
end;

function TSyntMemoStrings.GetModified: Boolean;
begin
  Result := FModified or (UndoList.Count - RedoCount <> FUndoCountAfterSave);
end;

procedure TSyntMemoStrings.SetModified(const Value: Boolean);
var oldMod: Boolean;
begin
  oldMod := Modified;
  FModified := Value;
  if not Value then
    begin
      ClearUndo;
      SaveLineStates;
//      ResetLineStates;
    end;
  if oldMod <> Modified then
    ModifiedChanged;
end;

procedure TSyntMemoStrings.ClearUndo;
var oldMod: Boolean;
begin
  oldMod := Modified;
  UndoList.Clear;
  RedoCount := 0;
  FUndoCountAfterSave := 0;
  if oldMod <> Modified then
    ModifiedChanged;
end;

procedure TSyntMemoStrings.ClearRedo;
var i: integer;
    oldMod: Boolean;
begin
  oldMod := Modified;
  for i := 1 to RedoCount do
    UndoList.Delete(UndoList.Count - 1);
  RedoCount := 0;
  if oldMod <> Modified then
    ModifiedChanged;
end;

procedure TSyntMemoStrings.SaveUndoState;
var oldMod: Boolean;
begin
  oldMod := Modified;
  FUndoCountAfterSave := UndoList.Count;
  FModified := False;
  if oldMod <> Modified then
    ModifiedChanged;
end;

procedure TSyntMemoStrings.SetRedoCount(const Value: integer);
var oldMod: Boolean;
begin
  oldMod := Modified;
  FRedoCount := Value;
  if oldMod <> Modified then
    ModifiedChanged;
end;

function TSyntMemoStrings.GetLineState(Line: integer): TLineState;
begin
  Result := TLineState(FLineStates[Line]);
end;

procedure TSyntMemoStrings.SetLineState(Line: integer;
  const Value: TLineState);
begin
  FLineStates[Line] := TObject(Value);
end;

procedure TSyntMemoStrings.ResetLineStates(FromLine, ToLine: integer);
var i, e: integer;
begin
  if (ToLine = -1) or (ToLine >= FLineStates.Count) then e := FLineStates.Count - 1
   else e := ToLine;
  for i := FromLine to e do
    FLineStates[i] := nil;
end;

procedure TSyntMemoStrings.SaveLineStates;
var i: integer;
begin
  for i := 0 to FLineStates.Count - 1 do
    if FLineStates[i] <> nil then
      FLineStates[i] := TObject(lsSaved);
end;

{$IFDEF EC_MBCS}
function TSyntMemoStrings.CharType(Index: integer): TMbcsByteType;
begin
  if (Index > 0) and (Index <= Length(FText)) then
    Result := TestCharType(FText, Index, FCharSet)
  else
    Result := mbSingleByte;
end;
{$ENDIF}

procedure TSyntMemoStrings.AddUndo(op: TTextOperation; const aInsTxt, aDelTxt: ecString;
  aPos: integer; MovedCaret: Boolean);
var ur: TUndoRec;
    oldMod: Boolean;
begin
  // remove redo items
  ClearRedo;

  // create undo item
  if (UndoList.Count > 0) then
    with TUndoRec(UndoList.Last) do
      if (Operation = toDelete) and (op = toInsert) and
         (aDelTxt = '') and (Position = aPos) then
        begin
          Operation := toInsert;
          InsText := aInsTxt;
          CaretChanged := MovedCaret;
          Exit;
        end;

  oldMod := Modified;
  ur := TUndoRec.Create;
  ur.Operation := op;
  ur.InsText := aInsTxt;
  ur.DelText := aDelTxt;
  ur.Position := aPos;
  ur.CaretChanged := MovedCaret;
  ur.GroupIndex := FGroupIndex;
  UndoList.Add(ur);
  CutUndoList;
  if oldMod <> Modified then
    ModifiedChanged;
end;

procedure TSyntMemoStrings.BeginUndoGroup;
begin
  if FGroupUndoCount = 0 then
     if UndoList.Count - RedoCount > 0 then
      FGroupIndex := TUndoRec(UndoList[UndoList.Count - RedoCount - 1]).GroupIndex + 1
     else
      FGroupIndex := 0;
  Inc(FGroupUndoCount);
end;

procedure TSyntMemoStrings.EndUndoGroup;
begin
  Dec(FGroupUndoCount);
  if FGroupUndoCount <= 0 then
   begin
     FGroupUndoCount := 0;
     FGroupIndex := -1;
   end;
end;

{$IFDEF EC_VCL12_UP}
procedure TSyntMemoStrings.LoadFromStream(Stream: TStream; Encoding: TEncoding);
begin
  LoadFromStream(Stream);
end;

procedure TSyntMemoStrings.SaveToStream(Stream: TStream; Encoding: TEncoding);
begin
  SaveToStream(Stream);
end;
{$ENDIF}

end.

