grepresultsdlg.~pas

Delphi编写的一个支持语法高亮显示和很多语言的文本编辑器

{***************************************************************
 *
 * Unit Name   : GrepResultsDlg
 * Date        :
 * Purpose     : Grep Search Result Dialog
 * Copyright   : This Source Code is taken from GExperts, the excellent
 * 			     Delphi/C++Builder add-on available from GExperts.org.
 *				 Please see the file gexpertslicense.html for the license.
 *				 Any modifications from the original are copyright Echo
 *				 Software.
 * History     :
 *       2000-02-19 MBCS Support
 *               29/05/2000 Moved button code into actions, and
 *               replaced speedbuttons with Toolbar97 buttons.
 *
 ****************************************************************}

unit GrepResultsDlg;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls,  SearchFile, ComCtrls, Registry,
  ActnList, ImgList, ToolWin, Menus, DropSource, fDoc, DockPanel;

type
  TGrepAction = (gaAllFilesGrep, gaCurrentOnlyGrep, gaOpenFilesGrep, gaDirGrep);

  TSearchResult = class(TCollectionItem)
  private
    FLine: string;
    FLineNo: Integer;
    FSPos: Integer;
    FEPos: Integer;
  published
    property Line: string read FLine write FLine;
    property LineNo: Integer read FLineNo write FLineNo;
    property SPos: Integer read FSPos write FSPos;
    property EPos: Integer read FEPos write FEPos;
  end;

  TSearchResults = class(TCollection)
  private
    FExpanded: Boolean;
    FFileName: string;
    function GetItem(Index: Integer): TSearchResult;
    procedure SetItem(Index: Integer; Value: TSearchResult);
  public
    constructor Create;
    function Add: TSearchResult;
    property Expanded: Boolean read FExpanded write FExpanded;
    property FileName: string read FFileName write FFileName;
    property Items[Index: Integer]: TSearchResult read GetItem write SetItem; default;
  end;

  // Saved grep settings (used for refresh)
  TGrepSettings = packed record
    NoComments,
      NoCase,
      WholeWord,
      RegEx,
      IncludeSubdirs: Boolean;
    Directory,
      Mask,
      Pattern: string;
    GrepAction: TGrepAction;
    CanRefresh: Boolean;
  end;

  TfrmGrepResults = class(TDockableForm)
    StatusBar: TStatusBar;
    dlgGrepFont: TFontDialog;
    lbResults: TListBox;
    alsGrep: TActionList;
    actGrep: TAction;
    actRefresh: TAction;
    actAbort: TAction;
    actGotoLine: TAction;
    actPrint: TAction;
    actContract: TAction;
    actExpand: TAction;
    actFont: TAction;
    actGrepReplace: TAction;
    popGrepResults: TPopupMenu;
    ClearResults1: TMenuItem;
    N1: TMenuItem;
    Hide1: TMenuItem;
    actClear: TAction;
    actHide: TAction;
    ilsGrep: TImageList;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    procedure btnCloseClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure lbResultsMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lbResultsKeyPress(Sender: TObject; var Key: Char);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure lbResultsDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure lbResultsMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lbResultsMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure mnuRefreshClick(Sender: TObject);
    procedure FormDockDrop(Sender: TObject; Source: TDragDockObject; X,
      Y: Integer);
    procedure SpeedButton1Click(Sender: TObject);
    procedure actGrepExecute(Sender: TObject);
    procedure actRefreshExecute(Sender: TObject);
    procedure actAbortExecute(Sender: TObject);
    procedure actGotoLineExecute(Sender: TObject);
    procedure actPrintExecute(Sender: TObject);
    procedure actContractExecute(Sender: TObject);
    procedure actExpandExecute(Sender: TObject);
    procedure actFontExecute(Sender: TObject);
    procedure actClearExecute(Sender: TObject);
    procedure lbResultsDblClick(Sender: TObject);
    procedure MakeVisible;
    procedure ClearResults1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    Total: Integer;
    DragSource: TDropFileSource; //DropSource; //FileSource;
    DragPoint: TPoint;
    {tran: TvgTranslator;}
    procedure Foundit(Sender: TObject; LineNo: Integer; Line: string; SPos, EPos: Integer);
    procedure StartSearch(Sender: TObject);
    procedure SaveSettings;
    procedure LoadSettings;
    procedure ExpandContract(n: Integer);
    procedure ResizeListBox;
  protected
    procedure WMExitSizeMove(var Message: TMessage); message WM_EXITSIZEMOVE;
  public
    GrepSettings: TGrepSettings;
    SAbort: Boolean;
    Searching: Boolean;
    OpenFiles: Boolean;
    Results: TSearchResults;
    Searcher: TSearcher;
    FileCount: Integer;
    IsDocked: Boolean;
    procedure Execute(Refresh: Boolean); overload;
    procedure Execute(Refresh: Boolean; SString : String); overload;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Loaded; override;
  end;

var
  frmGrepResults: TfrmGrepResults = nil;

const
  secGrepResult = 'GrepResult';
  SProcessing              = 'Processing: ';
  SNoFileOpen              = 'No file is currently open.';
  SGrepActive              = 'A Grep search is currently active; either abort it or wait until it is finished.';
  SGrepStatistics          = '%d files in %g seconds';
  SMatches                 = ' matches';
  SCouldNotOpenFile        = 'Could not open file:';
  SItemMatches             = 'Matches: ';

procedure SaveFont(Reg: TRegistry; Font: TFont);
procedure LoadFont(Reg: TRegistry; Font: TFont);

implementation

{$R *.DFM}

uses
  GrepSearchDlg,
  {main,} fMain,
  ShellAPI, dMain;

procedure SaveFont(Reg: TRegistry; Font: TFont);
begin
  with Reg do
  begin
    // Do not localize any of the following strings
    WriteString('Name', Font.Name);
    WriteInteger('Size', Font.Size);
    WriteBool('Bold', (fsBold in Font.Style));
    WriteBool('Italic', (fsItalic in Font.Style));
    WriteBool('Underline', (fsUnderline in Font.Style));
  end;
end;

procedure LoadFont(Reg: TRegistry; Font: TFont);
begin
  with Reg do
  begin
    // Do not localize any of the following strings
    Try
      Font.Name := ReadString('Name');
      Font.Size := ReadInteger('Size');
      if ReadBool('Bold') then
        Font.Style := Font.Style + [fsBold];
      if ReadBool('Italic') then
        Font.Style := Font.Style + [fsItalic];
      if ReadBool('Underline') then
        Font.Style := Font.Style + [fsUnderLine];
    Except
      Font.Name := 'MS Sans Serif';
      Font.Size := 8;
      Font.Style := [];
    end;
  end;
end;

function MyTrim(var st: string): Integer;
begin
  Result := 0;
  while (Length(st) > 0) and (st[1] in [#9, #32]) do
  begin
    Delete(st, 1, 1);
    Inc(Result);
  end;
end;

constructor TSearchResults.Create;
begin
  inherited Create(TSearchResult);
end;

function TSearchResults.Add: TSearchResult;
begin
  Result := TSearchResult(inherited Add);
end;

function TSearchResults.GetItem(Index: Integer): TSearchResult;
begin
  Result := TSearchResult(inherited GetItem(Index));
end;

procedure TSearchResults.SetItem(Index: Integer; Value: TSearchResult);
begin
  inherited SetItem(Index, Value);
end;

procedure TfrmGrepResults.btnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmGrepResults.StartSearch(Sender: TObject);
begin
  StatusBar.Panels.Items[0].Text := SProcessing{tran.TMsg(SProcessing)} + Searcher.FileName;
  StatusBar.Repaint;
end;

procedure TfrmGrepResults.Foundit(Sender: TObject; LineNo: Integer; Line: string; SPos, EPos: Integer);
var
  AResult: TSearchResult;
begin
  Application.ProcessMessages;
  Inc(Total);
  if (Results = nil) or (Results.FileName <> Searcher.FileName) then
  begin
    Results := TSearchResults.Create;
    Results.FileName := Searcher.FileName;
    lbResults.Items.AddObject(Searcher.FileName, Results);
  end;
  AResult := Results.Add;
  AResult.Line := Line;
  AResult.LineNo := LineNo;
  AResult.SPos := SPos;
  AResult.EPos := EPos;
end;

procedure TfrmGrepResults.Execute(Refresh: Boolean);
begin
  if Searching then
  begin
    MessageDlg(SGrepActive{tran.TMsg(SGrepActive)}, mtInformation, [mbOK], 0);
    Exit;
  end;
  Execute(Refresh, '');
end;

procedure TfrmGrepResults.Execute(Refresh: Boolean; SString : String);
var
  Dlg: TfrmGrepSearch;
  SStart: Integer;
  SEnd: Integer;

  procedure CurrentOnlyGrep;
  var
    CurrentFile  : string;
    fEditor      : tfrmDoc;
  begin
    Results := nil;
    fEditor := frmMain.GetCurrentEditor;
    if Assigned(fEditor) then
      CurrentFile := fEditor.FileName;
    if CurrentFile <> '' then
    begin
      Searcher.FileName := CurrentFile;
      Searcher.Execute;
      Inc(FileCount);
    end
    else
      MessageDlg(SNoFileOpen{tran.TMsg(SNoFileOpen)}, mtError, [mbOK], 0);
  end;

  procedure AllFilesGrep;
  var
    I: Integer;
  begin
    if OpenFiles then
      with frmMain do
      begin //Current Open Files in Editor.
        for I := 0 to frmMain.MDIChildCount - 1 do
        begin
          if TfrmDOc(i).FileName = '' then continue;
          Searcher.FileName := TfrmDoc(i).FileName;
          Searcher.Execute;
          Inc(FileCount);
          if SAbort then Break;
        end;
      end
  end;

  procedure DirGrep(Dir, Mask: string);
  var
    Search: TSearchRec;
    Result: Integer;
    S: TStringList;
    i: Integer;
  begin
    if dir[Length(dir)] <> '\' then Dir := Dir + '\';
    S := TStringList.Create;
    try
      for i := 1 to Length(Mask) do
        if Mask[i] in [';', ','] then
          Mask[i] := #13;

      S.Text := Mask;

      { First do sub-directories if option is selected }
      if GrepSettings.IncludeSubdirs then
      begin
        Result := FindFirst(Dir + '*.*', faAnyFile, Search);
        try
          while Result = 0 do
          begin
            if (Search.Attr and faDirectory) <> 0 then
            begin
              if (Search.Name <> '.') and (Search.Name <> '..') then
                DirGrep(Dir + Search.Name, Mask);
            end;
            Result := FindNext(Search);
          end;
        finally
          FindClose(Search);
        end;
      end;

      for i := 0 to S.Count - 1 do
      begin
        Result := FindFirst(Dir + Trim(S.Strings[i]), faAnyFile, Search);
        try
          while Result = 0 do
          begin
            if (Search.Attr and faDirectory) <> 0 then
            begin
              Result := FindNext(Search);
            end
            else
            begin
              Results := nil;
              Searcher.FileName := Dir + Search.Name;
              Searcher.Execute;

              Application.ProcessMessages;
              if SAbort then Break;

              Inc(FileCount);
              Result := FindNext(Search);
            end;
          end;
        finally
          FindClose(Search);
        end;
      end;
    finally
      S.Free;
    end;
  end;
var
  GrepANSI: Boolean;
begin
  GrepANSI := False;
  //! StH: This code needs some cleanup attention


  if not (Refresh and GrepSettings.CanRefresh) then
  begin
    Dlg := TfrmGrepSearch.Create(nil);
    try
      Dlg.cbText.Text := SString;
      if Dlg.ShowModal <> mrOk then
        Exit;

        // Save Dialog settings to local vars
      GrepSettings.NoComments := Dlg.chkNoComments.Checked;
      GrepSettings.NoCase := Dlg.chkNoCase.Checked;
      GrepSettings.WholeWord := Dlg.chkWholeWord.Checked;
      GrepSettings.RegEx := Dlg.chkRegEx.Checked;
      GrepSettings.Pattern := Dlg.cbText.Text;
      GrepSettings.Directory := Dlg.cbDirectory.Text;
      if GrepSettings.Pattern = '' then exit;
      GrepSettings.IncludeSubdirs := Dlg.chkInclude.Checked;
      if Dlg.rbAllFiles.Checked then
        GrepSettings.GrepAction := gaAllFilesGrep
      else if Dlg.rbCurrentOnly.Checked then
        GrepSettings.GrepAction := gaCurrentOnlyGrep
      else if Dlg.rbOpenFiles.Checked then
        GrepSettings.GrepAction := gaOpenFilesGrep
      else
      begin
        GrepSettings.Directory := Dlg.cbDirectory.Text;
        if GrepSettings.Directory = '' then exit;
        GrepSettings.Mask := Dlg.cbMasks.Text;
        GrepSettings.GrepAction := gaDirGrep;
      end;
      GrepSettings.CanRefresh := True;
      GrepANSI := Dlg.chkGrepANSI.Checked;
    finally
      Dlg.Free;
    end;
  end;

  try
    Searching := True;
    Visible := True;
    FormResize(Self);
    Total := 0;
    FileCount := 0;
    SAbort := False;
    OpenFiles := False;

    actGrep.Enabled := False;
    actRefresh.Enabled := False;
    actPrint.Enabled := False;
    actGotoLine.Enabled := False;
    actExpand.Enabled := False;
    actContract.Enabled := False;
    actFont.Enabled := False;
    actAbort.Enabled := True;

    SStart := GetTickCount;
    Self.Cursor := crHourglass;
    Searcher := TSearcher.Create('');
    try
      Searcher.BufSize := 30000;
      Searcher.OnFound := FoundIt;
      Searcher.OnStartSearch := StartSearch;

      Searcher.NoComments := GrepSettings.NoComments;
      if GrepSettings.NoCase then
        Searcher.SearchOptions := [soCaseSensitive];
      if GrepSettings.WholeWord then
        Searcher.SearchOptions := Searcher.SearchOptions + [soWholeWord];
      if GrepSettings.RegEx then
        Searcher.SearchOptions := Searcher.SearchOptions + [soRegEx];
      Searcher.ANSICompatible := GrepANSI;

      lbResults.Clear;
      Searcher.SetPattern(GrepSettings.Pattern);

      Application.ProcessMessages;
      case GrepSettings.GrepAction of
        gaAllFilesGrep: AllFilesGrep;
        gaCurrentOnlyGrep: CurrentOnlyGrep;
        gaOpenFilesGrep:
          begin
            OpenFiles := True;
            AllFilesGrep;
          end;
        gaDirGrep:
          begin
            if Length(Trim(GrepSettings.Mask)) = 0 then
              DirGrep(GrepSettings.Directory, '*.pas')
            else
              DirGrep(GrepSettings.Directory, UpperCase(GrepSettings.Mask));
          end;
      end; // end case
    finally
      Searching := False;

      SEnd := GetTickCount;
      Searcher.Free;
      Self.Cursor := crDefault;

      StatusBar.Panels.Items[0].Text := Format(SGrepStatistics{tran.TMsg(SGrepStatistics)}, [FileCount, (SEnd - SStart) / 1000]);

      lbResults.Refresh;
      lbResults.Sorted := True;
      lbResults.Sorted := False;
      if lbResults.Items.Count = 1 then
      begin
        lbResults.ItemIndex := 0;
        actExpandExecute(actExpand);
      end;
    end;
  finally
    actPrint.Enabled := True;
    actGrep.Enabled := True;
    actRefresh.Enabled := True;
    actExpand.Enabled := True;
    actContract.Enabled := True;
    actFont.Enabled := True;
    actGotoLine.Enabled := True;
    actAbort.Enabled := False;
  end;
  StatusBar.Panels.Items[1].Text := IntToStr(Total) + SMatches{tran.TMsg(SMatches)};
  //frmGrepResults.ManualDock(frmMain.panBottomDock);
end;

procedure TfrmGrepResults.lbResultsMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);