unit ce_search;

{$I ce_defines.inc}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  Menus, StdCtrls, actnList, Buttons, SynEdit, SynEditSearch, SynEditTypes,
  ce_common, ce_mru, ce_widget, ce_synmemo, ce_interfaces, ce_observer,
  ce_writableComponent, ce_dialogs, strutils;

type

  // TCESearchWidget persistents settings
  TCESearchOptions = class(TWritableLfmTextComponent)
  private
    fPrompt: boolean;
    fFromCur: boolean;
    fRegex: boolean;
    fCaseSens:boolean;
    fBackWard: boolean;
    fWholeWord: boolean;
    fMrSearches: TStringList;
    fMrReplacements: TStringList;
    procedure setMrSearches(aValue: TStringList);
    procedure setMrReplacements(aValue: TStringList);
  published
    property prompt: boolean read fPrompt write fPrompt;
    property fromCursor: boolean read fFromCur write fFromCur;
    property regex: boolean read fRegex write fRegex;
    property caseSensistive: boolean read fCaseSens write fCaseSens;
    property backward: boolean read fBackWard write fBackWard;
    property wholeWord: boolean read fWholeWord write fWholeWord;
    property recentSearches: TStringList read fMrSearches write setMrSearches;
    property recentReplacements: TStringList read fMrReplacements write setMrReplacements;
  public
    procedure afterLoad; override;
    constructor create(aOwner: TComponent); override;
    destructor destroy; override;
    procedure Assign(aValue: TPersistent); override;
    procedure AssignTo(aValue: TPersistent); override;
  end;

  { TCESearchWidget }
  TCESearchWidget = class(TCEWidget, ICEMultiDocObserver)
    btnFind: TBitBtn;
    btnFindAll: TBitBtn;
    btnReplace: TBitBtn;
    btnReplaceAll: TBitBtn;
    cbToFind: TComboBox;
    cbReplaceWth: TComboBox;
    chkEnableRep: TCheckBox;
    chkPrompt: TCheckBox;
    chkRegex: TCheckBox;
    chkWWord: TCheckBox;
    chkBack: TCheckBox;
    chkFromCur: TCheckBox;
    chkCaseSens: TCheckBox;
    grpOpts: TGroupBox;
    imgList: TImageList;
    Panel1: TPanel;
    procedure cbReplaceWthChange(Sender: TObject);
    procedure cbToFindChange(Sender: TObject);
    procedure chkEnableRepChange(Sender: TObject);
  private
    fDoc: TCESynMemo;
    fToFind: string;
    fReplaceWth: string;
    fActReplaceNext: TAction;
    fActFindNext: TAction;
    fActReplaceAll: TAction;
    fActFindAll: TAction;
    fSearchMru, fReplaceMru: TCEMruList;
    fCancelAll: boolean;
    fHasSearched: boolean;
    fHasRestarted: boolean;
    function getOptions: TSynSearchOptions;
    procedure actReplaceAllExecute(sender: TObject);
    procedure replaceEvent(Sender: TObject; const ASearch, AReplace:
      string; Line, Column: integer; var ReplaceAction: TSynReplaceAction);
  protected
    procedure updateImperative; override;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    //
    procedure docNew(aDoc: TCESynMemo);
    procedure docClosing(aDoc: TCESynMemo);
    procedure docFocused(aDoc: TCESynMemo);
    procedure docChanged(aDoc: TCESynMemo);
    //
    procedure actFindNextExecute(sender: TObject);
    procedure actReplaceNextExecute(sender: TObject);
    procedure actFindAllExecute(sender: TObject);
  end;

implementation
{$R *.lfm}

const
  OptsFname = 'search.txt';

{$REGION TCESearchOptions ------------------------------------------------------}
constructor TCESearchOptions.create(aOwner: TComponent);
begin
  inherited;
  fMrReplacements := TStringList.Create;
  fMrSearches := TStringList.Create;
end;

destructor TCESearchOptions.destroy;
begin
  fMrSearches.Free;
  fMrReplacements.Free;
  inherited;
end;

procedure TCESearchOptions.Assign(aValue: TPersistent);
var
  widg: TCESearchWidget;
begin
  if aValue is TCESearchWidget then
  begin
    widg := TCESearchWidget(aValue);
    fMrSearches.Assign(widg.fSearchMru);
    fMrReplacements.Assign(widg.fReplaceMru);
    fPrompt     := widg.chkPrompt.Checked;
    fBackWard   := widg.chkBack.Checked;
    fCaseSens   := widg.chkCaseSens.Checked;
    fRegex      := widg.chkRegex.Checked;
    fFromCur    := widg.chkFromCur.Checked;
    fWholeWord  := widg.chkWWord.Checked;
  end
  else inherited;
end;

procedure TCESearchOptions.AssignTo(aValue: TPersistent);
var
  widg: TCESearchWidget;
begin
  if aValue is TCESearchWidget then
  begin
    widg := TCESearchWidget(aValue);
    widg.cbToFind.Items.Assign(fMrSearches);
    widg.fSearchMru.Assign(fMrSearches);
    widg.cbReplaceWth.Items.Assign(fMrReplacements);
    widg.fReplaceMru.Assign(fMrReplacements);
    widg.chkPrompt.Checked  := fPrompt;
    widg.chkBack.Checked    := fBackWard;
    widg.chkCaseSens.Checked:= fCaseSens;
    widg.chkRegex.Checked   := fRegex;
    widg.chkFromCur.Checked := fFromCur;
    widg.chkWWord.Checked   := fWholeWord;
  end
  else inherited;
end;

procedure TCESearchOptions.setMrSearches(aValue: TStringList);
begin
  fMrSearches.Assign(aValue);
end;

procedure TCESearchOptions.setMrReplacements(aValue: TStringList);
begin
  fMrReplacements.Assign(aValue);
end;

procedure TCESearchOptions.afterLoad;
var
  i: integer;
begin
  inherited;
  for i := fMrReplacements.Count-1 downto 0 do
    if length(fMrReplacements[i]) > 128 then
      fMrReplacements.Delete(i);
  for i := fMrSearches.Count-1 downto 0 do
      if length(fMrSearches[i]) > 128 then
        fMrSearches.Delete(i);
end;
{$ENDREGION}

{$REGION Standard Comp/Obj------------------------------------------------------}
constructor TCESearchWidget.Create(aOwner: TComponent);
var
  fname: string;
begin
  inherited;
  fActFindNext := TAction.Create(self);
  fActFindNext.Caption := 'Find';
  fActFindNext.OnExecute := @actFindNextExecute;
  fActFindAll := TAction.Create(self);
  fActFindAll.Caption := 'Find all';
  fActFindAll.OnExecute := @actFindAllExecute;
  fActReplaceNext := TAction.Create(self);
  fActReplaceNext.Caption := 'Replace';
  fActReplaceNext.OnExecute := @actReplaceNextExecute;
  fActReplaceAll := TAction.Create(self);
  fActReplaceAll.Caption := 'Replace all';
  fActReplaceAll.OnExecute := @actReplaceAllExecute;
  //
  fSearchMru := TCEMruList.Create;
  fReplaceMru:= TCEMruList.Create;
  //
  fname := getCoeditDocPath + OptsFname;
  if FileExists(fname) then with TCESearchOptions.create(nil) do
  try
    loadFromFile(fname);
    AssignTo(self);
  finally
    free;
  end;
  //
  btnFind.Action := fActFindNext;
  btnReplace.Action := fActReplaceNext;
  btnReplaceAll.Action := fActReplaceAll;
  btnFindAll.Action := fActFindAll;
  updateImperative;
  //
  EntitiesConnector.addObserver(self);
end;

destructor TCESearchWidget.Destroy;
begin
  with TCESearchOptions.create(nil) do
  try
    Assign(self);
    saveToFile(getCoeditDocPath + OptsFname);
  finally
    free;
  end;
  //
  EntitiesConnector.removeObserver(self);
  fSearchMru.Free;
  fReplaceMru.Free;
  inherited;
end;
{$ENDREGION}

{$REGION ICEContextualActions---------------------------------------------------}
function TCESearchWidget.getOptions: TSynSearchOptions;
begin
  result := [];
  if chkRegex.Checked     then result += [ssoRegExpr];
  if chkWWord.Checked     then result += [ssoWholeWord];
  if chkBack.Checked      then result += [ssoBackwards];
  if chkCaseSens.Checked  then result += [ssoMatchCase];
  if chkPrompt.Checked    then result += [ssoPrompt];
end;

function dlgReplaceAll: TModalResult;
const
  Btns = [mbYes, mbNo, mbYesToAll, mbNoToAll];
begin
  exit( MessageDlg('Coedit', 'Replace this match ?', mtConfirmation, Btns, ''));
end;

procedure TCESearchWidget.replaceEvent(Sender: TObject; const ASearch, AReplace:
      string; Line, Column: integer; var ReplaceAction: TSynReplaceAction);
begin
  case dlgReplaceAll of
    mrYes: ReplaceAction := raReplace;
    mrNo: ReplaceAction := raSkip;
    mrYesToAll: ReplaceAction := raReplaceAll;
    mrCancel, mrClose, mrNoToAll:
      begin
        ReplaceAction := raCancel;
        fCancelAll := true;
      end;
  end;
end;

procedure TCESearchWidget.actFindAllExecute(sender: TObject);
var
  search: TSynEditSearch;
  options: TSynSearchOptions;
  start, stop: TPoint;
  startf, stopf: TPoint;
  msgs: ICEMessagesDisplay;
  msg: string;
  fmt: string;
  i: integer;
  res: array of TPoint = nil;
begin
  if fDoc.isNil then exit;
  //
  fSearchMru.Insert(0,fToFind);
  cbToFind.Items.Assign(fSearchMru);
  //
  search := TSynEditSearch.Create;
  try
    options := getOptions;
    search.Sensitive := ssoMatchCase in options;
    search.Whole := ssoWholeWord in options;
    search.RegularExpressions:= ssoRegExpr in options;
    search.Pattern:=fToFind;
    search.IdentChars:=fDoc.IdentChars;
    start := Point(1,1);
    stop := Point(high(integer), fDoc.Lines.Count);
    while search.FindNextOne(fDoc.Lines, start, stop, startf, stopf) do
    begin
      setLength(res, length(res) + 1);
      res[high(res)].X := startf.X;
      res[high(res)].Y := startf.Y;
      start := stopf;
    end;
    msgs := getMessageDisplay;
    msg := format('%d result(s) for the pattern <%s>', [length(res), fToFind]);
    msgs.message(msg, fDoc, amcMisc, amkInf);
    fmt := fDoc.fileName + '(%d,%d): "%s"';
    for i := 0 to high(res) do
    begin
      msg := format(fmt, [res[i].Y, res[i].X, Trim(fDoc.Lines.Strings[res[i].Y-1])]);
      msgs.message(msg, fDoc, amcMisc, amkInf);
    end;
  finally
    search.free;
  end;
end;

procedure TCESearchWidget.actFindNextExecute(sender: TObject);
begin
  if fDoc.isNil then exit;
  //
  fSearchMru.Insert(0,fToFind);
  cbToFind.Items.Assign(fSearchMru);
  //
  if not chkFromCur.Checked then
  begin
    if chkBack.Checked then
      fDoc.CaretXY := Point(high(Integer), high(Integer))
    else
    begin
      if not fHasRestarted then
        fDoc.CaretXY := Point(0,0);
      fHasRestarted := true;
    end;
  end
  else if fHasSearched then
  begin
    if chkBack.Checked then
      fDoc.CaretX := fDoc.CaretX - 1
    else
      fDoc.CaretX := fDoc.CaretX + length(fToFind);
  end;
  if fDoc.SearchReplace(fToFind, '', getOptions) = 0 then
    dlgOkInfo('the expression cannot be found')
  else
  begin
    fHasSearched := true;
    fHasRestarted := false;
    chkFromCur.Checked := true;
  end;
  updateImperative;
end;

procedure TCESearchWidget.actReplaceNextExecute(sender: TObject);
begin
  if fDoc.isNil then exit;
  //
  fSearchMru.Insert(0, fToFind);
  fReplaceMru.Insert(0, fReplaceWth);
  cbToFind.Items.Assign(fSearchMru);
  cbReplaceWth.Items.Assign(fReplaceMru);
  //
  if chkPrompt.Checked then
    fDoc.OnReplaceText := @replaceEvent;
  if not chkFromCur.Checked then
  begin
    if chkBack.Checked then
      fDoc.CaretXY := Point(high(Integer), high(Integer))
    else
      fDoc.CaretXY := Point(0,0);
  end
  else if fHasSearched then
  begin
    if chkBack.Checked then
      fDoc.CaretX := fDoc.CaretX - 1
    else
      fDoc.CaretX := fDoc.CaretX + length(fToFind);
  end;
  if fDoc.SearchReplace(fToFind, fReplaceWth, getOptions + [ssoReplace]) <> 0 then
    fHasSearched := true;
  fDoc.OnReplaceText := nil;
  updateImperative;
end;

procedure TCESearchWidget.actReplaceAllExecute(sender: TObject);
var
  opts: TSynSearchOptions;
begin
  if fDoc.isNil then exit;
  cbReplaceWth.Items.Assign(fReplaceMru);
  opts := getOptions + [ssoReplace];
  opts -= [ssoBackwards];
  //
  fSearchMru.Insert(0, fToFind);
  fReplaceMru.Insert(0, fReplaceWth);
  if chkPrompt.Checked then fDoc.OnReplaceText := @replaceEvent;
  fDoc.CaretXY := Point(0,0);
  while(true) do
  begin
    if fDoc.SearchReplace(fToFind, fReplaceWth, opts) = 0
      then break;
    if fCancelAll then
    begin
      fCancelAll := false;
      break;
    end;
  end;
  fDoc.OnReplaceText := nil;
  updateImperative;
end;
{$ENDREGION}

{$REGION ICEMultiDocObserver ---------------------------------------------------}
procedure TCESearchWidget.docNew(aDoc: TCESynMemo);
begin
  fDoc := aDoc;
  updateImperative;
end;

procedure TCESearchWidget.docClosing(aDoc: TCESynMemo);
begin
  if fDoc = aDoc then fDoc := nil;
  updateImperative;
end;

procedure TCESearchWidget.docFocused(aDoc: TCESynMemo);
begin
  if fDoc = aDoc then exit;
  fDoc := aDoc;
  updateImperative;
end;

procedure TCESearchWidget.docChanged(aDoc: TCESynMemo);
begin
end;
{$ENDREGION}

{$REGION Misc. -----------------------------------------------------------------}
procedure TCESearchWidget.cbToFindChange(Sender: TObject);
begin
  if Updating then exit;
  fToFind := cbToFind.Text;
  fHasSearched := false;
  updateImperative;
end;

procedure TCESearchWidget.chkEnableRepChange(Sender: TObject);
begin
  if Updating then exit;
  updateImperative;
end;

procedure TCESearchWidget.cbReplaceWthChange(Sender: TObject);
begin
  if Updating then exit;
  fReplaceWth := cbReplaceWth.Text;
  fHasSearched := false;
  updateImperative;
end;

procedure TCESearchWidget.updateImperative;
begin
  btnFind.Enabled := fDoc.isNotNil and fToFind.isNotEmpty;
  btnFindAll.Enabled := fDoc.isNotNil and fToFind.isNotEmpty;
  btnReplace.Enabled := fDoc.isNotNil and chkEnableRep.Checked and fToFind.isNotEmpty;
  btnReplaceAll.Enabled := btnReplace.Enabled;
  cbReplaceWth.Enabled := fDoc.isNotNil and chkEnableRep.Checked;
  cbToFind.Enabled := fDoc.isNotNil;
end;
{$ENDREGION}

end.