294 lines
9.1 KiB
ObjectPascal
294 lines
9.1 KiB
ObjectPascal
{
|
|
********************************************************************************
|
|
|
|
SPackGui
|
|
Copyright (C) 2012-2013 Geoffray Levasseur <geoffray.levasseurbrandin@numericable.fr>.
|
|
Copyright (C) <date> <add your name and mail address here>
|
|
|
|
http://www.geoffray-levasseur.org/
|
|
http://0.tuxfamilly.org/
|
|
|
|
This software is governed by the CeCILL license under French law and
|
|
abiding by the rules of distribution of free software. You can use,
|
|
modify and/ or redistribute the software under the terms of the CeCILL
|
|
license as circulated by CEA, CNRS and INRIA at the following URL
|
|
"http://www.cecill.info".
|
|
|
|
As a counterpart to the access to the source code and rights to copy,
|
|
modify and redistribute granted by the license, users are provided only
|
|
with a limited warranty and the software's author, the holder of the
|
|
economic rights, and the successive licensors have only limited
|
|
liability.
|
|
|
|
In this respect, the user's attention is drawn to the risks associated
|
|
with loading, using, modifying and/or developing or reproducing the
|
|
software by the user in light of its specific status of free software,
|
|
that may mean that it is complicated to manipulate, and that also
|
|
therefore means that it is reserved for developers and experienced
|
|
professionals having in-depth computer knowledge. Users are therefore
|
|
encouraged to load and test the software's suitability as regards their
|
|
requirements in conditions enabling the security of their systems and/or
|
|
data to be ensured and, more generally, to use and operate it in the
|
|
same conditions as regards security.
|
|
|
|
The fact that you are presently reading this means that you have had
|
|
knowledge of the CeCILL license and that you accept its terms.
|
|
|
|
********************************************************************************
|
|
|
|
Description:
|
|
search dialog
|
|
|
|
}
|
|
unit frmSearch;
|
|
|
|
{$mode objfpc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
|
Buttons, ComCtrls, uCommon, uSpackPackage;
|
|
|
|
type
|
|
|
|
{ TfSearch }
|
|
|
|
TfSearch = class(TForm)
|
|
btnClose: TBitBtn;
|
|
btnSearch: TBitBtn;
|
|
btnRegExprHelp: TButton;
|
|
cbxSearch: TComboBox;
|
|
ckbToUpgrade: TCheckBox;
|
|
ckbNotInstalle: TCheckBox;
|
|
ckbInstalled: TCheckBox;
|
|
ckbDescription: TCheckBox;
|
|
ckbPackageName: TCheckBox;
|
|
ckbWholeWord: TCheckBox;
|
|
ckbCaseSensitive: TCheckBox;
|
|
ckbRegExpr: TCheckBox;
|
|
gbOptions: TGroupBox;
|
|
gbWhere: TGroupBox;
|
|
lbSearch: TLabel;
|
|
procedure btnCloseClick(Sender: TObject);
|
|
procedure btnRegExprHelpClick(Sender: TObject);
|
|
procedure btnSearchClick(Sender: TObject);
|
|
procedure cbxSearchChange(Sender: TObject);
|
|
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure lvSearchResultChange(Sender: TObject; Item: TListItem; Change: TItemChange);
|
|
procedure lvSearchResultColumnClick(Sender: TObject; Column: TListColumn);
|
|
procedure lvSearchResultCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
|
|
private
|
|
{ private declarations }
|
|
FSearchTerms: TStringList;
|
|
FLastSortedColumn: Integer;
|
|
FAscending: Boolean;
|
|
procedure ParseString(const Str: string);
|
|
procedure SearchTerm(const Pkg: TSPackPackage);
|
|
function TestField(const ASearch, AField: string): Boolean;
|
|
public
|
|
{ public declarations }
|
|
end;
|
|
|
|
var
|
|
fSearch: TfSearch;
|
|
|
|
implementation
|
|
|
|
uses
|
|
LCLType, uStrings, frmMain, uIconManager, uDebug;
|
|
|
|
{$R *.lfm}
|
|
|
|
{ TfSearch }
|
|
|
|
procedure TfSearch.ParseString(const Str: string);
|
|
var
|
|
I, N: Integer;
|
|
InBrace: Boolean;
|
|
begin
|
|
if Length(Str) < 1 then
|
|
Exit; //cannot parse an empty string
|
|
FSearchTerms.Clear;
|
|
N := FSearchTerms.Add('');
|
|
InBrace := False;
|
|
for I := 1 to Length(Str) do
|
|
begin
|
|
if (Str[I] = '"') and ckbRegExpr.Checked then
|
|
begin
|
|
InBrace := not InBrace;
|
|
Continue;
|
|
end;
|
|
if (Str[I] = ' ') and (not InBrace) then
|
|
if FSearchTerms[N] <> '' then //in case of several successive spaces
|
|
N := FSearchTerms.Add('')
|
|
else
|
|
else
|
|
FSearchTerms[N] := FSearchTerms[N] + Str[I];
|
|
end;
|
|
end;
|
|
|
|
function TfSearch.TestField(const ASearch, AField: string): Boolean;
|
|
var
|
|
N: Integer;
|
|
begin
|
|
N := Pos(ASearch, AField);
|
|
if N <> 0 then
|
|
begin //many if so begin is put to clarify even if it's not needed
|
|
if ckbWholeWord.Checked then
|
|
begin
|
|
//we use if here as in those statement the second term is not evaluated
|
|
//when the first one is set to false : we can't have a range check error
|
|
//as the second test is done only if the first one return true
|
|
//if we use Result := test1 and test2 both tests are alwais evaluated and
|
|
//will result in range checking error in some cases (match at end or
|
|
//beginning of a string)
|
|
if (N + Length(ASearch) <= Length(AField)) and
|
|
(AField[N + Length(ASearch)] <> ' ') then
|
|
Result := False
|
|
else
|
|
if (N > 1) and (AField[N - 1] <> ' ') then
|
|
Result := False
|
|
else
|
|
Result := True;
|
|
end else
|
|
Result := True;
|
|
end else
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TfSearch.SearchTerm(const Pkg: TSPackPackage);
|
|
begin
|
|
//do it
|
|
end;
|
|
|
|
procedure TfSearch.btnRegExprHelpClick(Sender: TObject);
|
|
begin
|
|
Application.MessageBox(PChar(rsRegExprHelp), PChar(rsHelp),
|
|
MB_ICONINFORMATION + MB_OK);
|
|
end;
|
|
|
|
procedure TfSearch.btnSearchClick(Sender: TObject);
|
|
var
|
|
I: integer;
|
|
begin
|
|
cbxSearch.Items.Add(cbxSearch.Text);
|
|
if Trim(cbxSearch.Text) = '' then
|
|
Exit;
|
|
Cursor := crHourGlass;
|
|
ParseString(Trim(cbxSearch.Text)); //put each term in a stringlist
|
|
if ckbRegExpr.Checked and ((Trim(FSearchTerms[0])[1] in RegExprOperator) or
|
|
(Trim(FSearchTerms[FSearchTerms.Count - 1])[1] in RegExprOperator)) then
|
|
begin
|
|
MessageDlg(rsErrorSearchSynthax, mtError, [MBOK], 0);
|
|
Exit;
|
|
end;
|
|
try
|
|
for I := 0 to fMain.PackageList.Count - 1 do
|
|
begin
|
|
Application.ProcessMessages;
|
|
SearchTerm(fMain.PackageList.Packages[I]);
|
|
end;
|
|
//Sort(lvSearchResult, 0, False);
|
|
finally
|
|
Cursor := crArrow;
|
|
end;
|
|
end;
|
|
|
|
procedure TfSearch.cbxSearchChange(Sender: TObject);
|
|
begin
|
|
btnSearch.Enabled := (ckbPackageName.Checked or ckbDescription.Checked) and
|
|
(Trim(cbxSearch.Text) <> '');
|
|
end;
|
|
|
|
procedure TfSearch.FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
try
|
|
SaveWindowGeometry(Self);
|
|
IniWriteStrings(iniMain, Self.Name, rsConfNameFindHistory, cbxSearch.Items);
|
|
except
|
|
PrintLnDbg(rsErrorCannotSaveConf, vlLow);
|
|
end;
|
|
end;
|
|
|
|
procedure TfSearch.FormCreate(Sender: TObject);
|
|
begin
|
|
FSearchTerms := TStringList.Create;
|
|
btnSearch.Enabled := False;
|
|
//next line is needed because of different metrics with fonts and/or widget sets
|
|
{$IFDEF LCLGTK2 OR $IFDEF LCLGTK3}
|
|
btnRegExprHelp.Left := ckbRegExpr.Left + ckbRegExpr.Width + 1;
|
|
btnRegExprHelp.Top := ckbRegExpr.Top;
|
|
btnRegExprHelp.Height := ckbRegExpr.Height;
|
|
{$ENDIF}
|
|
{$IFDEF LCLQT OR $IFDEF LCLQT5}
|
|
btnRegExprHelp.Left := ckbRegExpr.Left + ckbRegExpr.Width + 21;
|
|
btnRegExprHelp.Top := ckbRegExpr.Top + 1;
|
|
btnRegExprHelp.Height := ckbRegExpr.Height + 1;
|
|
{$ENDIF} //other widget sets not tested so left as designed
|
|
btnRegExprHelp.Width := ckbRegExpr.Height;
|
|
btnSearch.Tag := icSearch;
|
|
btnClose.Tag := icClose;
|
|
InitBtnGlyphs(Self);
|
|
cbxSearch.Text := '';
|
|
LoadWindowGeometry(Self);
|
|
IniReadStrings(iniMain, Self.Name, rsConfNameFindHistory, cbxSearch.Items);
|
|
ckbPackageName.Checked := True;
|
|
ckbDescription.Checked := True;
|
|
ckbInstalled.Checked := True;
|
|
ckbNotInstalle.Checked := True;
|
|
ckbToUpgrade.Checked := True;
|
|
end;
|
|
|
|
procedure TfSearch.FormDestroy(Sender: TObject);
|
|
begin
|
|
try
|
|
FSearchTerms.Free;
|
|
finally
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
procedure TfSearch.lvSearchResultChange(Sender: TObject; Item: TListItem; Change: TItemChange);
|
|
begin
|
|
end;
|
|
|
|
procedure TfSearch.lvSearchResultColumnClick(Sender: TObject;
|
|
Column: TListColumn);
|
|
begin
|
|
TListView(Sender).SortType := stNone;
|
|
if Column.Index = FLastSortedColumn then
|
|
FAscending := not FAscending
|
|
else
|
|
FLastSortedColumn := Column.Index;
|
|
TListView(Sender).SortColumn := Column.Index;
|
|
TListView(Sender).SortType := stData;
|
|
end;
|
|
|
|
procedure TfSearch.lvSearchResultCompare(Sender: TObject;
|
|
Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
|
|
begin
|
|
case FLastSortedColumn of
|
|
0: Compare := AnsiCompareText(Item1.Caption, Item2.Caption);
|
|
1: Compare := CompareVersion(Item1.SubItems[0], Item2.SubItems[0]);
|
|
2: Compare := CompareVersion(Item1.SubItems[1], Item2.SubItems[1]);
|
|
3: Compare := fMain.CompareSize(Item1.SubItems[2], Item2.SubItems[2]);
|
|
4: Compare := fMain.CompareSize(Item1.SubItems[3], Item2.SubItems[3]);
|
|
5: Compare := AnsiCompareText(Item1.SubItems[4], Item2.SubItems[4]);
|
|
end;
|
|
if not FAscending then
|
|
Compare := -Compare;
|
|
end;
|
|
|
|
procedure TfSearch.btnCloseClick(Sender: TObject);
|
|
begin
|
|
Close;
|
|
end;
|
|
|
|
end.
|
|
|