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

unit ecAutoReplace;

interface

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

type
  TOnAutoReplaceEvent = procedure(APos: integer; const AWord: ecString; var AReplace: ecString; var Accept: Boolean) of object;

  TSyntAutoReplace = class(TSyntMemoPlugin, {$IFNDEF EC_DOTNET}IUnknown,{$ENDIF}IecTextClient, IecCommandHook)
  private
    FEnabled: Boolean;
    FItems: TStrings;
    FIndex: TzStringList;
    FSeparator: Char;
    FMaintainCase: Boolean;
    FCorrCurCmd: integer;
    FCorrAllCmd: integer;
    FOnAutoReplace: TOnAutoReplaceEvent;
    FCaseConsistancy: Boolean;
    FOnCheckChar: TCheckCharEvent;
    FRegExpr: TecRegExpr;
    FSmartReplace: Boolean;
    procedure SetItems(const Value: TStrings);
    procedure SetSeparator(const Value: Char);
    procedure ItemsChanged(Sender: TObject);
    function GetIgnoreCase: Boolean;
    procedure SetIgnoreCase(const Value: Boolean);
    function GetWordAt(APos: integer; var Ws, We: integer): Boolean;
    function GetActExpr: string;
    procedure SetActExpr(const Value: string);
    procedure SkipRead(Reader: TReader);
  protected
    procedure TextChanged(Sender: TObject; Pos, Count, LineChange: integer);
    function FindReplaceItem(const AWord: ecString; out AReplace: ecString): Boolean;
    function CorrectAtPos(aPos: integer; var Delta: Integer): Boolean; overload;
    function CorrectAtPos(aPos: integer): Boolean; overload;
    function DoReplace(var AReplace: ecString; WStart, WLength: integer): Boolean;
    function IsLegalChar(C: ecChar): boolean; virtual;
    procedure BeforeCommand(Command: integer; Data: ecPointer; var Handled: Boolean);
    procedure AfterCommand(Command: integer; Data: ecPointer; var Handled: Boolean);
    procedure IsCommandEnabled(Command: integer; Data: ecPointer; var Enable: Boolean);
    procedure DefineProperties(Filer: TFiler); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function CorrectCur: Boolean;  // Replace word at cursor
    function CorrectAll: integer;  // Replace all words
  published
    property Separator: Char read FSeparator write SetSeparator default Char('=');
    property Items: TStrings read FItems write SetItems;
    property Enabled: Boolean read FEnabled write FEnabled default True;
    property IgnoreCase: Boolean read GetIgnoreCase write SetIgnoreCase default True;
    property MaintainCase: Boolean read FMaintainCase write FMaintainCase default True;
    property CaseConsistancy: Boolean read FCaseConsistancy write FCaseConsistancy default True;
    property CorrCurCmd: integer read FCorrCurCmd write FCorrCurCmd default smAutoCorrectCur;
    property CorrAllCmd: integer read FCorrAllCmd write FCorrAllCmd default smAutoCorrectAll;
    property OnAutoReplace: TOnAutoReplaceEvent read FOnAutoReplace write FOnAutoReplace;
    property OnCheckChar: TCheckCharEvent read FOnCheckChar write FOnCheckChar;
    property SyntMemo;
    property ActivateExpression: string read GetActExpr write SetActExpr;
    property SmartReplace: Boolean read FSmartReplace write FSmartReplace default False;
  end;

implementation

uses SysUtils, ecMemoStrings;

{ TSyntAutoReplace }

constructor TSyntAutoReplace.Create(AOwner: TComponent);
begin
  inherited;
  FIndex := TzStringList.Create;
  FIndex.Sorted := True;
  FIndex.CaseSensitive := False;
  FItems := TStringList.Create;
  TStringList(FItems).OnChange := ItemsChanged;
  FEnabled := True;
  FMaintainCase := True;
  FSeparator := '=';
  FCorrCurCmd := smAutoCorrectCur;
  FCorrAllCmd := smAutoCorrectAll;
  FSmartReplace := False;
  FCaseConsistancy := True;
end;

destructor TSyntAutoReplace.Destroy;
begin
  FreeAndNil(FIndex);
  FreeAndNil(FItems);
  FreeAndNil(FRegExpr);
  inherited;
end;

function TSyntAutoReplace.IsLegalChar(C: ecChar): boolean;
begin
  Result := IsWordChar(ecChar(C));
  if Assigned(FOnCheckChar) then
    FOnCheckChar(Self, Ord(C), Result);
end;

function TSyntAutoReplace.GetWordAt(APos: integer; var Ws,
  We: integer): Boolean;
begin
  if SyntMemo = nil then Result := False else
   with SyntMemo.Lines do
     begin
       Ws := APos;
       We := APos;
       while (Ws > 0) and IsLegalChar(Chars[Ws]) do Dec(Ws);
       while (We < TextLength - 1) and IsLegalChar(Chars[We + 1]) do Inc(We);
       Result := Ws < We;
     end;
end;

procedure TSyntAutoReplace.TextChanged(Sender: TObject; Pos, Count,
  LineChange: integer);

  function CanStart: Boolean;
  var C: ecChar;
      i: integer;
  begin
    with SyntMemo do
    if Assigned(FRegExpr) then
      begin
        i := Pos + 1;
        Result := (Count > 0) and FRegExpr.Match(Lines.FText, i);
      end else
      begin
        C := Lines.Chars[Pos + 1];
        Result := (Count = 1) and IsSpaceChar(C) or
                  (Count > 1) and IsLineBreakChar(C);
        if Result then
          for i := 1 to Count do
            if not IsSpaceChar(Lines.Chars[Pos + i]) then
              begin
                Result := False;
                Exit;
              end;
      end;
  end;

var D: integer;
begin
   with SyntMemo do
    if FEnabled and (Pos > 0) and
       IsLegalChar(Lines.Chars[Pos]) and
       CanStart and
       CorrectAtPos(CaretStrPos, D)
    then
       CaretStrPos := Pos + Count + D;
end;

function TSyntAutoReplace.CorrectAtPos(aPos: integer; var Delta: integer): Boolean;
var ws, we: integer;
    RStr: ecString;
  function FindReplace: Boolean;
  var i: integer;
  begin
    for i := we - ws downto 1 do
      if FindReplaceItem(SyntMemo.Lines.SubString(we - i + 1, i), RStr) then
        begin
          ws := we - i;
          Result := True;
          Exit;
        end;
    Result := False;
  end;
begin
  with SyntMemo do
   begin
     Result := GetWordAt(aPos, ws, we);
     if Result then
       begin
         if SmartReplace then
           Result := FindReplace
         else
           Result := FindReplaceItem(Lines.SubString(ws + 1, we - ws), RStr);
         if Result then
           begin
             DoReplace(RStr, ws, we - ws);
             Delta := Length(RStr) - (we - ws)
           end;
       end;
  end;
end;

function TSyntAutoReplace.CorrectAtPos(aPos: integer): Boolean;
var D: integer;
begin
  Result := CorrectAtPos(aPos, D);
end;

procedure TSyntAutoReplace.SetItems(const Value: TStrings);
begin
  FItems.Assign(Value);
end;

procedure TSyntAutoReplace.ItemsChanged(Sender: TObject);
var i, k: integer;
    S: string;
begin
  FIndex.Clear;
  for i := 0 to FItems.Count - 1 do
   begin
    S := FItems[i];
    k := Pos(FSeparator, S);
    if k > 0 then S := Copy(S, 1, k - 1);
    S := Trim(S);
    FIndex.AddObject(S, TObject(i));
   end;
end;

procedure TSyntAutoReplace.SetSeparator(const Value: Char);
var i, k: integer;
    S: string;
begin
  if (FSeparator <> Value) and not (csLoading in ComponentState) then
   begin
     FItems.BeginUpdate;
     try
       for i := 0 to FItems.Count - 1 do
        begin
         S := FItems[i];
         k := Pos(FSeparator, S);
         if k > 0 then S[k] := Value;
         FItems[i] := S;
        end;
     finally
       FItems.EndUpdate;
     end;
   end;
  FSeparator := Value;
end;

function TSyntAutoReplace.GetIgnoreCase: Boolean;
begin
  Result := not FIndex.CaseSensitive;
end;

procedure TSyntAutoReplace.SetIgnoreCase(const Value: Boolean);
begin
  FIndex.CaseSensitive := not Value;
end;

function TSyntAutoReplace.FindReplaceItem(const AWord: ecString;
  out AReplace: ecString): Boolean;
var k: integer;
    S: ecString;
begin
  k := FIndex.IndexOf(AWord);
  Result := k <> -1;
  if Result then
   begin
    k := integer(FIndex.Objects[k]);
    S := FItems[k];
    k := Pos(FSeparator, S);
    if k > 0 then
     begin
      AReplace := Trim(Copy(S, k + 1, Length(S) - k));
      if FMaintainCase and (Length(AReplace) > 0) then
       begin
        AReplace := LowerCase(AReplace);
        if AWord[1] = ecUpCase(AWord[1]) then
          AReplace[1] := ecUpCase(AReplace[1]);
       end;
     end else
    if FCaseConsistancy then AReplace := S
     else Result := False;
   end;
end;

function TSyntAutoReplace.CorrectCur: Boolean;
begin
  Result := (SyntMemo <> nil) and CorrectAtPos(SyntMemo.CaretStrPos);
end;

function TSyntAutoReplace.CorrectAll: integer;
var Text, ReplStr: ecString;
    i, we: integer;
begin
  Result := 0;
  if SyntMemo <> nil then
   begin
    Text := SyntMemo.Lines.Text;
    we := 0;
    SyntMemo.BeginUpdate;
    try
      for i := Length(Text) downto 1 do
       begin
        if IsLegalChar(Text[i]) then
         begin
           if we = 0 then we := i;
         end else
        if we <> 0 then
         begin
           if FindReplaceItem(Copy(Text, i + 1, we - i), ReplStr) and
              DoReplace(ReplStr, i, we - i) then
            Inc(Result);
           we := 0;
         end;
       end;
      if (we > 0) and FindReplaceItem(Copy(Text, 1, we), ReplStr) and
         DoReplace(ReplStr, 0, we) then Inc(Result);
    finally
      SyntMemo.EndUpdate;
    end;
   end;
end;

function TSyntAutoReplace.DoReplace(var AReplace: ecString; WStart,
  WLength: integer): Boolean;
begin
  Result := True;
  if Assigned(FOnAutoReplace) then
    FOnAutoReplace(WStart, SyntMemo.Lines.SubString(WStart + 1, WLength), AReplace, Result);
  if Result then
    SyntMemo.ReplaceText(WStart, WLength, AReplace);
end;

function TSyntAutoReplace.GetActExpr: string;
begin
  if Assigned(FRegExpr) then
    Result := FRegExpr.Expression
  else
    Result := '';
end;

procedure TSyntAutoReplace.SetActExpr(const Value: string);
begin
  if Value = '' then
    begin
      if Assigned(FRegExpr) then
        FreeAndNil(FRegExpr);
    end else
    begin
      if not Assigned(FRegExpr) then
        FRegExpr := TecRegExpr.Create;
      FRegExpr.Expression := Value;
    end;
end;

procedure TSyntAutoReplace.AfterCommand(Command: integer; Data: ecPointer;
  var Handled: Boolean);
begin

end;

procedure TSyntAutoReplace.BeforeCommand(Command: integer; Data: ecPointer;
  var Handled: Boolean);
begin
  if Command = FCorrCurCmd then
    begin
      Handled := CorrectCur;
    end else
  if Command = FCorrAllCmd then
    begin
      Handled := CorrectAll > 0;
    end;
end;

procedure TSyntAutoReplace.IsCommandEnabled(Command: integer;
  Data: ecPointer; var Enable: Boolean);
begin
  if (Command = FCorrCurCmd) or (Command = FCorrAllCmd) then
    Enable := True;
end;

procedure TSyntAutoReplace.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineProperty('CorrCurKey', SkipRead, nil, False);
  Filer.DefineProperty('CorrAllKey', SkipRead, nil, False);
end;

procedure TSyntAutoReplace.SkipRead(Reader: TReader);
begin
  {$IFDEF EC_VCL5}
  Reader.ReadInteger;
  {$ELSE}
  Reader.SkipValue;
  {$ENDIF}
end;

end.
