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

unit ecMultRepl;

interface

uses Windows, Classes, Controls, ecStrUtils, eczRegExpr, ecSyntMemo, ecSyntAnal;

type
  TecReplaceFlags = set of (rfRegularExpr,
                            rfReplaceTemplate,
                            rfKeepPosition,
                            rfCaseSensitive,
                            rfWordBreakBound);

  TecReplaceItems = class;

  TecReplaceItem = class(TCollectionItem)
  private
    FReplaceText: ecString;
    FFlags: TecReplaceFlags;
    FRegExpr: TecRegExpr;
    FSubItems: TecReplaceItems;
    FPassNumber: integer;
    procedure SetFindText(const Value: ecString);
    procedure SetFlags(const Value: TecReplaceFlags);
    procedure SetReplaceText(const Value: ecString);
    function GetFindText: ecString;
    procedure SetSubItems(const Value: TecReplaceItems);
    procedure SetPassNumber(const Value: integer);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function DoReplace(var Text: ecString; var Pos: integer): Boolean;
  published
    property FindText: ecString read GetFindText write SetFindText;
    property ReplaceText: ecString read FReplaceText write SetReplaceText;
    property Flags: TecReplaceFlags read FFlags write SetFlags default [rfRegularExpr, rfReplaceTemplate];
    property PassNumber: integer read FPassNumber write SetPassNumber default 0;
    property SubItems: TecReplaceItems read FSubItems write SetSubItems;
  end;

  TecReplaceItems = class(TCollection)
  private
    FOnChange: TNotifyEvent;
    function GetItem(Index: integer): TecReplaceItem;
  protected
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create;
    function Add: TecReplaceItem;
    procedure Transform(var Text: ecString; CurPass: integer);
    property Items[Index: integer]: TecReplaceItem read GetItem; default;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TecReplaceGroup = class(TCollectionItem)
  private
    FOnlySelection: Boolean;
    FCategory: ecString;
    FGroupIndex: integer;
    FShortCut: TShortCut;
    FItems: TecReplaceItems;
    FRegExpr: TecRegExpr;
    FDisplayName: string;
    FNotes: TStrings;
    FMaxPass: integer;
    procedure SetCategory(const Value: ecString);
    procedure SetCheckStart(const Value: ecString);
    procedure SetGroupIndex(const Value: integer);
    procedure SetOnlySelection(const Value: Boolean);
    procedure SetShortCut(const Value: TShortCut);
    procedure SetItems(const Value: TecReplaceItems);
    procedure SetNotes(const Value: TStrings);
    procedure ItemsChanged(Sender: TObject);
    function GetCheckStart: ecString;
  protected
    function GetDisplayName: string; override;
    procedure SetDisplayName(const Value: string); override;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;

    function Execute(Memo: TCustomSyntaxMemo): Boolean;
    function IsEnabled(Memo: TCustomSyntaxMemo): Boolean;
  published
    property Category: ecString read FCategory write SetCategory;
    property OnlySelection: Boolean read FOnlySelection write SetOnlySelection;
    property ShortCut: TShortCut read FShortCut write SetShortCut;
    property GroupIndex: integer read FGroupIndex write SetGroupIndex;
    property CheckStart: ecString read GetCheckStart write SetCheckStart;
    property Items: TecReplaceItems read FItems write SetItems;
    property Notes: TStrings read FNotes write SetNotes;
    property DisplayName;
  end;

  TecReplaceGroups = class(TCollection)
  private
    function GetItem(Index: integer): TecReplaceGroup;
  public
    constructor Create;
    function Add: TecReplaceGroup;
    property Items[Index: integer]: TecReplaceGroup read GetItem; default;
  end;

  TecMultiReplace = class(TSyntMemoPlugin, IecSyntMemoPlugIn)
  private
    FItems: TecReplaceGroups;
    procedure SetItems(const Value: TecReplaceGroups);
    // IecSyntMemoPlugIn
    function HandleKeyStroke(AShortCut: TShortCut): Boolean;
    function HandleMouse(Button: TMouseButton; Shift: TShiftState; X, Y: Integer): Boolean;
    procedure UpdateCursor(X, Y: Integer; Shift: TShiftState; var Cursor: TCursor);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;

    function Customize: Boolean;
    function SelectExecute(Memo : TCustomSyntaxMemo): Boolean;
    procedure SaveToFile(const FileName: string);
    procedure LoadFromFile(const FileName: string);
  published
    property Items: TecReplaceGroups read FItems write SetItems;
    property SyntMemo;
  end;

implementation

uses SysUtils, ecMultReplDlg, ecMultReplSelectDlg, Forms;

{ TecReplaceItem }

constructor TecReplaceItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FRegExpr := TecRegExpr.Create;
  FFlags := [rfRegularExpr, rfReplaceTemplate];
  FSubItems := TecReplaceItems.Create;
end;

destructor TecReplaceItem.Destroy;
begin
  FRegExpr.Free;
  FSubItems.Free;
  inherited;
end;

function TecReplaceItem.GetFindText: ecString;
begin
  Result := FRegExpr.Expression;
end;

procedure TecReplaceItem.SetFindText(const Value: ecString);
begin
  FRegExpr.Expression := Value;
  Changed(False);
end;

procedure TecReplaceItem.SetFlags(const Value: TecReplaceFlags);
begin
  FFlags := Value;
  FRegExpr.ModifierI := not (rfCaseSensitive in FFlags);
  Changed(False);
end;

procedure TecReplaceItem.SetReplaceText(const Value: ecString);
begin
  FReplaceText := Value;
  Changed(False);
end;

// Pos - zero-based
function TecReplaceItem.DoReplace(var Text: ecString;
  var Pos: integer): Boolean;
var mLen, cmp_fl, L2: integer;
    S: ecString;
begin
  if rfRegularExpr in FFlags then
   begin
    mLen := Pos;
    Result := FRegExpr.Match(Text, mLen);
    if Result then
      mLen := mLen - Pos;
   end
  else
   begin
    S := FregExpr.Expression;
    L2 := Length(S);
    if rfCaseSensitive in FFlags then cmp_fl := 0
                                 else cmp_fl := NORM_IGNORECASE;
    if (Pos > Length(Text) - L2) or (L2 = 0) then
     begin
      Result := False;
      Exit;
     end;

    {$IFNDEF EC_DOTNET}
    {$IFDEF EC_UNICODE}
    Result := CompareStringW(LOCALE_SYSTEM_DEFAULT, cmp_fl,
              @Text[Pos], L2, PWideChar(S), L2) = 2;
    {$ELSE}
    Result := CompareStringA(LOCALE_SYSTEM_DEFAULT, cmp_fl,
              @Text[Pos], L2, PChar(S), L2) = 2;
    {$ENDIF}
    {$ELSE}
    Result := CompareString(LOCALE_SYSTEM_DEFAULT, cmp_fl,
              Text.Substring(Pos), L2, S, L2) = 2;
    {$ENDIF}
    if Result then mLen := L2;
   end;

  if (rfWordBreakBound in FFlags) and Result then
    Result := IsWordBreak(Pos, Text) and IsWordBreak(Pos + mLen, Text);

  // Perform replacing
  if Result then
    begin
      if (rfReplaceTemplate in FFlags) and (rfRegularExpr in FFlags) then
        S := FRegExpr.Substitute(Text, FReplaceText)
      else
        S := FReplaceText;
      SubItems.Transform(S, -1);

      Delete(Text, Pos, mLen);
      Insert(S, Text, Pos);
      if not (rfKeepPosition in FFlags) then
        Inc(Pos, Length(S));
    end;
end;

procedure TecReplaceItem.Assign(Source: TPersistent);
begin
  if Source is TecReplaceItem then
    with Source as TecReplaceItem do
      begin
        Self.ReplaceText := ReplaceText;
        Self.FindText := FindText;
        Self.Flags := Flags;
        Self.SubItems := SubItems;
        Self.PassNumber := PassNumber;
      end
  else inherited;
end;

procedure TecReplaceItem.SetSubItems(const Value: TecReplaceItems);
begin
  FSubItems.Assign(Value);
  Changed(False);
end;

procedure TecReplaceItem.SetPassNumber(const Value: integer);
begin
  FPassNumber := Value;
  Changed(False);
end;

{ TecReplaceItems }

function TecReplaceItems.Add: TecReplaceItem;
begin
  Result := TecReplaceItem(inherited Add);
end;

constructor TecReplaceItems.Create;
begin
  inherited Create(TecReplaceItem);
end;

function TecReplaceItems.GetItem(Index: integer): TecReplaceItem;
begin
  Result := TecReplaceItem(inherited Items[Index]);
end;

procedure TecReplaceItems.Transform(var Text: ecString; CurPass: integer);
var i, Pos: integer;
    tick: LongWord;
    res: Boolean;
    List: TList;
begin
  Pos := 1;
  tick := GetTickCount;
  List := TList.Create;
  try
    for i := 0 to Count - 1 do
      if (CurPass = -1) or (Items[i].PassNumber = CurPass) then
        List.Add(Items[i]);
    if List.Count = 0 then Exit;
    while Pos <= Length(Text) do
     begin
       res := False;
       for i := 0 to List.Count - 1 do
        begin
          res := res or TecReplaceItem(List[i]).DoReplace(Text, Pos);
          if GetTickCount - tick > 60000 then
            Raise Exception.Create('Transformation terminated due to long execution time.');
        end;
       if not res then
         Inc(Pos);
     end;
  finally
    List.Free;
  end;
end;

procedure TecReplaceItems.Update(Item: TCollectionItem);
begin
  inherited;
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

{ TecReplaceGroup }

procedure TecReplaceGroup.Assign(Source: TPersistent);
begin
  if Source is TecReplaceGroup then
    with Source as TecReplaceGroup do
      begin
        Self.Category := Category;
        Self.OnlySelection := OnlySelection;
        Self.ShortCut := ShortCut;
        Self.GroupIndex := GroupIndex;
        Self.CheckStart := CheckStart;
        Self.Items := Items;
        Self.DisplayName := DisplayName;
        Self.Notes := Notes;
      end
  else inherited;
end;

constructor TecReplaceGroup.Create(Collection: TCollection);
begin
  inherited;
  FItems := TecReplaceItems.Create;
  FItems.OnChange := ItemsChanged;
  FNotes := TStringList.Create;
end;

destructor TecReplaceGroup.Destroy;
begin
  FItems.Free;
  FNotes.Free;
  if FRegExpr <> nil then
    FRegExpr.Free;
  inherited;
end;

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

procedure TecReplaceGroup.SetCategory(const Value: ecString);
begin
  FCategory := Value;
end;

procedure TecReplaceGroup.SetCheckStart(const Value: ecString);
begin
  if Value = '' then
    begin
      if FRegExpr <> nil then
        begin
          FRegExpr.Free;
          FRegExpr := nil;
        end;
    end else
    begin
      if FRegExpr = nil then
        FRegExpr := TecRegExpr.Create;
      FRegExpr.Expression := Value;
    end;
end;

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

procedure TecReplaceGroup.SetGroupIndex(const Value: integer);
begin
  FGroupIndex := Value;
  Changed(False);
end;

procedure TecReplaceGroup.SetItems(const Value: TecReplaceItems);
begin
  FItems.Assign(Value);
  Changed(False);
end;

procedure TecReplaceGroup.SetOnlySelection(const Value: Boolean);
begin
  FOnlySelection := Value;
  Changed(False);
end;

procedure TecReplaceGroup.SetShortCut(const Value: TShortCut);
begin
  FShortCut := Value;
  Changed(False);
end;

function TecReplaceGroup.IsEnabled(Memo: TCustomSyntaxMemo): Boolean;
var sPos: integer;
begin
  Result := (Memo <> nil) and (not Memo.ReadOnly) and
            (not OnlySelection or (Memo.SelLength > 0) and (Memo.SelectMode <> msColumn) and
            Memo.CanClearSelection);
  if Result and (FRegExpr <> nil) then
    begin
      sPos := Memo.SelStart + 1;
      Result := FRegExpr.Match(Memo.Lines.FText, sPos);
    end;
end;

function TecReplaceGroup.Execute(Memo: TCustomSyntaxMemo): Boolean;
var Text: ecString;
    i: integer;
    Sel: Boolean;
begin
  Result := IsEnabled(Memo);
  if not Result then Exit;
  Sel := (Memo.SelLength > 0) and (Memo.SelectMode <> msColumn);
  if Sel then
    Text := Memo.SelText
  else
    Text := Memo.Lines.FText;

  // Text transformation
  for i := 0 to FMaxPass do
    Items.Transform(Text, i);

  // Replace text in control
  if Sel then
    Memo.SelText := Text
  else
    Memo.ReplaceText(0, Memo.TextLength, Text);
end;

procedure TecReplaceGroup.SetNotes(const Value: TStrings);
begin
  FNotes.Assign(Value);
  Changed(False);
end;

procedure TecReplaceGroup.ItemsChanged(Sender: TObject);
var i: integer;
begin
  FMaxPass := 0;
  for i := 0 to Items.Count - 1 do
    if Items[i].PassNumber > FMaxPass then
      FMaxPass := Items[i].PassNumber;
end;

function TecReplaceGroup.GetCheckStart: ecString;
begin
  if FRegExpr = nil then
    Result := ''
  else
    Result := FRegExpr.Expression;
end;

{ TecReplaceGroups }

function TecReplaceGroups.Add: TecReplaceGroup;
begin
  Result := TecReplaceGroup(inherited Add);
end;

constructor TecReplaceGroups.Create;
begin
  inherited Create(TecReplaceGroup);
end;

function TecReplaceGroups.GetItem(Index: integer): TecReplaceGroup;
begin
  Result := TecReplaceGroup(inherited Items[Index]);
end;

{ TecMultiReplace }

procedure TecMultiReplace.Assign(Source: TPersistent);
begin
  if Source is TecMultiReplace then
   with Source as TecMultiReplace do
    begin
      Self.FItems.Assign(FItems);
    end;
end;

constructor TecMultiReplace.Create(AOwner: TComponent);
begin
  inherited;
  FItems := TecReplaceGroups.Create;
end;

function TecMultiReplace.Customize: Boolean;
begin
  with TMultiReplaceDlg.Create(nil) do
    try
      Comp.Assign(Self);
      FillTree;
      Result := ShowModal = mrOk;
      if Result then
        Self.Assign(Comp);
    finally
      Free;
    end;
end;

destructor TecMultiReplace.Destroy;
begin
  FItems.Free;
  inherited;
end;

function TecMultiReplace.SelectExecute(Memo : TCustomSyntaxMemo): Boolean;
begin
  with TMultiReplaceSelectDlg.Create(nil) do
    try
      MultiReplace := Self;
      SyntaxMemo := Memo;
      Result := ShowModal = mrOk;
    finally
      Free;
    end;
end;

function TecMultiReplace.HandleKeyStroke(AShortCut: TShortCut): Boolean;
var i: integer;
begin
  if SyntMemo <> nil then
  for i := 0 to Items.Count - 1 do
    if Items[i].ShortCut = AShortCut then
      begin
        Result := Items[i].Execute(SyntMemo);
        if Result then Exit;
      end;
  Result := False;
end;

function TecMultiReplace.HandleMouse(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer): Boolean;
begin
  Result := False;
end;

procedure TecMultiReplace.LoadFromFile(const FileName: string);
begin
  try
    LoadComponentFromFile(Self, FileName);
  except
    Application.HandleException(Self);
  end;
end;

procedure TecMultiReplace.SaveToFile(const FileName: string);
begin
  SaveComponentToFile(Self, FileName);
end;

procedure TecMultiReplace.SetItems(const Value: TecReplaceGroups);
begin
  FItems.Assign(Value);
end;

procedure TecMultiReplace.UpdateCursor(X, Y: Integer; Shift: TShiftState;
  var Cursor: TCursor);
begin
end;

end.
