unit ce_search; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, Menus, StdCtrls, actnList, Buttons, SynEdit, SynEditSearch, SynEditTypes, ce_common, ce_widget, ce_synmemo; type { TCESearchWidget } TCESearchWidget = class(TCEWidget) btnFind: TBitBtn; btnReplace: TBitBtn; btnReplaceAll: TBitBtn; cbToFind: TComboBox; cbReplaceWth: TComboBox; chkEnableRep: TCheckBox; chkPrompt: 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 fEditor: TCESynMemo; fToFind: string; fReplaceWth: string; fActFindNext, fActReplaceNext: TAction; fActReplaceAll: TAction; fSearchMru, fReplaceMru: TMruList; fCancelAll: boolean; function getOptions: TSynSearchOptions; procedure actFindNextExecute(sender: TObject); procedure actReplaceAllExecute(sender: TObject); procedure actReplaceNextExecute(sender: TObject); procedure replaceEvent(Sender: TObject; const ASearch, AReplace: string; Line, Column: integer; var ReplaceAction: TSynReplaceAction); protected procedure UpdateByEvent; override; public constructor Create(aOwner: TComponent); override; destructor Destroy; override; // procedure docFocused(const aDoc: TCESynMemo); override; procedure docClose(const aDoc: TCESynMemo); override; // function contextName: string; override; function contextActionCount: integer; override; function contextAction(index: integer): TAction; override; end; implementation {$R *.lfm} constructor TCESearchWidget.Create(aOwner: TComponent); begin fActFindNext := TAction.Create(self); fActFindNext.Caption := 'Find'; fActFindNext.OnExecute := @actFindNextExecute; fActReplaceNext := TAction.Create(self); fActReplaceNext.Caption := 'Replace'; fActReplaceNext.OnExecute := @actReplaceNextExecute; fActReplaceAll := TAction.Create(self); fActReplaceAll.Caption := 'Replace all'; fActReplaceAll.OnExecute := @actReplaceAllExecute; inherited; fID := 'ID_FIND'; // btnFind.Action := fActFindNext; btnReplace.Action := fActReplaceNext; btnReplaceAll.Action := fActReplaceAll; // fSearchMru := TMruList.Create; fReplaceMru:= TMruList.Create; end; destructor TCESearchWidget.Destroy; begin fSearchMru.Free; fReplaceMru.Free; inherited; end; procedure TCESearchWidget.docFocused(const aDoc: TCESynMemo); begin fEditor := aDoc; UpdateByEvent; end; procedure TCESearchWidget.docClose(const aDoc: TCESynMemo); begin if fEditor = aDoc then fEditor := nil; UpdateByEvent; end; function TCESearchWidget.contextName: string; begin exit('Seach'); end; function TCESearchWidget.contextActionCount: integer; begin exit(3); end; function TCESearchWidget.contextAction(index: integer): TAction; begin case index of 0: exit(fActFindNext); 1: exit(fActReplaceNext); 2: exit(fActReplaceAll); else exit(nil); end; end; procedure TCESearchWidget.cbToFindChange(Sender: TObject); begin if Updating then exit; fToFind := cbToFind.Text; end; procedure TCESearchWidget.chkEnableRepChange(Sender: TObject); begin if Updating then exit; UpdateByEvent; end; procedure TCESearchWidget.cbReplaceWthChange(Sender: TObject); begin if Updating then exit; fReplaceWth := cbReplaceWth.Text; end; function TCESearchWidget.getOptions: TSynSearchOptions; begin 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; procedure TCESearchWidget.actFindNextExecute(sender: TObject); begin if fEditor = nil then exit; // fSearchMru.Insert(0,fToFind); if not chkFromCur.Checked then if chkBack.Checked then fEditor.CaretXY := Point(high(Integer), high(Integer)) else fEditor.CaretXY := Point(0,0); if fEditor.SearchReplace(fToFind, '', getOptions) = 0 then dlgOkInfo('the expression cannot be found'); UpdateByEvent; end; procedure TCESearchWidget.actReplaceNextExecute(sender: TObject); begin if fEditor = nil then exit; // fSearchMru.Insert(0, fToFind); fReplaceMru.Insert(0, fReplaceWth); if chkPrompt.Checked then fEditor.OnReplaceText := @replaceEvent; if not chkFromCur.Checked then if chkBack.Checked then fEditor.CaretXY := Point(high(Integer), high(Integer)) else fEditor.CaretXY := Point(0,0); fEditor.SearchReplace(fToFind, fReplaceWth, getOptions + [ssoReplace]); fEditor.OnReplaceText := nil; UpdateByEvent; end; procedure TCESearchWidget.actReplaceAllExecute(sender: TObject); var opts: TSynSearchOptions; begin if fEditor = nil then exit; opts := getOptions + [ssoReplace]; opts -= [ssoBackwards]; // fSearchMru.Insert(0, fToFind); fReplaceMru.Insert(0, fReplaceWth); if chkPrompt.Checked then fEditor.OnReplaceText := @replaceEvent; fEditor.CaretXY := Point(0,0); while(true) do begin if fEditor.SearchReplace(fToFind, fReplaceWth, opts) = 0 then break; if fCancelAll then begin fCancelAll := false; break; end; end; fEditor.OnReplaceText := nil; UpdateByEvent; 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.UpdateByEvent; begin fActFindNext.Enabled := fEditor <> nil; fActReplaceNext.Enabled := (fEditor <> nil) and (chkEnableRep.Checked); fActReplaceAll.Enabled := (fEditor <> nil) and (chkEnableRep.Checked); cbReplaceWth.Enabled := (fEditor <> nil) and (chkEnableRep.Checked); cbToFind.Enabled := fEditor <> nil; // cbToFind.Items.Assign(fSearchMru); cbReplaceWth.Items.Assign(fReplaceMru); end; end.