[lazarus] Search results windows patch

Jason King pizza at netspace.net.au
Fri Nov 7 23:53:06 EST 2003


(and its probably got my earlier patch in it too , sorry about that)

this implements the search results window.  If you do "Find in Files" ,
"search all open files" you will get a list of search results for your
text.  It only lists the first result in each file , not all of them so
far.  clicking on the entry in the search result window jumps to that
line in the file.

no doubt needs more work to make it less annoying , but its a start I
guess.  Still need to do notebook for several results , and search again
button.

searchresultview.pp is a blatent copy of messageview.pp 

-- 
I had a guaranteed military sale with ed 209, renovation program,
spare parts for 25 years. Who cares if it worked or not?

Dick Jones , Robocop.



lazarus.diff.gz

{
 /***************************************************************************
                       searchresultviewView.pp - SearchResult view
                           ----------------------------------
                   TSearchResultsView is responsible for displaying the
                   Search Results of a find operation.


                   Initial Revision  : Sat Nov 8th 2003


 ***************************************************************************/

 ***************************************************************************
 *                                                                         *
 *   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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 *                                                                         *
 ***************************************************************************
}
unit searchresultview;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Controls, StdCtrls, Forms, LResources, IDEProcs,
  IDEOptionDefs, EnvironmentOpts, LazarusIDEStrConsts;

type
  TSearchResultsView = class(TForm)
    SearchResultView : TListBox;
    procedure SearchResultViewDblClicked(Sender: TObject);
    Procedure SearchResultViewClicked(sender : TObject);
  private
    FDirectories: TStringList;
    FLastLineIsProgress: boolean;
    FOnSelectionChanged: TNotifyEvent;
    function GetDirectory: string;
    Function GetSearchResult: String;
    procedure SetLastLineIsProgress(const AValue: boolean);
  protected
    fBlockCount: integer;
    Function GetSelectedLineIndex: Integer;
    procedure SetSelectedLineIndex(const AValue: Integer);
    procedure SetMsgDirectory(Index: integer; const CurDir: string);
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure Add(const Msg, CurDir: String; ProgressLine: boolean);
    procedure AddMsg(const Msg, CurDir: String);
    procedure AddProgress(const Msg, CurDir: String);
    procedure AddSeparator;
    procedure ClearTillLastSeparator;
    procedure ShowTopSearchResult;
    function MsgCount: integer;
    procedure Clear;
    procedure GetSearchResultAt(Index: integer; var Msg, MsgDirectory: string);
    procedure BeginBlock;
    procedure EndBlock;
  public
    property LastLineIsProgress: boolean read FLastLineIsProgress
                                         write SetLastLineIsProgress;
    property SearchResult: String read GetSearchResult;
    property Directory: string read GetDirectory;
    property SelectedSearchResultIndex: Integer read GetSelectedLineIndex
                                           write SetSelectedLineIndex;
    property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged
                                              write FOnSelectionChanged;
  end;

var
  SearchResultsView: TSearchResultsView;


implementation

const SeparatorLine = '---------------------------------------------';

{ TSearchResultsView }


{------------------------------------------------------------------------------
  TSearchResultsView.Create
------------------------------------------------------------------------------}
constructor TSearchResultsView.Create(TheOwner : TComponent);
var ALayout: TIDEWindowLayout;
Begin
  inherited Create(TheOwner);
  if LazarusResources.Find(ClassName)=nil then begin
    Caption:=lisMenuViewSearchResults;
    SearchResultView := TListBox.Create(Self);
    With SearchResultView do Begin
      Parent:= Self;
      Align:= alClient;
    end;
  end;
  Name := NonModalIDEWindowNames[nmiwSearchResultsViewName];
  ALayout:=EnvironmentOptions.IDEWindowLayoutList.
                                               ItemByEnum(nmiwSearchResultsViewName);
  ALayout.Form:=TForm(Self);
  ALayout.Apply;
end;

destructor TSearchResultsView.Destroy;
begin
  FreeAndNil(FDirectories);
  inherited Destroy;
end;

{------------------------------------------------------------------------------
  TSearchResultsView.Add
------------------------------------------------------------------------------}
Procedure TSearchResultsView.Add(const Msg, CurDir: String; ProgressLine: boolean);
var
  i: Integer;
Begin
  if FLastLineIsProgress then begin
    SearchResultView.Items[SearchResultView.Items.Count-1]:=Msg;
  end else begin
    SearchResultView.Items.Add(Msg);
  end;
  FLastLineIsProgress:=ProgressLine;
  i:=SearchResultView.Items.Count-1;
  SetMsgDirectory(i,CurDir);
  SearchResultView.TopIndex:=SearchResultView.Items.Count-1;
end;

procedure TSearchResultsView.AddMsg(const Msg, CurDir: String);
begin
  Add(Msg,CurDir,false);
end;

procedure TSearchResultsView.AddProgress(const Msg, CurDir: String);
begin
  Add(Msg,CurDir,true);
end;

Procedure TSearchResultsView.AddSeparator;
begin
  Add(SeparatorLine,'',false);
end;

procedure TSearchResultsView.ClearTillLastSeparator;
var LastSeparator: integer;
begin
  with SearchResultView do begin
    LastSeparator:=Items.Count-1;
    while (LastSeparator>=0) and (Items[LastSeparator]<>SeparatorLine) do
      dec(LastSeparator);
    if LastSeparator>=0 then begin
      while (Items.Count>LastSeparator) do
        Items.Delete(Items.Count-1);
      FLastLineIsProgress:=false;
    end;
  end;
end;

procedure TSearchResultsView.ShowTopSearchResult;
begin
  if SearchResultView.Items.Count>0 then
    SearchResultView.TopIndex:=0;
end;

function TSearchResultsView.MsgCount: integer;
begin
  Result:=SearchResultView.Items.Count;
end;

{------------------------------------------------------------------------------
  TSearchResultsView.Clear
------------------------------------------------------------------------------}
Procedure  TSearchResultsView.Clear;
Begin
  if fBlockCount>0 then exit;
  SearchResultView.Clear;
  FLastLineIsProgress:=false;
  if not Assigned(SearchResultsView.SearchResultView.OnClick) then
    SearchResultView.OnClick := @SearchResultViewClicked;
  if not Assigned(SearchResultsView.SearchResultView.OnDblClick) then
    SearchResultView.OnDblClick :=@SearchResultViewDblClicked;
end;

procedure TSearchResultsView.GetSearchResultAt(Index: integer;
  var Msg, MsgDirectory: string);
begin
  // consistency checks
  if (Index<0) then
    RaiseException('TSearchResultsView.GetSearchResultAt');
  if SearchResultView.Items.Count<=Index then
    RaiseException('TSearchResultsView.GetSearchResultAt');
  if (FDirectories=nil) then
    RaiseException('TSearchResultsView.GetSearchResultAt');
  if (FDirectories.Count<=Index) then
    RaiseException('TSearchResultsView.GetSearchResultAt');
  Msg:=SearchResultView.Items[Index];
  MsgDirectory:=FDirectories[Index];
end;

procedure TSearchResultsView.BeginBlock;
begin
  Clear;
  inc(fBlockCount);
end;

procedure TSearchResultsView.EndBlock;
begin
  if fBlockCount<=0 then RaiseException('TSearchResultsView.EndBlock Internal Error');
  dec(fBlockCount);
end;

{------------------------------------------------------------------------------
  TSearchResultsView.GetSearchResult
------------------------------------------------------------------------------}
Function TSearchResultsView.GetSearchResult: String;
Begin
  Result := '';
  if (SearchResultView.Items.Count > 0) and (SearchResultView.SelCount > 0) then
    Result := SearchResultView.Items.Strings[GetSelectedLineIndex];
end;

procedure TSearchResultsView.SearchResultViewDblClicked(Sender: TObject);
begin
  if not EnvironmentOptions.MsgViewDblClickJumps then exit;
  if (SearchResultView.Items.Count > 0) and (SearchResultView.SelCount > 0) then Begin
    If Assigned(OnSelectionChanged) then
      OnSelectionChanged(self);
  end;
end;

Procedure TSearchResultsView.SearchResultViewClicked(sender : TObject);
begin
  if EnvironmentOptions.MsgViewDblClickJumps then exit;
  if (SearchResultView.Items.Count > 0) and (SearchResultView.SelCount > 0) then Begin
    If Assigned(OnSelectionChanged) then
      OnSelectionChanged(self);
  end;
end;

function TSearchResultsView.GetDirectory: string;
var
  i: Integer;
begin
  Result := '';
  i:=GetSelectedLineIndex;
  if (FDirectories<>nil) and (FDirectories.Count>i) then
    Result := FDirectories[i];
end;

Function TSearchResultsView.GetSelectedLineIndex : Integer;
var
  I : Integer;
Begin
  Result := -1;
  if (SearchResultView.Items.Count > 0) and (SearchResultView.SelCount > 0) then Begin
    for i := 0 to SearchResultView.Items.Count-1 do
    Begin
      if SearchResultView.Selected[I] then
        Begin
	  Result := I;
          Break;
        end;
    end;
  end;
end;

procedure TSearchResultsView.SetLastLineIsProgress(const AValue: boolean);
begin
  if FLastLineIsProgress=AValue then exit;
  if FLastLineIsProgress then
    SearchResultView.Items.Delete(SearchResultView.Items.Count-1);
  FLastLineIsProgress:=AValue;
end;

procedure TSearchResultsView.SetSelectedLineIndex(const AValue: Integer);
begin
  SearchResultView.ItemIndex:=AValue;
  SearchResultView.TopIndex:=SearchResultView.ItemIndex;
end;

procedure TSearchResultsView.SetMsgDirectory(Index: integer; const CurDir: string);
begin
  if FDirectories=nil then FDirectories:=TStringList.Create;
  while FDirectories.Count<=Index do FDirectories.Add('');
  FDirectories[Index]:=CurDir;
end;

initialization
  SearchResultsView:=nil;
  { $I msgview.lrs}


end.

-------------- next part --------------
A non-text attachment was scrubbed...
Name: gz00043.gz
Type: application/octet-stream
Size: 7085 bytes
Desc: ""
Url : http://localhost/pipermail/lazarus/attachments/20031107/2375e2c0/gz00043.obj


More information about the Lazarus mailing list