lazarus/ide/searchfrm.pas

1105 lines
35 KiB
ObjectPascal

{
/***************************************************************************
SearchFrm.pas
-------------------
***************************************************************************/
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
* *
***************************************************************************
}
unit SearchFrm;
{$mode objfpc}{$H+}
interface
uses
// RTL + FCL
Classes, SysUtils, types, RegExpr,
// LCL
LCLIntf, Forms, Controls, ComCtrls, Dialogs, ExtCtrls, StdCtrls, Buttons,
// CodeTools
SourceLog, BasicCodeTools, FileProcs,
// LazUtils
FileUtil, LazFileUtils, LazFileCache, LazTracer, LazUTF8,
// IDEIntf
IdeIntfStrConsts, IDEWindowIntf, LazIDEIntf, SrcEditorIntf, IDEDialogs,
ProjectGroupIntf, ProjectIntf, InputHistory,
// IdeUtils
IdeUtilsPkgStrConsts,
// IdeConfig
SearchPathProcs,
// IDE
LazarusIDEStrConsts, SearchResultView, Project;
type
{ TSearchProgressForm }
TSearchProgressForm = class(TForm)
btnCancel: TBitBtn;
MatchesLabel: TLABEL;
SearchingLabel: TLABEL;
SearchTextLabel: TLABEL;
lblMatches: TLABEL;
lblProgress: TLABEL;
lblSearchText: TLABEL;
Panel2: TPANEL;
procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
procedure FormShow(Sender: TObject);
procedure SearchFormCREATE(Sender: TObject);
procedure SearchFormDESTROY(Sender: TObject);
procedure btnAbortCLICK(Sender: TObject);
private
fFlags: TSrcEditSearchOptions;
fAbortString: string;
fMask: string;
fMatches: longint;
fPad: string;
FProgress: TIDESearchInTextProgress;
fPromptOnReplace: boolean;
fRecursive: boolean;
FReplaceText: string;
fResultsListUpdating: boolean;
fResultsList: TStrings;
fResultsWindow: TTabSheet;
fSearchFileList: TStringList;
fSearchFiles: boolean;
fSearchFor: String;
fDirectories: string;
fSearchOpen: boolean;
fSearchActive: boolean;
fSearchProject: boolean;
fSearchProjectGroup: boolean;
fResultsPageIndex: integer;
fLastUpdateProgress: DWORD;
fWasActive: boolean;
procedure AddMatchHandler(const Filename: string; const StartPos, EndPos: TPoint;
const Lines: string);
procedure DoFindInFiles(ADirectories: string);
procedure DoFindInSearchList;
procedure SetResultsList(const AValue: TStrings);
procedure UpdateMatches;
procedure UpdateProgress(FileName: string);
function PadAndShorten(FileName: string): string;
procedure SetOptions(TheOptions: TLazFindInFileSearchOptions);
function GetOptions: TLazFindInFileSearchOptions;
procedure SearchFile(const aFilename: string);
procedure SetFlag(Flag: TSrcEditSearchOption; AValue: boolean);
procedure DoSearchAndAddToSearchResults;
function DoSearch: integer;
procedure SearchEvent(FileIterator: TFileIterator);
public
procedure DoSearchOpenFiles;
procedure DoSearchActiveFile;
procedure DoSearchDirs;
procedure DoSearchProject(AProject: TProject);
procedure DoSearchProjectGroup;
public
property SearchDirectories: string read fDirectories write fDirectories;
property SearchText: string read fSearchFor write fSearchFor;
property ReplaceText: string read FReplaceText write FReplaceText;
property SearchOptions: TLazFindInFileSearchOptions read GetOptions
write SetOptions;
property SearchFileList: TStringList read fSearchFileList
write fSearchFileList;
property ResultsList: TStrings read fResultsList write SetResultsList;
property ResultsPageIndex: integer read fResultsPageIndex write fResultsPageIndex;
property SearchMask: string read fMask write fMask;
property Pad: string read fPad write fPad;
property PromptOnReplace: boolean read fPromptOnReplace write fPromptOnReplace;// this is asked once and can be changed when prompting
property Progress: TIDESearchInTextProgress read FProgress;
end;
function SearchInText(const TheFileName: string;
var TheText: string;// if TheFileName='' then use TheText
SearchFor, ReplaceText: string;
Flags: TSrcEditSearchOptions; var Prompt: boolean;
Progress: TIDESearchInTextProgress = nil
): TModalResult;
function TrimLinesAndAdjustPos(const Lines: string; var APosition: integer): string;
function SearchInLine(const SearchStr: string; SrcLog: TSourceLog;
LineNumber: integer; WholeWords: boolean; StartInLine: integer;
out MatchStartInLine: integer): boolean;
implementation
{$R *.lfm}
const
WordBreakChars = [#0..#31,'.', ',', ';', ':', '"', '''', '!', '?', '[', ']',
'(', ')', '{', '}', '^', '-', '=', '+', '*', '/', '\', '|', ' '];
WhiteSpaceChars = [' ',#10,#13,#9];
function SearchInLine(const SearchStr: string; SrcLog: TSourceLog;
LineNumber: integer; WholeWords: boolean; StartInLine: integer;
out MatchStartInLine: integer): boolean;
// search SearchStr in SrcLog line
// returns MatchStartInLine=1 for start of line
var
LineRange: TLineRange;
Src: String;
StartPos: PChar;
EndPos: PChar;
i: Integer;
SearchLen: Integer;
LineStartPos: PChar;
FirstChar: Char;
Found: Boolean;
CharInFront: PChar;
CharBehind: PChar;
begin
Result:=false;
if SearchStr='' then exit;
SrcLog.GetLineRange(LineNumber-1,LineRange);
Src:=SrcLog.Source;
SearchLen:=length(SearchStr);
LineStartPos:=@Src[LineRange.StartPos];
StartPos:=LineStartPos+StartInLine-1;
EndPos:=@Src[LineRange.EndPos-SearchLen+1];
FirstChar:=SearchStr[1];
while (StartPos<EndPos) do begin
if FirstChar=StartPos^ then begin
i:=1;
while (i<=SearchLen) and (StartPos[i-1]=SearchStr[i]) do
inc(i);
if i>SearchLen then begin
Found:=true;
MatchStartInLine:=StartPos-LineStartPos+1;
if WholeWords then begin
CharInFront:=StartPos-1;
CharBehind:=StartPos+SearchLen;
if ((MatchStartInLine=1)
or (CharInFront^ in WordBreakChars))
and ((StartPos+SearchLen=@Src[LineRange.EndPos])
or (CharBehind^ in WordBreakChars))
then begin
// word start and word end
end else begin
// not whole word
Found:=false;
end;
end;
if Found then begin
Result:=true;
exit;
end;
end;
end;
inc(StartPos);
end;
end;
function TrimLinesAndAdjustPos(const Lines: string;
var APosition: integer): string;
var
StartPos: Integer;
EndPos: Integer;
begin
if Lines='' then begin
Result:='';
exit;
end;
if LineEndCount(Lines)=0 then begin
StartPos:=1;
while (StartPos<=length(Lines)) and (Lines[StartPos] in WhiteSpaceChars) do
inc(StartPos);
if (APosition>0) and (StartPos>APosition) then
StartPos:=APosition;
EndPos:=length(Lines)+1;
while (EndPos>=StartPos) and (Lines[EndPos-1] in WhiteSpaceChars) do
dec(EndPos);
dec(APosition,StartPos-1);
Result:=copy(Lines,StartPos,EndPos-StartPos);
end else
Result:=Lines;
end;
function SearchInText(const TheFileName: string;
var TheText: string;// if TheFileName='' then use TheText
SearchFor, ReplaceText: string;
Flags: TSrcEditSearchOptions; var Prompt: boolean;
Progress: TIDESearchInTextProgress = nil
): TModalResult;
var
OriginalFile: TSourceLog;// The original File being searched
CaseFile: TSourceLog; // The working File being searched
FoundStartPos: TPoint; // Position of match in line. 1 based.
FoundEndPos: TPoint;
ReplaceLineOffset: integer;// number of lines added/deleted by replacement.
LastReplaceLine: integer; // last changed line by replace. 1 based
LastReplaceColOffset: integer;// bytes added/deleted by replace in last line
TempSearch: string; // Temp Storage for the search string.
RE: TRegExpr;
Lines: String;
SrcEditValid: Boolean;// true if SrcEdit is valid
SrcEdit: TSourceEditorInterface;
PaintLockEnabled: Boolean;
ReplacedText: PChar;
ReplacedTextCapacity: integer;
ReplacedTextLength: integer;
ReplacedTextOriginalPos: integer;// 1-based. e.g. 2 bytes has been replaced => ReplacedTextOriginalPos=3.
procedure DoAbort;
begin
if Progress<>nil then
Progress.Abort:=true;
Result:=mrAbort;
end;
procedure ProcessMessages;
begin
if Application<>nil then Application.ProcessMessages;
if (Progress<>nil) and Progress.Abort then
Result:=mrAbort;
end;
function FileIsOpenInSourceEditor: boolean;
begin
if not SrcEditValid then begin
if (TheFileName<>'') and (SourceEditorManagerIntf<>nil) then
SrcEdit:=SourceEditorManagerIntf.SourceEditorIntfWithFilename(TheFileName)
else
SrcEdit:=nil;
SrcEditValid:=true;
end;
Result:=SrcEdit<>nil;
end;
procedure GrowNewText(NewLength: integer);
var
NewCapacity: Integer;
begin
if NewLength<=ReplacedTextCapacity then exit;
// grow
// first double
NewCapacity:=ReplacedTextCapacity*2;
if NewLength>NewCapacity then begin
// double is not enough, use the original size as minimum
if NewCapacity<1 then
NewCapacity:=OriginalFile.SourceLength+1000;
if NewLength>NewCapacity then begin
// still not enough -> grow to new length
NewCapacity:=NewLength;
end;
end;
ReplacedTextCapacity:=NewCapacity;
ReAllocMem(ReplacedText,ReplacedTextCapacity);
end;
procedure EnablePaintLock;
begin
if (not PaintLockEnabled) and FileIsOpenInSourceEditor then begin
PaintLockEnabled:=true;
SrcEdit.BeginUpdate;
end;
end;
procedure DisablePaintLock;
begin
if PaintLockEnabled then
SrcEdit.EndUpdate;
PaintLockEnabled:=false;
end;
procedure EndLocks;
begin
DisablePaintLock;
SrcEditValid:=false;
end;
procedure DoReplaceLine;
var
AReplace: String;
Action: TSrcEditReplaceAction;
OriginalTextPos: integer; // 1-based
GapLength: Integer;
NewLength: Integer;
SrcEditPosValid: boolean;
SrcEditStartPos, SrcEditEndPos: TPoint;
aLastLineLength: integer;
aLineCount: integer;
i: integer;
procedure GetSrcEditPos;
begin
if not SrcEditPosValid then begin
SrcEditStartPos:=FoundStartPos;
SrcEditEndPos:=FoundEndPos;
// FoundStart/EndPos contain the original position
// add the changes due to replacement to SrcEditStart/EndPos
if SrcEditStartPos.Y=LastReplaceLine then
inc(SrcEditStartPos.X,LastReplaceColOffset);
if SrcEditStartPos.Y>=LastReplaceLine then
inc(SrcEditStartPos.Y,ReplaceLineOffset);
if SrcEditEndPos.Y=LastReplaceLine then
inc(SrcEditEndPos.X,LastReplaceColOffset);
if SrcEditEndPos.Y>=LastReplaceLine then
inc(SrcEditEndPos.Y,ReplaceLineOffset);
SrcEditPosValid:=true;
end;
end;
begin
// create replacement
AReplace:=ReplaceText;
if sesoRegExpr in Flags then
AReplace:=RE.Substitute(AReplace);
//DebugLn(['DoReplaceLine Replace with "',AReplace,'"']);
SrcEditPosValid:=false;
// ask the user
if Prompt and (TheFileName<>'') then begin
// open the place in the source editor
EndLocks;
// update windows
ProcessMessages;
if Result=mrAbort then exit;
GetSrcEditPos;
if LazarusIDE.DoOpenFileAndJumpToPos(TheFileName,SrcEditStartPos,
-1,-1,-1,[ofUseCache,ofDoNotLoadResource,ofVirtualFile,ofRegularFile])
<>mrOk then
begin
DoAbort;
exit;
end;
// select found text
if not FileIsOpenInSourceEditor then
RaiseGDBException('inconsistency');
SrcEdit.SelectText(SrcEditStartPos.Y,SrcEditStartPos.X,
SrcEditEndPos.Y,SrcEditEndPos.X);
SrcEdit.AskReplace(nil,SrcEdit.Selection,AReplace,
SrcEditStartPos.Y,SrcEditStartPos.X,Action);
case Action of
seraSkip: exit;
seraReplace: ;
seraReplaceAll: Prompt:=false;
else
DoAbort;
exit;
end;
end;
if FileIsOpenInSourceEditor then begin
// change text in source editor
EnablePaintLock;
GetSrcEditPos;
SrcEdit.SelectText(SrcEditStartPos.Y,SrcEditStartPos.X,
SrcEditEndPos.Y,SrcEditEndPos.X);
SrcEdit.Selection:=AReplace;
// count total replacements and adjust offsets
aLineCount:=LineEndCount(AReplace,aLastLineLength);
//debugln(['DoReplaceLine Replace="',dbgstr(AReplace),'" aLineCount=',aLineCount,' aLastLineLength=',aLastLineLength]);
if aLineCount>0 then begin
// replaced with multiple lines
LastReplaceColOffset:=aLastLineLength+1-FoundEndPos.X;
end else begin
if FoundStartPos.Y<>LastReplaceLine then
LastReplaceColOffset:=0;
// replaced with some words
if FoundStartPos.Y=FoundEndPos.Y then begin
// replaced some words with some words
inc(LastReplaceColOffset,
aLastLineLength-(FoundEndPos.X-FoundStartPos.X));
end else begin
// replaced several lines with some words
inc(LastReplaceColOffset,FoundStartPos.X+aLastLineLength-FoundEndPos.X);
end;
end;
LastReplaceLine:=FoundEndPos.Y;
Lines := '';
for i := SrcEditStartPos.Y to SrcEditStartPos.Y + aLineCount do
Lines := Lines + SrcEdit.Lines[i-1] + LineEnding;
Lines:=ChompOneLineEndAtEnd(Lines);
if (Progress<>nil)
and (Progress.OnAddMatch<>nil) then begin
Progress.OnAddMatch(TheFileName,
Point(FoundStartPos.x, FoundStartPos.y + ReplaceLineOffset),
SrcEdit.CursorTextXY,Lines);
end;
inc(ReplaceLineOffset,aLineCount-(FoundEndPos.Y-FoundStartPos.Y));
//DebugLn(['DoReplaceLine FoundStartPos=',dbgs(FoundStartPos),' FoundEndPos=',dbgs(FoundEndPos),' aLastLineLength=',aLastLineLength,' LastReplaceLine=',LastReplaceLine,' LastReplaceColOffset=',LastReplaceColOffset,' ReplaceLineOffset=',ReplaceLineOffset]);
end else begin
// change text in memory/disk
OriginalFile.LineColToPosition(FoundStartPos.Y,FoundStartPos.X,
OriginalTextPos);
GapLength:=OriginalTextPos-ReplacedTextOriginalPos;
NewLength:=ReplacedTextLength+GapLength+length(AReplace);
GrowNewText(NewLength);
// copy the text between the last replacement and this replacement
if GapLength>0 then begin
System.Move(OriginalFile.Source[ReplacedTextOriginalPos],
ReplacedText[ReplacedTextLength],GapLength);
inc(ReplacedTextLength,GapLength);
end;
// copy the replacement
if AReplace<>'' then begin
System.Move(AReplace[1],ReplacedText[ReplacedTextLength],length(AReplace));
inc(ReplacedTextLength,length(AReplace));
end;
// save original position behind found position
OriginalFile.LineColToPosition(FoundEndPos.Y,FoundEndPos.X,
ReplacedTextOriginalPos);
Lines:=copy(OriginalFile.GetLines(FoundStartPos.Y,FoundStartPos.Y), 1, FoundStartPos.X - 1) +
AReplace +
copy(OriginalFile.GetLines(FoundEndPos.Y,FoundEndPos.Y), FoundEndPos.x, MaxInt);
Lines:=ChompOneLineEndAtEnd(Lines);
aLineCount:=LineEndCount(AReplace,aLastLineLength);
if aLineCount = 0 then aLastLineLength := aLastLineLength + FoundStartPos.X;
if (Progress<>nil)
and (Progress.OnAddMatch<>nil) then begin
Progress.OnAddMatch(TheFileName,
Point(FoundStartPos.x, FoundStartPos.y + ReplaceLineOffset),
Point(aLastLineLength, FoundStartPos.Y + aLineCount + ReplaceLineOffset),
Lines);
end;
inc(ReplaceLineOffset,aLineCount-(FoundEndPos.Y-FoundStartPos.Y));
end;
end;
procedure CommitChanges;
var
GapLength: Integer;
NewLength: Integer;
NewText: string;
CurResult: TModalResult;
begin
EndLocks;
if (ReplacedText<>nil) then begin
if SearchInText<>mrAbort then begin
GapLength:=OriginalFile.SourceLength+1-ReplacedTextOriginalPos;
NewLength:=ReplacedTextLength+GapLength;
GrowNewText(NewLength);
// copy the text between the last and this replacement
if GapLength>0 then begin
System.Move(OriginalFile.Source[ReplacedTextOriginalPos],
ReplacedText[ReplacedTextLength],GapLength);
inc(ReplacedTextLength,GapLength);
end;
SetLength(NewText{%H-},ReplacedTextLength);
if NewText<>'' then
System.Move(ReplacedText[0],NewText[1],length(NewText));
if (TheFileName<>'') then begin
OriginalFile.Source:=NewText;
if (not OriginalFile.SaveToFile(TheFileName)) then begin
CurResult:=MessageDlg(lisCodeToolsDefsWriteError,
Format(lisErrorWritingFile, [TheFileName]),
mtError,[mbCancel,mbAbort],0);
if CurResult=mrAbort then DoAbort;
end;
end else begin
TheText:=NewText;
end;
end;
FreeMem(ReplacedText);
end;
end;
var
Found: Boolean;
Src: String;
NewMatchStartPos: PtrInt;
NewMatchEndPos: PtrInt;
lCaseMismatchCheckCompleted: Boolean;
p1, p2: PChar;
i, l, n1, n2: Integer;
begin
//debugln(['SearchInText TheFileName=',TheFileName,' SearchFor=',SearchFor,'" ReplaceText=',ReplaceText,'"']);
if (Progress<>nil) and Progress.Abort then exit(mrAbort);
Result:=mrOk;
OriginalFile:=nil;
CaseFile:=nil;
RE:=nil;
SrcEdit:=nil;
SrcEditValid:=false;
PaintLockEnabled:=false;
ReplacedText:=nil;
ReplacedTextCapacity:=0;
ReplacedTextLength:=0;
ReplacedTextOriginalPos:=1;
ReplaceLineOffset:=0;
LastReplaceLine:=0;
LastReplaceColOffset:=0;
try
FoundEndPos:= Point(0,0);
TempSearch:= SearchFor;
// load text (to save memory, do not use codetools cache system)
if FileIsOpenInSourceEditor then begin
OriginalFile:=TSourceLog.Create(SrcEdit.GetText(false));
end else if TheFileName<>'' then begin
OriginalFile:=TSourceLog.Create('');
OriginalFile.LoadFromFile(TheFileName);
end else begin
OriginalFile:=TSourceLog.Create(TheText);
end;
if OriginalFile.Source='' then exit;
CaseFile:=nil;
lCaseMismatchCheckCompleted := false;
if sesoRegExpr in Flags then begin
// Setup the regular expression search engine
RE:=TRegExpr.Create;
RE.ModifierI:=not (sesoMatchCase in Flags);
RE.ModifierM:=true;
RE.ModifierS:=sesoMultiLine in Flags;
Src:=OriginalFile.Source;
if sesoWholeWord in Flags then
RE.Expression:='\b'+SearchFor+'\b'
else
RE.Expression:=SearchFor;
end else begin
// convert case if necessary
if not (sesoMatchCase in Flags) then begin
CaseFile:=TSourceLog.Create(UTF8UpperCase(OriginalFile.Source));
TempSearch:=UTF8UpperCase(TempSearch);
Src:=CaseFile.Source;
end else
Src:=OriginalFile.Source;
end;
//debugln(['TheFileName=',TheFileName,' len=',OriginalFile.SourceLength,' Cnt=',OriginalFile.LineCount,' TempSearch=',TempSearch]);
NewMatchEndPos:=1;
repeat
Found:=false;
if sesoRegExpr in Flags then begin
// search the text for regular expression
RE.InputString:=Src;
if RE.ExecPos(NewMatchEndPos) then begin
Found:=true;
NewMatchStartPos:=RE.MatchPos[0];
NewMatchEndPos:=NewMatchStartPos+RE.MatchLen[0];
end;
end else begin
// search for normal text
if SearchNextInText(PChar(TempSearch),length(TempSearch),
PChar(Src),length(Src),
NewMatchEndPos-1,NewMatchStartPos,NewMatchEndPos,
sesoWholeWord in Flags,sesoMultiLine in Flags)
then begin
Found:=true;
inc(NewMatchStartPos);
inc(NewMatchEndPos);
end;
end;
if Found then begin
// found => convert position, report and/or replace
OriginalFile.AbsoluteToLineCol(NewMatchStartPos,
FoundStartPos.Y,FoundStartPos.X);
OriginalFile.AbsoluteToLineCol(NewMatchEndPos,
FoundEndPos.Y,FoundEndPos.X);
//DebugLn(['SearchInText NewMatchStartPos=',NewMatchStartPos,' NewMatchEndPos=',NewMatchEndPos,' FoundStartPos=',dbgs(FoundStartPos),' FoundEndPos=',dbgs(FoundEndPos),' Found="',dbgstr(copy(Src,NewMatchStartPos,NewMatchEndPos-NewMatchStartPos)),'" Replace=',sesoReplace in Flags]);
if sesoReplace in Flags then begin
// Comparing character lengths after UTF8UpperCase:
// their difference can lead to damage to the text when replacing.
// Issue #40893
if not lCaseMismatchCheckCompleted then
begin
lCaseMismatchCheckCompleted := true;
// length of strings in bytes (don't use UTF8Length)
n1 := length(OriginalFile.Source);
n2 := length(CaseFile.Source);
// length check has been done above
p1 := @OriginalFile.Source[1];
p2 := @CaseFile.Source[1];
l := n1; // assumed n1=n2
i := 1;
while (n1 = n2) and (i <= l) do
begin
// length of characters in bytes
n1 := UTF8CodepointSizeFast(p1);
n2 := UTF8CodepointSizeFast(p2);
// assumed n1=n2
inc(p1, n1);
inc(p2, n1);
inc(i, n1);
end;
if n1 <> n2 then
begin
if IDEMessageDialog(lisCCOWarningCaption,
lisFindFileReplacementIsNotPossible + LineEnding + LineEnding + TheFileName,
mtWarning, [mbOK, mbCancel]) = mrCancel
then
DoAbort;
exit(mrAbort);
end;
end;
DoReplaceLine;
end else begin
if (Progress<>nil)
and (Progress.OnAddMatch<>nil) then begin
Lines:=OriginalFile.GetLines(FoundStartPos.Y,FoundEndPos.Y);
Lines:=ChompOneLineEndAtEnd(Lines);
if (Progress<>nil)
and (Progress.OnAddMatch<>nil) then begin
Progress.OnAddMatch(TheFileName,FoundStartPos,FoundEndPos,Lines);
end;
end;
end;
end else begin
// not found
break;
end;
// check abort
if (Result=mrAbort) then begin
exit;
end;
until false;
finally
CommitChanges;
if OriginalFile=CaseFile then
CaseFile:=nil;
FreeAndNil(OriginalFile);
FreeAndNil(CaseFile);
FreeAndNil(RE);
end;
end;//SearchFile
{ TSearchProgressForm }
procedure TSearchProgressForm.btnAbortCLICK(Sender: TObject);
begin
Progress.Abort:= true;
end;
procedure TSearchProgressForm.SearchFormCREATE(Sender: TObject);
Function MaxWidth(const Labs : array of TLabel) : integer;
var i,w : integer;
begin
Result:=0;
for i:=low(Labs) to high(Labs) do
begin
w:=Canvas.TextWidth(Labs[i].Caption);
if Result<w then
Result:=w;
end;
end;
var NewX : integer;
begin
//Set Defaults
MatchesLabel.Caption:=lissMatches;
SearchingLabel.Caption:=lissSearching;
SearchTextLabel.Caption:=lissSearchText;
NewX:=MatchesLabel.Left+MaxWidth([MatchesLabel,SearchingLabel,SearchTextLabel])+10;
lblMatches.Left:=NewX;
lblProgress.Left:=NewX;
lblSearchText.Left:=NewX;
Caption:=dlgSearchCaption;
btnCancel.Caption:=lisCancel;
fProgress:=TIDESearchInTextProgress.Create;
FProgress.OnAddMatch:=@AddMatchHandler;
fFlags:=[];
fPromptOnReplace:=true;
fRecursive:= True;
Progress.Abort:= false;
fAbortString:= dlgSearchAbort;
fPad:= '...';
fSearchProject:= false;
fSearchProjectGroup:= false;
fSearchOpen:= false;
fSearchFiles:= false;
fResultsPageIndex:=-1;
fWasActive:= false;
end;
procedure TSearchProgressForm.AddMatchHandler(const Filename: string; const StartPos,
EndPos: TPoint; const Lines: string);
var
MatchLen: Integer;
TrimmedMatch: LongInt;
TrimmedLines: String;
LastLineLen: integer;
begin
LineEndCount(Lines,LastLineLen);
MatchLen:=length(Lines)-(LastLineLen+1-EndPos.X)-StartPos.X+1;
if MatchLen<1 then MatchLen:=1;
//DebugLn(['TSearchForm.OnAddMatch length(Lines)=',length(Lines),' LastLineLen=',LastLineLen,' MatchLen=',MatchLen]);
TrimmedMatch:=StartPos.X;
TrimmedLines:=TrimLinesAndAdjustPos(Lines,TrimmedMatch);
//DebugLn(['TSearchForm.OnAddMatch StartPos=',dbgs(StartPos),' EndPos=',dbgs(EndPos),' Lines="',Lines,'" Trimmed="',TrimmedLines,'" TrimmedMatch=',TrimmedMatch]);
SearchResultsView.AddMatch(fResultsWindow.PageIndex,FileName,StartPos,EndPos,
TrimmedLines, TrimmedMatch, MatchLen);
UpdateMatches;
end;
procedure TSearchProgressForm.FormClose(Sender: TObject; var CloseAction:
TCloseAction);
begin
fWasActive:= Active;
end;
procedure TSearchProgressForm.FormShow(Sender: TObject);
begin
fWasActive:= true;
end;
procedure TSearchProgressForm.SearchFormDESTROY(Sender: TObject);
begin
FreeAndNil(fProgress);
end;
procedure TSearchProgressForm.SetOptions(TheOptions: TLazFindInFileSearchOptions);
begin
SetFlag(sesoWholeWord,fifWholeWord in TheOptions);
SetFlag(sesoReplace,fifReplace in TheOptions);
SetFlag(sesoReplaceAll,fifReplaceAll in TheOptions);
SetFlag(sesoMatchCase,fifMatchCase in TheOptions);
SetFlag(sesoRegExpr,fifRegExpr in TheOptions);
SetFlag(sesoMultiLine,fifMultiLine in TheOptions);
fRecursive:= (fifIncludeSubDirs in TheOptions);
fSearchProject:= (fifSearchProject in TheOptions);
fSearchProjectGroup:= (fifSearchProjectGroup in TheOptions);
fSearchOpen:= (fifSearchOpen in TheOptions);
fSearchActive:= (fifSearchActive in TheOptions);
fSearchFiles:= (fifSearchDirectories in TheOptions);
end;//SetOptions
function TSearchProgressForm.GetOptions: TLazFindInFileSearchOptions;
begin
Result:=[];
if sesoWholeWord in fFlags then include(Result,fifWholeWord);
if sesoMatchCase in fFlags then include(Result,fifMatchCase);
if sesoReplace in fFlags then include(Result,fifReplace);
if sesoReplaceAll in fFlags then include(Result,fifReplaceAll);
if sesoRegExpr in fFlags then include(Result,fifRegExpr);
if sesoMultiLine in fFlags then include(Result,fifMultiLine);
if fRecursive then include(Result,fifIncludeSubDirs);
if fSearchProject then include(Result, fifSearchProject);
if fSearchProjectGroup then include(Result, fifSearchProjectGroup);
if fSearchOpen then include(Result,fifSearchOpen);
if fSearchActive then include(Result,fifSearchActive);
if fSearchFiles then include(Result,fifSearchDirectories);
end;//GetOptions
function TSearchProgressForm.DoSearch: integer;
// Search in all files and then return the number of found items.
begin
Result:= 0;
PromptOnReplace:=true;
Progress.Abort:=false;
lblSearchText.Caption:= fSearchFor;
fMatches:= 0;
if Assigned(fResultsList) then
begin
if not fResultsListUpdating then begin
fResultsList.BeginUpdate;
fResultsListUpdating:=true;
end;
try
if fSearchFiles or fSearchProjectGroup then
DoFindInFiles(fDirectories);
if fSearchProject or fSearchOpen or fSearchActive then
DoFindInSearchList;
if Assigned(fResultsList) then begin
Result:=fResultsList.Count; // Return the real item count.
if fResultsList.Count = 0 then // Add a note to the list if no items found.
fResultsList.Add(Format(lisUESearchStringNotFound,[dbgstr(fSearchFor)]));
end;
finally
if fResultsListUpdating then begin
fResultsListUpdating:=false;
fResultsList.EndUpdate;
end;
end;
end;//if
Close;
end;//DoSearch
procedure TSearchProgressForm.DoFindInFiles(ADirectories: string);
var
Searcher: TFileSearcher;
SearchPath: String;
p: Integer;
Dir: String;
begin
// if we have a list and a valid directory
SearchPath:='';
p:=1;
repeat
Dir:=GetNextDirectoryInSearchPath(ADirectories,p);
if Dir='' then break;
if DirPathExists(Dir) then
SearchPath:=MergeSearchPaths(SearchPath,Dir);
until false;
if SearchPath='' then
exit;
Searcher := TFileSearcher.Create;
Searcher.OnDirectoryFound := @SearchEvent;
Searcher.OnDirectoryEnter := @SearchEvent;
Searcher.OnFileFound := @SearchEvent;
try
Searcher.Search(SearchPath, FMask, FRecursive);
finally
Searcher.Free;
end;
end;
procedure TSearchProgressForm.SearchEvent(FileIterator: TFileIterator);
begin
// File found
if not FileIterator.IsDirectory then
if FileIsTextCached(FileIterator.FileName) then
begin
UpdateProgress(FileIterator.FileName);
SearchFile(FileIterator.FileName);
end;
// Check abort
if Application.Terminated or Progress.Abort then
begin
FileIterator.Stop;
FResultsList.Insert(0, FAbortString);
end;
end;
procedure TSearchProgressForm.DoFindInSearchList;
var
i: integer;
begin
if Assigned(fSearchFileList) then
begin
for i:= 0 to fSearchFileList.Count -1 do
begin
UpdateProgress(fSearchFileList[i]);
SearchFile(fSearchFileList[i]);
end;
end;
end;
procedure TSearchProgressForm.SetResultsList(const AValue: TStrings);
begin
if fResultsList=AValue then exit;
if fResultsListUpdating then
begin
fResultsList.EndUpdate;
fResultsListUpdating:=false;
end;
fResultsList:=AValue;
end;
procedure TSearchProgressForm.UpdateMatches;
begin
inc(fMatches);
//DebugLn(['TSearchForm.UpdateMatches ',lblMatches.Caption]);
lblMatches.Caption:=IntToStr(fMatches);
end;
procedure TSearchProgressForm.UpdateProgress(FileName: string);
const
UpdateAfterTicks = 200; // update not more than 5 times per second
var
DisplayFileName: string;
ShorterFileName: String;
CurTick: DWORD;
begin
CurTick:=GetTickCount;
if Abs(int64(CurTick)-int64(fLastUpdateProgress))<UpdateAfterTicks then
exit;
fLastUpdateProgress:=CurTick;
DisplayFileName := FileName;
//DebugLn(['TSearchForm.UpdateProgress DisplayFileName="',dbgstr(DisplayFileName),'"']);
while (lblProgress.Left + lblProgress.Canvas.TextWidth(DisplayFileName)) > lblProgress.Parent.ClientWidth-12 do
begin
ShorterFileName:= PadAndShorten(DisplayFileName);
if ShorterFileName=DisplayFileName then break;
DisplayFileName:=ShorterFileName;
//DebugLn(['TSearchForm.UpdateProgress Padded DisplayFileName="',dbgstr(DisplayFileName),'"']);
end;
lblProgress.Caption := DisplayFileName;
Application.ProcessMessages;
end;
procedure TSearchProgressForm.SearchFile(const aFilename: string);
var
Src: String;
begin
fResultsList.BeginUpdate;
try
Src:='';
SearchInText(aFilename,Src,fSearchFor,FReplaceText,FFlags,
fPromptOnReplace,Progress);
finally
fResultsList.EndUpdate;
end;
end;
procedure TSearchProgressForm.SetFlag(Flag: TSrcEditSearchOption; AValue: boolean);
begin
if AValue then
Include(fFlags,Flag)
else
Exclude(fFlags,Flag);
end;
procedure TSearchProgressForm.DoSearchAndAddToSearchResults;
begin
LazarusIDE.DoShowSearchResultsView(iwgfShow);
if fResultsPageIndex >= 0 then
fResultsWindow:=SearchResultsView.GetResultsPage(fResultsPageIndex)
else
fResultsWindow:=SearchResultsView.AddSearch(SearchText, ReplaceText,
SearchDirectories, SearchMask, SearchOptions);
try
(* BeginUpdate prevents ListPage from being closed,
other pages can still be closed or inserted, so PageIndex can change *)
SearchResultsView.BeginUpdate(fResultsWindow.PageIndex);
ResultsList:= SearchResultsView.Items[fResultsWindow.PageIndex];
ResultsList.Clear;
try
Show; // floating window, not dockable
DoSearch;
except
on E: ERegExpr do
IDEMessageDialog(lisUEErrorInRegularExpression, E.Message,mtError,
[mbCancel]);
end;
finally
// show, but bring to front only if Search Progress dialog was active
if fWasActive then
LazarusIDE.DoShowSearchResultsView(iwgfShowOnTop)
else
LazarusIDE.DoShowSearchResultsView(iwgfShow);
SearchResultsView.EndUpdate(fResultsWindow.PageIndex, SearchText);
end;
end;
procedure TSearchProgressForm.DoSearchOpenFiles;
var
i: integer;
TheFileList: TStringList;
SrcEdit: TSourceEditorInterface;
begin
try
TheFileList:= TStringList.Create;
for i:= 0 to SourceEditorManagerIntf.UniqueSourceEditorCount -1 do
begin
//only if file exists on disk
SrcEdit := SourceEditorManagerIntf.UniqueSourceEditors[i];
if FilenameIsAbsolute(SrcEdit.FileName)
and (not FileExistsCached(SrcEdit.FileName)) then
continue;
TheFileList.Add(SrcEdit.FileName);
end;
SearchFileList:= TheFileList;
DoSearchAndAddToSearchResults;
finally
FreeAndNil(TheFileList);
end;
end;
procedure TSearchProgressForm.DoSearchActiveFile;
var
TheFileList: TStringList;
begin
try
TheFileList:= TStringList.Create; // Add a single file to the list
TheFileList.Add(SourceEditorManagerIntf.ActiveEditor.FileName);
SearchFileList:= TheFileList;
DoSearchAndAddToSearchResults;
finally
FreeAndNil(TheFileList);
end;
end;
procedure TSearchProgressForm.DoSearchDirs;
begin
SearchFileList:= Nil;
DoSearchAndAddToSearchResults;
end;
procedure TSearchProgressForm.DoSearchProject(AProject: TProject);
var
AnUnitInfo: TUnitInfo;
TheFileList: TStringList;
begin
try
TheFileList:= TStringList.Create;
for TLazProjectFile(AnUnitInfo) in AProject.UnitsBelongingToProject do begin
//Only if file exists on disk.
if FilenameIsAbsolute(AnUnitInfo.FileName)
and FileExistsCached(AnUnitInfo.FileName) then
TheFileList.Add(AnUnitInfo.FileName);
end;
SearchFileList:= TheFileList;
DoSearchAndAddToSearchResults;
finally
FreeAndNil(TheFileList);
end;
end;
procedure TSearchProgressForm.DoSearchProjectGroup;
begin
if (ProjectGroupManager=nil) or (ProjectGroupManager.CurrentProjectGroup=nil) then
DoSearchProject(Project1)
else begin
SearchFileList:= Nil;
SearchDirectories:=ProjectGroupManager.GetSrcPaths;
DoSearchAndAddToSearchResults;
end;
end;
function TSearchProgressForm.PadAndShorten(FileName: string): string;
var
FoundAt: integer;
begin
FoundAt:= System.Pos(PathDelim,FileName);
if FoundAt<1 then begin
Result := Filename;
end else begin
Result:= fPad + copy(FileName,FoundAt+1,Length(FileName));
end;
end;//PadAndShorten
end.