PageRenderTime 39ms CodeModel.GetById 27ms app.highlight 5ms RepoModel.GetById 1ms app.codeStats 0ms

/ide/searchfrm.pas

http://github.com/graemeg/lazarus
Pascal | 1096 lines | 1050 code | 12 blank | 34 comment | 0 complexity | b2dd6df88b1facadea7296ccfef9604f MD5 | raw file
   1{
   2/***************************************************************************
   3                                SearchFrm.pas
   4                             -------------------
   5
   6 ***************************************************************************/
   7
   8 ***************************************************************************
   9 *                                                                         *
  10 *   This source is free software; you can redistribute it and/or modify   *
  11 *   it under the terms of the GNU General Public License as published by  *
  12 *   the Free Software Foundation; either version 2 of the License, or     *
  13 *   (at your option) any later version.                                   *
  14 *                                                                         *
  15 *   This code is distributed in the hope that it will be useful, but      *
  16 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
  17 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
  18 *   General Public License for more details.                              *
  19 *                                                                         *
  20 *   A copy of the GNU General Public License is available on the World    *
  21 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
  22 *   obtain it by writing to the Free Software Foundation,                 *
  23 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
  24 *                                                                         *
  25 ***************************************************************************
  26}
  27unit SearchFrm;
  28
  29{$mode objfpc}{$H+}
  30
  31interface
  32
  33uses
  34  // RTL + FCL + LCL
  35  Classes, SysUtils, types, LCLProc, LCLIntf, Forms, Controls, ComCtrls,
  36  Dialogs, ExtCtrls, StdCtrls, Buttons,
  37  // SynEdit, CodeTools
  38  SynRegExpr, SourceLog, KeywordFuncLists, BasicCodeTools, FileProcs,
  39  // LazUtils
  40  FileUtil, LazFileUtils, LazFileCache,
  41  // IDEIntf
  42  IDEWindowIntf, LazIDEIntf, SrcEditorIntf, IDEDialogs,
  43  // ide
  44  LazarusIDEStrConsts, InputHistory, IDEProcs, SearchResultView, Project;
  45
  46type
  47
  48  { TSearchProgressForm }
  49
  50  TSearchProgressForm = class(TForm)
  51    btnCancel: TBitBtn;
  52    MatchesLabel: TLABEL;
  53    SearchingLabel: TLABEL;
  54    SearchTextLabel: TLABEL;
  55    lblMatches: TLABEL;
  56    lblProgress: TLABEL;
  57    lblSearchText: TLABEL;
  58    Panel2: TPANEL;
  59    procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
  60    procedure FormShow(Sender: TObject);
  61    procedure OnAddMatch(const Filename: string; const StartPos, EndPos: TPoint;
  62                         const Lines: string);
  63    procedure SearchFormCREATE(Sender: TObject);
  64    procedure SearchFormDESTROY(Sender: TObject);
  65    procedure btnAbortCLICK(Sender: TObject);
  66  private
  67    fFlags: TSrcEditSearchOptions;
  68    fAbortString: string;
  69    fMask: string;
  70    fMatches: longint;
  71    fPad: string;
  72    FProgress: TIDESearchInTextProgress;
  73    fPromptOnReplace: boolean;
  74    fRecursive: boolean;
  75    FReplaceText: string;
  76    fResultsListUpdating: boolean;
  77    fResultsList: TStrings;
  78    fResultsWindow: TTabSheet;
  79    fSearchFileList: TStringList;
  80    fSearchFiles: boolean;
  81    fSearchFor: String;
  82    fDirectories: string;
  83    fSearchOpen: boolean;
  84    fSearchActive: boolean;
  85    fSearchProject: boolean;
  86    fAborting: boolean;
  87    fLastUpdateProgress: DWORD;
  88    fWasActive: boolean;
  89    procedure DoFindInFiles(ADirectories: string);
  90    procedure DoFindInSearchList;
  91    procedure SetResultsList(const AValue: TStrings);
  92    procedure UpdateMatches;
  93    procedure UpdateProgress(FileName: string);
  94    function PadAndShorten(FileName: string): string;
  95    procedure SetOptions(TheOptions: TLazFindInFileSearchOptions);
  96    function GetOptions: TLazFindInFileSearchOptions;
  97    procedure SearchFile(const aFilename: string);
  98    procedure SetFlag(Flag: TSrcEditSearchOption; AValue: boolean);
  99    procedure DoSearchAndAddToSearchResults;
 100    function DoSearch: integer;
 101  public
 102    procedure DoSearchOpenFiles;
 103    procedure DoSearchActiveFile;
 104    procedure DoSearchDir;
 105    procedure DoSearchProject(AProject: TProject);
 106  public
 107    property SearchDirectories: string read fDirectories write fDirectories;
 108    property SearchText: string read fSearchFor write fSearchFor;
 109    property ReplaceText: string read FReplaceText write FReplaceText;
 110    property SearchOptions: TLazFindInFileSearchOptions read GetOptions
 111                                                        write SetOptions;
 112    property SearchFileList: TStringList read fSearchFileList
 113                                         write fSearchFileList;
 114    property ResultsList: TStrings read fResultsList write SetResultsList;
 115    property SearchMask: string read fMask write fMask;
 116    property Pad: string read fPad write fPad;
 117    property ResultsWindow: TTabSheet read fResultsWindow write fResultsWindow;
 118    property PromptOnReplace: boolean read fPromptOnReplace write fPromptOnReplace;// this is asked once and can be changed when prompting
 119    property Progress: TIDESearchInTextProgress read FProgress;
 120  end;
 121
 122var
 123  SearchProgressForm: TSearchProgressForm;
 124  
 125function SearchInText(const TheFileName: string;
 126  var TheText: string;// if TheFileName='' then use TheText
 127  SearchFor, ReplaceText: string;
 128  Flags: TSrcEditSearchOptions; var Prompt: boolean;
 129  Progress: TIDESearchInTextProgress = nil
 130  ): TModalResult;
 131function TrimLinesAndAdjustPos(const Lines: string; var APosition: integer): string;
 132function SearchInLine(const SearchStr: string; SrcLog: TSourceLog;
 133  LineNumber: integer; WholeWords: boolean; StartInLine: integer;
 134  out MatchStartInLine: integer): boolean;
 135
 136
 137implementation
 138
 139{$R *.lfm}
 140
 141const
 142  WordBreakChars = [#0..#31,'.', ',', ';', ':', '"', '''', '!', '?', '[', ']',
 143               '(', ')', '{', '}', '^', '-', '=', '+', '*', '/', '\', '|', ' '];
 144  WhiteSpaceChars = [' ',#10,#13,#9];
 145
 146function SearchInLine(const SearchStr: string; SrcLog: TSourceLog;
 147  LineNumber: integer; WholeWords: boolean; StartInLine: integer;
 148  out MatchStartInLine: integer): boolean;
 149// search SearchStr in SrcLog line
 150// returns MatchStartInLine=1 for start of line
 151var
 152  LineRange: TLineRange;
 153  Src: String;
 154  StartPos: PChar;
 155  EndPos: PChar;
 156  i: Integer;
 157  SearchLen: Integer;
 158  LineStartPos: PChar;
 159  FirstChar: Char;
 160  Found: Boolean;
 161  CharInFront: PChar;
 162  CharBehind: PChar;
 163begin
 164  Result:=false;
 165  if SearchStr='' then exit;
 166  SrcLog.GetLineRange(LineNumber-1,LineRange);
 167  Src:=SrcLog.Source;
 168  SearchLen:=length(SearchStr);
 169  LineStartPos:=@Src[LineRange.StartPos];
 170  StartPos:=LineStartPos+StartInLine-1;
 171  EndPos:=@Src[LineRange.EndPos-SearchLen+1];
 172  FirstChar:=SearchStr[1];
 173  while (StartPos<EndPos) do begin
 174    if FirstChar=StartPos^ then begin
 175      i:=1;
 176      while (i<=SearchLen) and (StartPos[i-1]=SearchStr[i]) do
 177        inc(i);
 178      if i>SearchLen then begin
 179        Found:=true;
 180        MatchStartInLine:=StartPos-LineStartPos+1;
 181        if WholeWords then begin
 182          CharInFront:=StartPos-1;
 183          CharBehind:=StartPos+SearchLen;
 184          if ((MatchStartInLine=1)
 185              or (CharInFront^ in WordBreakChars))
 186          and ((StartPos+SearchLen=@Src[LineRange.EndPos])
 187               or (CharBehind^ in WordBreakChars))
 188          then begin
 189            // word start and word end
 190          end else begin
 191            // not whole word
 192            Found:=false;
 193          end;
 194        end;
 195        if Found then begin
 196          Result:=true;
 197          exit;
 198        end;
 199      end;
 200    end;
 201    inc(StartPos);
 202  end;
 203end;
 204
 205function TrimLinesAndAdjustPos(const Lines: string;
 206  var APosition: integer): string;
 207var
 208  StartPos: Integer;
 209  EndPos: Integer;
 210begin
 211  if Lines='' then begin
 212    Result:='';
 213    exit;
 214  end;
 215  if LineEndCount(Lines)=0 then begin
 216    StartPos:=1;
 217    while (StartPos<=length(Lines)) and (Lines[StartPos] in WhiteSpaceChars) do
 218      inc(StartPos);
 219    if (APosition>0) and (StartPos>APosition) then
 220      StartPos:=APosition;
 221    EndPos:=length(Lines)+1;
 222    while (EndPos>=StartPos) and (Lines[EndPos-1] in WhiteSpaceChars) do
 223      dec(EndPos);
 224    dec(APosition,StartPos-1);
 225    Result:=copy(Lines,StartPos,EndPos-StartPos);
 226  end else
 227    Result:=Lines;
 228end;
 229
 230function SearchInText(const TheFileName: string;
 231  var TheText: string;// if TheFileName='' then use TheText
 232  SearchFor, ReplaceText: string;
 233  Flags: TSrcEditSearchOptions; var Prompt: boolean;
 234  Progress: TIDESearchInTextProgress = nil
 235  ): TModalResult;
 236var
 237  OriginalFile: TSourceLog;// The original File being searched
 238  CaseFile: TSourceLog;  // The working File being searched
 239  FoundStartPos: TPoint; // Position of match in line. 1 based.
 240  FoundEndPos: TPoint;
 241  ReplaceLineOffset: integer;// number of lines added/deleted by replacement.
 242  LastReplaceLine: integer;  // last changed line by replace. 1 based
 243  LastReplaceColOffset: integer;// bytes added/deleted by replace in last line
 244  TempSearch: string;    // Temp Storage for the search string.
 245  RE: TRegExpr;
 246  Lines: String;
 247
 248  SrcEditValid: Boolean;// true if SrcEdit is valid
 249  SrcEdit: TSourceEditorInterface;
 250  PaintLockEnabled: Boolean;
 251
 252  ReplacedText: PChar;
 253  ReplacedTextCapacity: integer;
 254  ReplacedTextLength: integer;
 255  ReplacedTextOriginalPos: integer;// 1-based. e.g. 2 bytes has been replaced => ReplacedTextOriginalPos=3.
 256  
 257  procedure DoAbort;
 258  begin
 259    if Progress<>nil then
 260      Progress.Abort:=true;
 261    Result:=mrAbort;
 262  end;
 263  
 264  procedure ProcessMessages;
 265  begin
 266    if Application<>nil then Application.ProcessMessages;
 267    if (Progress<>nil) and Progress.Abort then
 268      Result:=mrAbort;
 269  end;
 270  
 271  function FileIsOpenInSourceEditor: boolean;
 272  begin
 273    if not SrcEditValid then begin
 274      if (TheFileName<>'') and (SourceEditorManagerIntf<>nil) then
 275        SrcEdit:=SourceEditorManagerIntf.SourceEditorIntfWithFilename(TheFileName)
 276      else
 277        SrcEdit:=nil;
 278      SrcEditValid:=true;
 279    end;
 280    Result:=SrcEdit<>nil;
 281  end;
 282
 283  procedure GrowNewText(NewLength: integer);
 284  var
 285    NewCapacity: Integer;
 286  begin
 287    if NewLength<=ReplacedTextCapacity then exit;
 288    // grow
 289    // first double
 290    NewCapacity:=ReplacedTextCapacity*2;
 291    if NewLength>NewCapacity then begin
 292      // double is not enough, use the original size as minimum
 293      if NewCapacity<1 then
 294        NewCapacity:=OriginalFile.SourceLength+1000;
 295      if NewLength>NewCapacity then begin
 296        // still not enough -> grow to new length
 297        NewCapacity:=NewLength;
 298      end;
 299    end;
 300    ReplacedTextCapacity:=NewCapacity;
 301    ReAllocMem(ReplacedText,ReplacedTextCapacity);
 302  end;
 303
 304  procedure EnablePaintLock;
 305  begin
 306    if (not PaintLockEnabled) and FileIsOpenInSourceEditor then begin
 307      PaintLockEnabled:=true;
 308      SrcEdit.BeginUpdate;
 309    end;
 310  end;
 311
 312  procedure DisablePaintLock;
 313  begin
 314    if PaintLockEnabled then
 315      SrcEdit.EndUpdate;
 316    PaintLockEnabled:=false;
 317  end;
 318
 319  procedure EndLocks;
 320  begin
 321    DisablePaintLock;
 322    SrcEditValid:=false;
 323  end;
 324
 325  procedure DoReplaceLine;
 326  var
 327    AReplace: String;
 328    Action: TSrcEditReplaceAction;
 329    OriginalTextPos: integer; // 1-based
 330    GapLength: Integer;
 331    NewLength: Integer;
 332    SrcEditPosValid: boolean;
 333    SrcEditStartPos, SrcEditEndPos: TPoint;
 334    aLastLineLength: integer;
 335    aLineCount: integer;
 336    i: integer;
 337    
 338    procedure GetSrcEditPos;
 339    begin
 340      if not SrcEditPosValid then begin
 341        SrcEditStartPos:=FoundStartPos;
 342        SrcEditEndPos:=FoundEndPos;
 343        // FoundStart/EndPos contain the original position
 344        // add the changes due to replacement to SrcEditStart/EndPos
 345        if SrcEditStartPos.Y=LastReplaceLine then
 346          inc(SrcEditStartPos.X,LastReplaceColOffset);
 347        if SrcEditStartPos.Y>=LastReplaceLine then
 348          inc(SrcEditStartPos.Y,ReplaceLineOffset);
 349        if SrcEditEndPos.Y=LastReplaceLine then
 350          inc(SrcEditEndPos.X,LastReplaceColOffset);
 351        if SrcEditEndPos.Y>=LastReplaceLine then
 352          inc(SrcEditEndPos.Y,ReplaceLineOffset);
 353        SrcEditPosValid:=true;
 354      end;
 355    end;
 356    
 357  begin
 358    // create replacement
 359    AReplace:=ReplaceText;
 360    if sesoRegExpr in Flags then
 361      AReplace:=RE.Substitute(AReplace);
 362    //DebugLn(['DoReplaceLine Replace with "',AReplace,'"']);
 363      
 364    SrcEditPosValid:=false;
 365      
 366    // ask the user
 367    if Prompt and (TheFileName<>'') then begin
 368      // open the place in the source editor
 369      EndLocks;
 370
 371      // update windows
 372      ProcessMessages;
 373      if Result=mrAbort then exit;
 374      
 375      GetSrcEditPos;
 376      if LazarusIDE.DoOpenFileAndJumpToPos(TheFileName,SrcEditStartPos,
 377             -1,-1,-1,[ofUseCache,ofDoNotLoadResource,ofVirtualFile,ofRegularFile])
 378      <>mrOk then
 379      begin
 380        DoAbort;
 381        exit;
 382      end;
 383      // select found text
 384      if not FileIsOpenInSourceEditor then
 385        RaiseGDBException('inconsistency');
 386      SrcEdit.SelectText(SrcEditStartPos.Y,SrcEditStartPos.X,
 387                         SrcEditEndPos.Y,SrcEditEndPos.X);
 388      SrcEdit.AskReplace(nil,SrcEdit.Selection,AReplace,
 389                         SrcEditStartPos.Y,SrcEditStartPos.X,Action);
 390      case Action of
 391        seraSkip: exit;
 392        seraReplace: ;
 393        seraReplaceAll: Prompt:=false;
 394      else
 395        DoAbort;
 396        exit;
 397      end;
 398    end;
 399
 400    if FileIsOpenInSourceEditor then begin
 401      // change text in source editor
 402      EnablePaintLock;
 403      GetSrcEditPos;
 404      SrcEdit.SelectText(SrcEditStartPos.Y,SrcEditStartPos.X,
 405                         SrcEditEndPos.Y,SrcEditEndPos.X);
 406      SrcEdit.Selection:=AReplace;
 407
 408      // count total replacements and adjust offsets
 409      aLineCount:=LineEndCount(AReplace,aLastLineLength);
 410      //debugln(['DoReplaceLine Replace="',dbgstr(AReplace),'" aLineCount=',aLineCount,' aLastLineLength=',aLastLineLength]);
 411      if aLineCount>0 then begin
 412        // replaced with multiple lines
 413        LastReplaceColOffset:=aLastLineLength+1-FoundEndPos.X;
 414      end else begin
 415        if FoundStartPos.Y<>LastReplaceLine then
 416          LastReplaceColOffset:=0;
 417        // replaced with some words
 418        if FoundStartPos.Y=FoundEndPos.Y then begin
 419          // replaced some words with some words
 420          inc(LastReplaceColOffset,
 421                               aLastLineLength-(FoundEndPos.X-FoundStartPos.X));
 422        end else begin
 423          // replaced several lines with some words
 424          inc(LastReplaceColOffset,FoundStartPos.X+aLastLineLength-FoundEndPos.X);
 425        end;
 426      end;
 427      LastReplaceLine:=FoundEndPos.Y;
 428
 429      Lines := '';
 430      for i := SrcEditStartPos.Y to SrcEditStartPos.Y + aLineCount do
 431        Lines := Lines + SrcEdit.Lines[i-1] + LineEnding;
 432      Lines:=ChompOneLineEndAtEnd(Lines);
 433      if (Progress<>nil)
 434      and (Progress.OnAddMatch<>nil) then begin
 435        Progress.OnAddMatch(TheFileName,
 436          Point(FoundStartPos.x, FoundStartPos.y + ReplaceLineOffset),
 437          SrcEdit.CursorTextXY,Lines);
 438      end;
 439
 440      inc(ReplaceLineOffset,aLineCount-(FoundEndPos.Y-FoundStartPos.Y));
 441      //DebugLn(['DoReplaceLine FoundStartPos=',dbgs(FoundStartPos),' FoundEndPos=',dbgs(FoundEndPos),' aLastLineLength=',aLastLineLength,' LastReplaceLine=',LastReplaceLine,' LastReplaceColOffset=',LastReplaceColOffset,' ReplaceLineOffset=',ReplaceLineOffset]);
 442    end else begin
 443      // change text in memory/disk
 444      OriginalFile.LineColToPosition(FoundStartPos.Y,FoundStartPos.X,
 445                                     OriginalTextPos);
 446      GapLength:=OriginalTextPos-ReplacedTextOriginalPos;
 447      NewLength:=ReplacedTextLength+GapLength+length(AReplace);
 448      GrowNewText(NewLength);
 449      // copy the text between the last replacement and this replacement
 450      if GapLength>0 then begin
 451        System.Move(OriginalFile.Source[ReplacedTextOriginalPos],
 452                    ReplacedText[ReplacedTextLength],GapLength);
 453        inc(ReplacedTextLength,GapLength);
 454      end;
 455      // copy the replacement
 456      if AReplace<>'' then begin
 457        System.Move(AReplace[1],ReplacedText[ReplacedTextLength],length(AReplace));
 458        inc(ReplacedTextLength,length(AReplace));
 459      end;
 460      // save original position behind found position
 461      OriginalFile.LineColToPosition(FoundEndPos.Y,FoundEndPos.X,
 462                                     ReplacedTextOriginalPos);
 463
 464      Lines:=copy(OriginalFile.GetLines(FoundStartPos.Y,FoundStartPos.Y), 1, FoundStartPos.X - 1) +
 465             AReplace +
 466             copy(OriginalFile.GetLines(FoundEndPos.Y,FoundEndPos.Y), FoundEndPos.x, MaxInt);
 467      Lines:=ChompOneLineEndAtEnd(Lines);
 468      aLineCount:=LineEndCount(AReplace,aLastLineLength);
 469      if aLineCount = 0 then aLastLineLength := aLastLineLength + FoundStartPos.X;
 470      if (Progress<>nil)
 471      and (Progress.OnAddMatch<>nil) then begin
 472        Progress.OnAddMatch(TheFileName,
 473          Point(FoundStartPos.x, FoundStartPos.y + ReplaceLineOffset),
 474          Point(aLastLineLength, FoundStartPos.Y + aLineCount + ReplaceLineOffset),
 475          Lines);
 476      end;
 477
 478      inc(ReplaceLineOffset,aLineCount-(FoundEndPos.Y-FoundStartPos.Y));
 479    end;
 480  end;
 481
 482  procedure CommitChanges;
 483  var
 484    GapLength: Integer;
 485    NewLength: Integer;
 486    NewText: string;
 487    CurResult: TModalResult;
 488  begin
 489    EndLocks;
 490    if (ReplacedText<>nil) then begin
 491      if SearchInText<>mrAbort then begin
 492        GapLength:=OriginalFile.SourceLength+1-ReplacedTextOriginalPos;
 493        NewLength:=ReplacedTextLength+GapLength;
 494        GrowNewText(NewLength);
 495        // copy the text between the last and this replacement
 496        if GapLength>0 then begin
 497          System.Move(OriginalFile.Source[ReplacedTextOriginalPos],
 498                      ReplacedText[ReplacedTextLength],GapLength);
 499          inc(ReplacedTextLength,GapLength);
 500        end;
 501        SetLength(NewText,ReplacedTextLength);
 502        if NewText<>'' then
 503          System.Move(ReplacedText[0],NewText[1],length(NewText));
 504        if (TheFileName<>'') then begin
 505          OriginalFile.Source:=NewText;
 506          if (not OriginalFile.SaveToFile(TheFileName)) then begin
 507            CurResult:=MessageDlg(lisCodeToolsDefsWriteError,
 508                                  Format(lisErrorWritingFile, [TheFileName]),
 509                                  mtError,[mbCancel,mbAbort],0);
 510            if CurResult=mrAbort then DoAbort;
 511          end;
 512        end else begin
 513          TheText:=NewText;
 514        end;
 515      end;
 516      FreeMem(ReplacedText);
 517    end;
 518  end;
 519
 520var
 521  Found: Boolean;
 522  Src: String;
 523  NewMatchStartPos: PtrInt;
 524  NewMatchEndPos: PtrInt;
 525begin
 526  //debugln(['SearchInText TheFileName=',TheFileName,' SearchFor=',SearchFor,'" ReplaceText=',ReplaceText,'"']);
 527
 528  if (Progress<>nil) and Progress.Abort then exit(mrAbort);
 529  Result:=mrOk;
 530
 531  OriginalFile:=nil;
 532  CaseFile:=nil;
 533  RE:=nil;
 534  SrcEdit:=nil;
 535  SrcEditValid:=false;
 536  PaintLockEnabled:=false;
 537  ReplacedText:=nil;
 538  ReplacedTextCapacity:=0;
 539  ReplacedTextLength:=0;
 540  ReplacedTextOriginalPos:=1;
 541
 542  ReplaceLineOffset:=0;
 543  LastReplaceLine:=0;
 544  LastReplaceColOffset:=0;
 545
 546  try
 547    FoundEndPos:= Point(0,0);
 548    TempSearch:= SearchFor;
 549
 550    // load text (to save memory, do not use codetools cache system)
 551    if FileIsOpenInSourceEditor then begin
 552      OriginalFile:=TSourceLog.Create(SrcEdit.GetText(false));
 553    end else if TheFileName<>'' then begin
 554      OriginalFile:=TSourceLog.Create('');
 555      OriginalFile.LoadFromFile(TheFileName);
 556    end else begin
 557      OriginalFile:=TSourceLog.Create(TheText);
 558    end;
 559    if OriginalFile.Source='' then exit;
 560
 561    CaseFile:=nil;
 562
 563    if sesoRegExpr in Flags then begin
 564      // Setup the regular expression search engine
 565      RE:=TRegExpr.Create;
 566      RE.ModifierI:=not (sesoMatchCase in Flags);
 567      RE.ModifierM:=true;
 568      RE.ModifierS:=sesoMultiLine in Flags;
 569      Src:=OriginalFile.Source;
 570      if sesoWholeWord in Flags then
 571        RE.Expression:='\b'+SearchFor+'\b'
 572      else
 573        RE.Expression:=SearchFor;
 574    end else begin
 575      // convert case if necessary
 576      if not (sesoMatchCase in Flags) then begin
 577        CaseFile:=TSourceLog.Create(UpperCaseStr(OriginalFile.Source));
 578        TempSearch:=UpperCaseStr(TempSearch);
 579        Src:=CaseFile.Source;
 580      end else
 581        Src:=OriginalFile.Source;
 582    end;
 583
 584    //debugln(['TheFileName=',TheFileName,' len=',OriginalFile.SourceLength,' Cnt=',OriginalFile.LineCount,' TempSearch=',TempSearch]);
 585    ProcessMessages;
 586
 587    NewMatchEndPos:=1;
 588    repeat
 589      Found:=false;
 590      if sesoRegExpr in Flags then begin
 591        // search the text for regular expression
 592        RE.InputString:=Src;
 593        if RE.ExecPos(NewMatchEndPos) then begin
 594          Found:=true;
 595          NewMatchStartPos:=RE.MatchPos[0];
 596          NewMatchEndPos:=NewMatchStartPos+RE.MatchLen[0];
 597        end;
 598      end else begin
 599        // search for normal text
 600        if SearchNextInText(PChar(TempSearch),length(TempSearch),
 601                            PChar(Src),length(Src),
 602                            NewMatchEndPos-1,NewMatchStartPos,NewMatchEndPos,
 603                            sesoWholeWord in Flags,sesoMultiLine in Flags)
 604        then begin
 605          Found:=true;
 606          inc(NewMatchStartPos);
 607          inc(NewMatchEndPos);
 608        end;
 609      end;
 610      
 611      if Found then begin
 612        // found => convert position, report and/or replace
 613        OriginalFile.AbsoluteToLineCol(NewMatchStartPos,
 614                                       FoundStartPos.Y,FoundStartPos.X);
 615        OriginalFile.AbsoluteToLineCol(NewMatchEndPos,
 616                                       FoundEndPos.Y,FoundEndPos.X);
 617        //DebugLn(['SearchInText NewMatchStartPos=',NewMatchStartPos,' NewMatchEndPos=',NewMatchEndPos,' FoundStartPos=',dbgs(FoundStartPos),' FoundEndPos=',dbgs(FoundEndPos),' Found="',dbgstr(copy(Src,NewMatchStartPos,NewMatchEndPos-NewMatchStartPos)),'" Replace=',sesoReplace in Flags]);
 618        if sesoReplace in Flags then begin
 619          DoReplaceLine
 620        end else begin
 621          if (Progress<>nil)
 622          and (Progress.OnAddMatch<>nil) then begin
 623            Lines:=OriginalFile.GetLines(FoundStartPos.Y,FoundEndPos.Y);
 624            Lines:=ChompOneLineEndAtEnd(Lines);
 625            if (Progress<>nil)
 626            and (Progress.OnAddMatch<>nil) then begin
 627              Progress.OnAddMatch(TheFileName,FoundStartPos,FoundEndPos,Lines);
 628            end;
 629          end;
 630        end;
 631      end else begin
 632        // not found
 633        break;
 634      end;
 635
 636      // check abort
 637      if (Result=mrAbort) then begin
 638        exit;
 639      end;
 640      
 641    until false;
 642  finally
 643    CommitChanges;
 644    if OriginalFile=CaseFile then
 645      CaseFile:=nil;
 646    FreeAndNil(OriginalFile);
 647    FreeAndNil(CaseFile);
 648    FreeAndNil(RE);
 649  end;
 650end;//SearchFile
 651
 652
 653{ TSearchProgressForm }
 654
 655procedure TSearchProgressForm.btnAbortCLICK(Sender: TObject);
 656begin
 657  Progress.Abort:= true;
 658end;
 659
 660procedure TSearchProgressForm.SearchFormCREATE(Sender: TObject);
 661  Function MaxWidth(Labs : array of TLabel) : integer;
 662  var i,w : integer;
 663  begin
 664    Result:=0;
 665    for i:=low(Labs) to high(Labs) do
 666      begin
 667          w:=Canvas.TextWidth(Labs[i].Caption);
 668          if Result<w then
 669             Result:=w;
 670      end;
 671  end;
 672
 673var NewX : integer;
 674begin
 675  //Set Defaults
 676  MatchesLabel.Caption:=lissMatches;
 677  SearchingLabel.Caption:=lissSearching;
 678  SearchTextLabel.Caption:=lissSearchText;
 679  NewX:=MatchesLabel.Left+MaxWidth([MatchesLabel,SearchingLabel,SearchTextLabel])+10;
 680  lblMatches.Left:=NewX;
 681  lblProgress.Left:=NewX;
 682  lblSearchText.Left:=NewX;
 683
 684  Caption:=dlgSearchCaption;
 685  btnCancel.Caption:=lisCancel;
 686
 687  fProgress:=TIDESearchInTextProgress.Create;
 688  FProgress.OnAddMatch:=@OnAddMatch;
 689
 690  fFlags:=[];
 691  fPromptOnReplace:=true;
 692  fRecursive:= True;
 693  Progress.Abort:= false;
 694  fAbortString:= dlgSearchAbort;
 695  fPad:= '...';
 696  fSearchProject:= false;
 697  fSearchOpen:= false;
 698  fSearchFiles:= false;
 699  fWasActive:= false;
 700end;
 701
 702procedure TSearchProgressForm.OnAddMatch(const Filename: string; const StartPos,
 703  EndPos: TPoint; const Lines: string);
 704var
 705  MatchLen: Integer;
 706  TrimmedMatch: LongInt;
 707  TrimmedLines: String;
 708  LastLineLen: integer;
 709begin
 710  LineEndCount(Lines,LastLineLen);
 711  MatchLen:=length(Lines)-(LastLineLen+1-EndPos.X)-StartPos.X+1;
 712  if MatchLen<1 then MatchLen:=1;
 713  //DebugLn(['TSearchForm.OnAddMatch length(Lines)=',length(Lines),' LastLineLen=',LastLineLen,' MatchLen=',MatchLen]);
 714  TrimmedMatch:=StartPos.X;
 715  TrimmedLines:=TrimLinesAndAdjustPos(Lines,TrimmedMatch);
 716  //DebugLn(['TSearchForm.OnAddMatch StartPos=',dbgs(StartPos),' EndPos=',dbgs(EndPos),' Lines="',Lines,'" Trimmed="',TrimmedLines,'" TrimmedMatch=',TrimmedMatch]);
 717  SearchResultsView.AddMatch(fResultsWindow.PageIndex,FileName,StartPos,EndPos,
 718                             TrimmedLines, TrimmedMatch, MatchLen);
 719  UpdateMatches;
 720end;
 721
 722procedure TSearchProgressForm.FormClose(Sender: TObject; var CloseAction:
 723  TCloseAction);
 724begin
 725  fWasActive:= Active;
 726end;
 727
 728procedure TSearchProgressForm.FormShow(Sender: TObject);
 729begin
 730  fWasActive:= true;
 731end;
 732
 733procedure TSearchProgressForm.SearchFormDESTROY(Sender: TObject);
 734begin
 735  FreeAndNil(fProgress);
 736end;
 737
 738procedure TSearchProgressForm.SetOptions(TheOptions: TLazFindInFileSearchOptions);
 739begin
 740  SetFlag(sesoWholeWord,fifWholeWord in TheOptions);
 741  SetFlag(sesoReplace,fifReplace in TheOptions);
 742  SetFlag(sesoReplaceAll,fifReplaceAll in TheOptions);
 743  SetFlag(sesoMatchCase,fifMatchCase in TheOptions);
 744  SetFlag(sesoRegExpr,fifRegExpr in TheOptions);
 745  SetFlag(sesoMultiLine,fifMultiLine in TheOptions);
 746  fRecursive:= (fifIncludeSubDirs in TheOptions);
 747  fSearchProject:= (fifSearchProject in TheOptions);
 748  fSearchOpen:= (fifSearchOpen in TheOptions);
 749  fSearchActive:= (fifSearchActive in TheOptions);
 750  fSearchFiles:= (fifSearchDirectories in TheOptions);
 751end;//SetOptions
 752
 753function TSearchProgressForm.GetOptions: TLazFindInFileSearchOptions;
 754begin
 755  Result:=[];
 756  if sesoWholeWord in fFlags then include(Result,fifWholeWord);
 757  if sesoMatchCase in fFlags then include(Result,fifMatchCase);
 758  if sesoReplace in fFlags then include(Result,fifReplace);
 759  if sesoReplaceAll in fFlags then include(Result,fifReplaceAll);
 760  if sesoRegExpr in fFlags then include(Result,fifRegExpr);
 761  if sesoMultiLine in fFlags then include(Result,fifMultiLine);
 762  if fRecursive then include(Result,fifIncludeSubDirs);
 763  if fSearchProject then include(Result, fifSearchProject);
 764  if fSearchOpen then include(Result,fifSearchOpen);
 765  if fSearchActive then include(Result,fifSearchActive);
 766  if fSearchFiles then include(Result,fifSearchDirectories);
 767end;//GetOptions
 768
 769function TSearchProgressForm.DoSearch: integer;
 770// Search in all files and then return the number of found items.
 771begin
 772  Result:= 0;
 773  PromptOnReplace:=true;
 774  fAborting:=false;
 775  Progress.Abort:=false;
 776  lblSearchText.Caption:= fSearchFor;
 777  fMatches:= 0;
 778  if Assigned(fResultsList) then
 779  begin
 780    if not fResultsListUpdating then begin
 781      fResultsList.BeginUpdate;
 782      fResultsListUpdating:=true;
 783    end;
 784    try
 785      if fSearchFiles then
 786        DoFindInFiles(fDirectories);
 787      if fSearchProject or fSearchOpen or fSearchActive then
 788        DoFindInSearchList;
 789      if Assigned(fResultsList) then begin
 790        Result:=fResultsList.Count;     // Return the real item count.
 791        if fResultsList.Count = 0 then  // Add a note to the list if no items found.
 792          fResultsList.Add(Format(lisUESearchStringNotFound,[dbgstr(fSearchFor)]));
 793      end;
 794    finally
 795      if fResultsListUpdating then begin
 796        fResultsListUpdating:=false;
 797        fResultsList.EndUpdate;
 798      end;
 799    end;
 800  end;//if
 801  Close;
 802end;//DoSearch
 803
 804type
 805
 806  { TLazFileSearcher }
 807
 808  TLazFileSearcher = class(TFileSearcher)
 809  private
 810    FParent: TSearchProgressForm;
 811    procedure CheckAbort;
 812  protected
 813    procedure DoDirectoryEnter; override;
 814    procedure DoDirectoryFound; override;
 815    procedure DoFileFound; override;
 816  public
 817    constructor Create(AParent: TSearchProgressForm);
 818    destructor Destroy; override;
 819  end;
 820
 821{ TLazFileSearcher }
 822
 823procedure TLazFileSearcher.CheckAbort;
 824begin
 825  if FParent.Progress.Abort then
 826  begin
 827    if not FParent.FAborting then
 828    begin
 829      FParent.FAborting := True;
 830      FParent.FResultsList.Insert(0, FParent.FAbortString);
 831    end;
 832
 833    Stop;
 834  end;
 835end;
 836
 837procedure TLazFileSearcher.DoDirectoryEnter;
 838begin
 839  CheckAbort;
 840end;
 841
 842procedure TLazFileSearcher.DoDirectoryFound;
 843begin
 844  CheckAbort;
 845end;
 846
 847procedure TLazFileSearcher.DoFileFound;
 848var
 849  F: String;
 850begin
 851  F := FileName;
 852  if FileIsTextCached(F) then
 853  begin
 854    FParent.UpdateProgress(F);
 855    FParent.SearchFile(F);
 856  end;
 857  CheckAbort;
 858end;
 859
 860constructor TLazFileSearcher.Create(AParent: TSearchProgressForm);
 861begin
 862  inherited Create;
 863  FParent := AParent;
 864end;
 865
 866destructor TLazFileSearcher.Destroy;
 867begin
 868  FParent:=nil;
 869  inherited Destroy;
 870end;
 871
 872{ TSearchProgressForm }
 873
 874procedure TSearchProgressForm.DoFindInFiles(ADirectories: string);
 875var
 876  Searcher: TLazFileSearcher;
 877  SearchPath: String;
 878  p: Integer;
 879  Dir: String;
 880begin
 881  // if we have a list and a valid directory
 882  SearchPath:='';
 883  p:=1;
 884  repeat
 885    Dir:=GetNextDirectoryInSearchPath(ADirectories,p);
 886    if Dir='' then break;
 887    if DirPathExists(Dir) then
 888      SearchPath:=MergeSearchPaths(SearchPath,Dir);
 889  until false;
 890  if SearchPath='' then
 891    exit;
 892  Searcher := TLazFileSearcher.Create(Self);
 893  try
 894    Searcher.Search(SearchPath, FMask, FRecursive);
 895  finally
 896    Searcher.Free;
 897  end;
 898end;
 899
 900procedure TSearchProgressForm.DoFindInSearchList;
 901var
 902  i: integer;
 903begin
 904  if Assigned(fSearchFileList) then
 905  begin
 906    for i:= 0 to fSearchFileList.Count -1 do
 907    begin
 908      UpdateProgress(fSearchFileList[i]);
 909      SearchFile(fSearchFileList[i]);
 910    end;
 911  end;
 912end;
 913
 914procedure TSearchProgressForm.SetResultsList(const AValue: TStrings);
 915begin
 916  if fResultsList=AValue then exit;
 917  if fResultsListUpdating then
 918  begin
 919    fResultsList.EndUpdate;
 920    fResultsListUpdating:=false;
 921  end;
 922  fResultsList:=AValue;
 923end;
 924
 925procedure TSearchProgressForm.UpdateMatches;
 926begin
 927  inc(fMatches);
 928  //DebugLn(['TSearchForm.UpdateMatches ',lblMatches.Caption]);
 929  lblMatches.Caption:=IntToStr(fMatches);
 930end;
 931
 932procedure TSearchProgressForm.UpdateProgress(FileName: string);
 933const
 934  UpdateAfterTicks = 200; // update not more than 5 times per second
 935var
 936  DisplayFileName: string;
 937  ShorterFileName: String;
 938  CurTick: DWORD;
 939begin
 940  CurTick:=GetTickCount;
 941  if Abs(int64(CurTick)-int64(fLastUpdateProgress))<UpdateAfterTicks then
 942    exit;
 943  fLastUpdateProgress:=CurTick;
 944
 945  DisplayFileName := FileName;
 946  //DebugLn(['TSearchForm.UpdateProgress DisplayFileName="',dbgstr(DisplayFileName),'"']);
 947  lblProgress.Caption:= DisplayFileName;
 948  while (lblProgress.Left + lblProgress.Width)> lblProgress.Parent.ClientWidth-12 do
 949  begin
 950    ShorterFileName:= PadAndShorten(DisplayFileName);
 951    if ShorterFileName=DisplayFileName then break;
 952    DisplayFileName:=ShorterFileName;
 953    //DebugLn(['TSearchForm.UpdateProgress Padded DisplayFileName="',dbgstr(DisplayFileName),'"']);
 954    lblProgress.Caption := DisplayFileName;
 955  end;
 956end;
 957
 958procedure TSearchProgressForm.SearchFile(const aFilename: string);
 959var
 960  Src: String;
 961begin
 962  fResultsList.BeginUpdate;
 963  try
 964    Src:='';
 965    SearchInText(aFilename,Src,fSearchFor,FReplaceText,FFlags,
 966                 fPromptOnReplace,Progress);
 967  finally
 968    fResultsList.EndUpdate;
 969  end;
 970end;
 971
 972procedure TSearchProgressForm.SetFlag(Flag: TSrcEditSearchOption; AValue: boolean);
 973begin
 974  if AValue then
 975    Include(fFlags,Flag)
 976  else
 977    Exclude(fFlags,Flag);
 978end;
 979
 980procedure TSearchProgressForm.DoSearchAndAddToSearchResults;
 981var
 982  ListPage: TTabSheet;
 983  Cnt: integer;
 984  State: TIWGetFormState;
 985begin
 986  Cnt:= 0;
 987  LazarusIDE.DoShowSearchResultsView(iwgfShow);
 988  ListPage:=SearchResultsView.AddSearch(SearchText,SearchText,
 989                            ReplaceText,SearchDirectories,SearchMask,SearchOptions);
 990  try
 991    (* BeginUpdate prevents ListPage from being closed,
 992      other pages can still be closed or inserted, so PageIndex can change *)
 993    SearchResultsView.BeginUpdate(ListPage.PageIndex);
 994    ResultsList:= SearchResultsView.Items[ListPage.PageIndex];
 995    ResultsList.Clear;
 996    ResultsWindow:= ListPage;
 997    try
 998      Show; // floating window, not dockable
 999      Cnt:= DoSearch;
1000    except
1001      on E: ERegExpr do
1002        IDEMessageDialog(lisUEErrorInRegularExpression, E.Message,mtError,
1003                   [mbCancel]);
1004    end;
1005  finally
1006    ListPage.Caption:= Format('%s (%d)',[ListPage.Caption,Cnt]);
1007    SearchResultsView.EndUpdate(ListPage.PageIndex);
1008    // show, but bring to front only if Search Progress dialog was active
1009    if fWasActive then
1010      State:=iwgfShowOnTop
1011    else
1012      State:=iwgfShow;
1013    LazarusIDE.DoShowSearchResultsView(State);
1014  end;
1015end;
1016
1017procedure TSearchProgressForm.DoSearchOpenFiles;
1018var
1019  i: integer;
1020  TheFileList: TStringList;
1021  SrcEdit: TSourceEditorInterface;
1022begin
1023  try
1024    TheFileList:= TStringList.Create;
1025    for i:= 0 to SourceEditorManagerIntf.UniqueSourceEditorCount -1 do
1026    begin
1027      //only if file exists on disk
1028      SrcEdit := SourceEditorManagerIntf.UniqueSourceEditors[i];
1029      if FilenameIsAbsolute(SrcEdit.FileName)
1030      and (not FileExistsCached(SrcEdit.FileName)) then
1031        continue;
1032      TheFileList.Add(SrcEdit.FileName);
1033    end;
1034    SearchFileList:= TheFileList;
1035    DoSearchAndAddToSearchResults;
1036  finally
1037    FreeAndNil(TheFileList);
1038  end;
1039end;
1040
1041procedure TSearchProgressForm.DoSearchActiveFile;
1042var
1043  TheFileList: TStringList;
1044begin
1045  try
1046    TheFileList:= TStringList.Create;      // Add a single file to the list
1047    TheFileList.Add(SourceEditorManagerIntf.ActiveEditor.FileName);
1048    SearchFileList:= TheFileList;
1049    DoSearchAndAddToSearchResults;
1050  finally
1051    FreeAndNil(TheFileList);
1052  end;
1053end;
1054
1055procedure TSearchProgressForm.DoSearchDir;
1056begin
1057  SearchFileList:= Nil;
1058  DoSearchAndAddToSearchResults;
1059end;
1060
1061procedure TSearchProgressForm.DoSearchProject(AProject: TProject);
1062var
1063  AnUnitInfo:  TUnitInfo;
1064  TheFileList: TStringList;
1065begin
1066  try
1067    TheFileList:= TStringList.Create;
1068    AnUnitInfo:=AProject.FirstPartOfProject;
1069    while AnUnitInfo<>nil do begin
1070      //Only if file exists on disk.
1071      if FilenameIsAbsolute(AnUnitInfo.FileName)
1072      and FileExistsCached(AnUnitInfo.FileName) then
1073        TheFileList.Add(AnUnitInfo.FileName);
1074      AnUnitInfo:=AnUnitInfo.NextPartOfProject;
1075    end;
1076    SearchFileList:= TheFileList;
1077    DoSearchAndAddToSearchResults;
1078  finally
1079    FreeAndNil(TheFileList);
1080  end;
1081end;
1082
1083function TSearchProgressForm.PadAndShorten(FileName: string): string;
1084var
1085  FoundAt: integer;
1086begin
1087  FoundAt:= System.Pos(PathDelim,FileName);
1088  if FoundAt<1 then begin
1089    Result := Filename;
1090  end else begin
1091    Result:= fPad + copy(FileName,FoundAt+1,Length(FileName));
1092  end;
1093end;//PadAndShorten
1094
1095end.
1096