initial commit from lost SVN repo
This commit is contained in:
fatalerrors
791
spackgui/frmmain.pas
Normal file
791
spackgui/frmmain.pas
Normal file
@@ -0,0 +1,791 @@
|
||||
{
|
||||
********************************************************************************
|
||||
|
||||
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:
|
||||
main window and program functionnalities
|
||||
|
||||
********************************************************************************
|
||||
}
|
||||
unit frmMain;
|
||||
|
||||
{$include ../common/defines.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Buttons,
|
||||
Menus, ExtCtrls, CheckLst, ComCtrls, ActnList, uPackageManager, frmProgress,
|
||||
StdCtrls;
|
||||
|
||||
type
|
||||
|
||||
{ TfMain }
|
||||
|
||||
TfMain = class(TForm)
|
||||
acActionList: TActionList;
|
||||
acFileOpen: TAction;
|
||||
acFileSave: TAction;
|
||||
acFileSaveAll: TAction;
|
||||
acFileShowLog: TAction;
|
||||
acFileExit: TAction;
|
||||
acEditCancel: TAction;
|
||||
acEditApply: TAction;
|
||||
acEditSearch: TAction;
|
||||
acEditShowHistory: TAction;
|
||||
acEditReload: TAction;
|
||||
acPackageReinit: TAction;
|
||||
acPackageInstall: TAction;
|
||||
acPackageUpdate: TAction;
|
||||
acPackageRemove: TAction;
|
||||
acPackageChooseVersion: TAction;
|
||||
acPackageProperties: TAction;
|
||||
acConfigEnvironment: TAction;
|
||||
acConfigDisplay: TAction;
|
||||
acConfigRepositories: TAction;
|
||||
acHelpManual: TAction;
|
||||
acHelpBugReport: TAction;
|
||||
acHelpAbout: TAction;
|
||||
acDebugCreateException: TAction;
|
||||
acDebugLogHeapStatus: TAction;
|
||||
acToolsCheckDeps: TAction;
|
||||
acToolsCheckConfFiles: TAction;
|
||||
clbStates: TCheckListBox;
|
||||
lvPackageList: TListView;
|
||||
mnuLogDatabase: TMenuItem;
|
||||
mnuDebugLogHeapStatus: TMenuItem;
|
||||
mnuDebugCreateException: TMenuItem;
|
||||
mnuDebug: TMenuItem;
|
||||
mnuPackageListBar1: TMenuItem;
|
||||
mnuPackageListProperties: TMenuItem;
|
||||
mnuPackageListChooseVersion: TMenuItem;
|
||||
mnuPackageListBar2: TMenuItem;
|
||||
mnuPackageListRemove: TMenuItem;
|
||||
mnuPackageListReinit: TMenuItem;
|
||||
mnuPackageListInstall: TMenuItem;
|
||||
mnuPackageListUpdate: TMenuItem;
|
||||
mnuTools: TMenuItem;
|
||||
mnuToolsCheckConfFiles: TMenuItem;
|
||||
mnuToolsCheckDependencies: TMenuItem;
|
||||
mmMenu: TMainMenu;
|
||||
mnuFile: TMenuItem;
|
||||
mnuFileOpen: TMenuItem;
|
||||
mnuFileSave: TMenuItem;
|
||||
mnuFileSep2: TMenuItem;
|
||||
mnuFileShowLog: TMenuItem;
|
||||
mnuFileSaveAll: TMenuItem;
|
||||
mnuFileSep1: TMenuItem;
|
||||
mnuFileExit: TMenuItem;
|
||||
mnuEdit: TMenuItem;
|
||||
mnuEditCancel: TMenuItem;
|
||||
mnuEditSep1: TMenuItem;
|
||||
mnuEditSearch: TMenuItem;
|
||||
mnuEditShowHistory: TMenuItem;
|
||||
mnuEditSep2: TMenuItem;
|
||||
mnuEditReload: TMenuItem;
|
||||
mnuEditApply: TMenuItem;
|
||||
mnuPackage: TMenuItem;
|
||||
mnuPackageReinit: TMenuItem;
|
||||
mnuPackageInstall: TMenuItem;
|
||||
mnuPackageUpdate: TMenuItem;
|
||||
mnuPackageRemove: TMenuItem;
|
||||
mnuPackageChooseVersion: TMenuItem;
|
||||
mnuPackageSep1: TMenuItem;
|
||||
mnuPackageSep2: TMenuItem;
|
||||
mnuPackageProperties: TMenuItem;
|
||||
mnuConfig: TMenuItem;
|
||||
mnuConfigEnvironment: TMenuItem;
|
||||
mnuConfigRepositories: TMenuItem;
|
||||
mnuConfigDisplay: TMenuItem;
|
||||
mnuHelp: TMenuItem;
|
||||
mnuHelpManual: TMenuItem;
|
||||
mnuHelpSep1: TMenuItem;
|
||||
mnuHelpBugReport: TMenuItem;
|
||||
mnuHelpSep2: TMenuItem;
|
||||
mnuHelpAbout: TMenuItem;
|
||||
pnLeft: TPanel;
|
||||
pmPackageList: TPopupMenu;
|
||||
spVertPanel: TSplitter;
|
||||
spHorizPanel: TSplitter;
|
||||
sbStatusBar: TStatusBar;
|
||||
tvPackageTree: TTreeView;
|
||||
PackageList: TPackageList;
|
||||
procedure acConfigDisplayExecute(Sender: TObject);
|
||||
procedure acConfigEnvironmentExecute(Sender: TObject);
|
||||
procedure acConfigRepositoriesExecute(Sender: TObject);
|
||||
procedure acDebugCreateExceptionExecute(Sender: TObject);
|
||||
procedure acDebugLogHeapStatusExecute(Sender: TObject);
|
||||
procedure acEditReloadExecute(Sender: TObject);
|
||||
procedure acEditSearchExecute(Sender: TObject);
|
||||
procedure acFileExitExecute(Sender: TObject);
|
||||
procedure acFileShowLogExecute(Sender: TObject);
|
||||
procedure acHelpAboutExecute(Sender: TObject);
|
||||
procedure acPackagePropertiesExecute(Sender: TObject);
|
||||
procedure clbStatesClickCheck(Sender: TObject);
|
||||
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure lvPackageListColumnClick(Sender: TObject; Column: TListColumn);
|
||||
procedure lvPackageListCompare(Sender: TObject; Item1, Item2: TListItem;
|
||||
Data: Integer; var Compare: Integer);
|
||||
procedure lvPackageListCustomDrawItem(Sender: TCustomListView;
|
||||
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
|
||||
procedure mnuLogDatabaseClick(Sender: TObject);
|
||||
procedure tvPackageTreeClick(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
FLastSortedColumn: Integer;
|
||||
FAscending: Boolean;
|
||||
FRootNode: TTreeNode;
|
||||
FUncategorised: TTreeNode;
|
||||
FSelectedCat: string;
|
||||
procedure AssignIcons;
|
||||
procedure SaveExtraParams;
|
||||
procedure LoadExtraParams;
|
||||
procedure InitRepo;
|
||||
procedure LoadPackages(const AUpdate: Boolean);
|
||||
procedure CreateBaseNodes;
|
||||
procedure AddCategory(const Cat: string; var AParent: TTreeNode);
|
||||
public
|
||||
fProgress: TfProgress;
|
||||
function CompareSize(const S1, S2: string): Integer;
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
fMain: TfMain;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
frmLogFile, LCLType, frmAbout, uIconManager, uDebug, uCommon,
|
||||
uUtils, frmEnvironementSettings, frmRepoSettings, uStrings, uSpackPackage,
|
||||
frmPackageProperty, frmSearch, frmDisplaySettings, uListViewColors;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
procedure DoProgress(const Min, Max, Pos: LongInt; const Msg: string);
|
||||
begin
|
||||
if Assigned(fMain.fProgress) then
|
||||
begin
|
||||
fMain.fProgress.ProgressBar2.Position := Pos;
|
||||
//if Msg <> '' then
|
||||
// fMain.fProgress.lbProgressionMessage.Caption := Msg; //that is slow
|
||||
end;
|
||||
Application.ProcessMessages;
|
||||
end;
|
||||
|
||||
{ TfMain }
|
||||
|
||||
procedure TfMain.AssignIcons;
|
||||
begin
|
||||
acFileOpen.ImageIndex := icOpen;
|
||||
acFileSave.ImageIndex := icSave;
|
||||
acFileSaveAll.ImageIndex := icSaveAll;
|
||||
acEditApply.ImageIndex := icApply;
|
||||
acEditCancel.ImageIndex := icUndo;
|
||||
acEditSearch.ImageIndex := icSearch;
|
||||
acEditReload.ImageIndex := icRefresh;
|
||||
acFileExit.ImageIndex := icExit;
|
||||
acPackageProperties.ImageIndex := icProperties;
|
||||
acConfigEnvironment.ImageIndex := icSettings;
|
||||
acConfigDisplay.ImageIndex := icDisplay;
|
||||
acConfigRepositories.ImageIndex := icRepository;
|
||||
acHelpAbout.ImageIndex := icAbout;
|
||||
acHelpBugReport.ImageIndex := icReportBug;
|
||||
acHelpManual.ImageIndex := icManual;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.SaveExtraParams;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
for I := 0 to lvPackageList.ColumnCount - 1 do
|
||||
iniMain.WriteInteger(Self.Name, rsConfNameListViewColumn + IntToStr(I),
|
||||
lvPackageList.Column[I].Width);
|
||||
iniMain.WriteInteger(Self.Name, rsConfNameHorizPanelLeft, pnLeft.Width);
|
||||
iniMain.WriteInteger(Self.Name, rsConfNameVertPanelTop,
|
||||
clbStates.Height);
|
||||
iniMain.WriteInteger(Self.Name, rsConfNameSortColumn, FLastSortedColumn);
|
||||
iniMain.WriteBool(Self.Name, rsConfNameSortAscending, FAscending);
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.LoadExtraParams;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
for I := 0 to lvPackageList.ColumnCount - 1 do
|
||||
lvPackageList.Column[I].Width := iniMain.ReadInteger(Self.Name,
|
||||
rsConfNameListViewColumn + IntToStr(I), lvPackageList.Column[I].Width);
|
||||
pnLeft.Width := iniMain.ReadInteger(Self.Name, rsConfNameHorizPanelLeft,
|
||||
pnLeft.Width);
|
||||
clbStates.Height := iniMain.ReadInteger(Self.Name,
|
||||
rsConfNameVertPanelTop, clbStates.Height);
|
||||
FLastSortedColumn := iniMain.ReadInteger(Self.Name, rsConfNameSortColumn, 0);
|
||||
FAscending := iniMain.ReadBool(Self.Name, rsConfNameSortAscending, True);
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.LoadPackages(const AUpdate: Boolean);
|
||||
var
|
||||
I, J, N, D: Integer;
|
||||
LI: TListItem;
|
||||
begin
|
||||
//cleanning
|
||||
if lvPackageList.Items.Count > 0 then
|
||||
lvPackageList.Clear;
|
||||
//activating this is not allowing to sort anymore
|
||||
//lvPackageList.OwnerData := not bNoColors;
|
||||
if PackageList.InstPackageLoaded then
|
||||
begin
|
||||
Cursor := crHourGlass;
|
||||
lvPackageList.BeginUpdate;
|
||||
for I := 0 to PackageList.Count - 1 do
|
||||
begin
|
||||
if not AUpdate then
|
||||
DoProgress(0, PackageList.Count - 1, I, rsProgressTidyPackageList);
|
||||
// always add category
|
||||
try
|
||||
if (PackageList.Packages[I].Cat <> '') and (not AUpdate) then
|
||||
AddCategory(PackageList.Packages[I].Cat, FRootNode);
|
||||
except
|
||||
ShowMessage('Error adding ' + PackageList.Packages[I].Cat + ' category.');
|
||||
end;
|
||||
// skip if not in selected cat
|
||||
if ((FSelectedCat <> '/') and
|
||||
(Pos(FSelectedCat, PackageList.Packages[I].Cat) <> 1)) or
|
||||
((PackageList.Packages[I].Cat = '') and (FSelectedCat <> '')) then
|
||||
Continue;
|
||||
// skip if not in the right state
|
||||
if ((psInstalled in PackageList.Packages[I].State) and
|
||||
(not clbStates.Checked[0])) or
|
||||
((not (psInstalled in PackageList.Packages[I].State)) and
|
||||
(not clbStates.Checked[1])) or
|
||||
((psUpdatable in PackageList.Packages[I].State) and
|
||||
(not clbStates.Checked[2])) then
|
||||
Continue;
|
||||
LI := lvPackageList.Items.Add;
|
||||
if PackageList.Packages[I].Name = '' then
|
||||
raise Exception.Create(rsExceptUnnamedPackage);
|
||||
LI.Data := PackageList.Packages[I];
|
||||
LI.Caption := PackageList.Packages[I].Name;
|
||||
for J := 0 to 4 do
|
||||
LI.SubItems.Add('');
|
||||
N := PackageList.Packages[I].GetInstalled;
|
||||
D := PackageList.Packages[I].GetDefaultVer;
|
||||
if D = 0 then
|
||||
D := PackageList.Packages[I].GetLatest;
|
||||
if N <> 0 then
|
||||
begin
|
||||
LI.SubItems[0] := PackageList.Packages[I].Alternatives[N].Version +
|
||||
'-' + IntToStr(PackageList.Packages[I].Alternatives[N].Build);
|
||||
if PackageList.Packages[I].Alternatives[N].Size <> 0 then
|
||||
LI.SubItems[2] := DispSize(PackageList.Packages[I].Alternatives[N].Size);
|
||||
LI.SubItems[3] := DispSize(PackageList.Packages[I].InstSize);
|
||||
LI.SubItems[4] := PackageList.Packages[I].Desc;
|
||||
end else
|
||||
begin
|
||||
LI.SubItems[0] := '';
|
||||
LI.SubItems[2] := '';
|
||||
LI.SubItems[4] := rsDescNotInstalledPackage;
|
||||
end;
|
||||
if D <> 0 then
|
||||
begin
|
||||
LI.SubItems[1] := PackageList.Packages[I].Alternatives[D].Version +
|
||||
'-' + IntToStr(PackageList.Packages[I].Alternatives[D].Build);
|
||||
if PackageList.Packages[I].Alternatives[D].Size <> 0 then
|
||||
LI.SubItems[2] := DispSize(PackageList.Packages[I].Alternatives[D].Size);
|
||||
end else
|
||||
begin
|
||||
LI.SubItems[1] := '';
|
||||
LI.SubItems[3] := '';
|
||||
end;
|
||||
end;
|
||||
Cursor := crArrow;
|
||||
lvPackageList.ScrollBy(0, 0);
|
||||
lvPackageList.EndUpdate;
|
||||
end else
|
||||
begin
|
||||
PrintLnDbg(Format(rsErrorNoPackage, [PackageList.InstPackageDir]), vlLow);
|
||||
MessageDlg(rsNoPackageFound, mtError, [MBOK], 0);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.InitRepo;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
LoadRepoSettings;
|
||||
for I := 0 to slRepoList.Count - 1 do
|
||||
begin
|
||||
if (Pos(sHttpPrefix, slRepoList[I]) > 0) or
|
||||
(Pos(sFtpPrefix, slRepoList[I]) > 0) then
|
||||
begin
|
||||
PrintLnDbg(Format(rsInfoAddingDistantRepo, [slRepoList[I]]), vlLow);
|
||||
PackageList.DistantRepoList.Add(slRepoList[I])
|
||||
end else
|
||||
begin
|
||||
PrintLnDbg(Format(rsInfoAddingLocalRepo, [slRepoList[I]]), vlLow);
|
||||
PackageList.LocalRepoList.Add(slRepoList[I]);
|
||||
end;
|
||||
//does the following really make sense?
|
||||
//clbStates.AddItem(Copy(slRepoList[I], 1,
|
||||
// Pos('=', slRepoList[I]) - 1), nil);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.CreateBaseNodes;
|
||||
begin
|
||||
FRootNode := tvPackageTree.Items.AddFirst(nil, rsAllPackages);
|
||||
FRootNode.Focused := True;
|
||||
FUncategorised := tvPackageTree.Items.AddChild(FRootNode, rsUncategorized);
|
||||
FUncategorised.MakeVisible;
|
||||
FRootNode.Expanded := True;
|
||||
FSelectedCat := '/';
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.AddCategory(const Cat: string; var AParent: TTreeNode);
|
||||
var
|
||||
Node: TTreeNode;
|
||||
S1, S2: string;
|
||||
I: Integer;
|
||||
begin
|
||||
if AParent = nil then
|
||||
AParent := FRootNode;
|
||||
if Pos('/', Cat) > 1 then
|
||||
begin
|
||||
S1 := Copy(Cat, 1, Pos('/', Cat) - 1);
|
||||
S2 := Copy(Cat, Pos('/', Cat) + 1, Length(Cat) - Pos('/', Cat));
|
||||
end else
|
||||
begin
|
||||
S1 := Cat;
|
||||
S2 := '';
|
||||
end;
|
||||
Node := nil;
|
||||
for I := 0 to AParent.Count - 1 do
|
||||
if AParent.Items[I].Text = S1 then
|
||||
Node := AParent.Items[I];
|
||||
if Node = nil then
|
||||
begin
|
||||
PrintLnDbg(Format(rsDebugNodeAdded, [S1, AParent.Text]));
|
||||
Node := tvPackageTree.Items.AddChild(AParent, S1);
|
||||
Node.MakeVisible;
|
||||
Node.Parent.Expanded := True;
|
||||
end;
|
||||
if S2 <> '' then
|
||||
AddCategory(S2, Node); // recursive...
|
||||
Node.AlphaSort;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.FormCreate(Sender: TObject);
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
{$IFDEF DEBUG}
|
||||
mnuDebug.Visible := True;
|
||||
{$ELSE}
|
||||
mnuDebug.Visible := False;
|
||||
{$ENDIF}
|
||||
FLastSortedColumn := -1;
|
||||
FAscending := True;
|
||||
PackageList := TPackageList.Create;
|
||||
mmMenu.Images := ilDefault;
|
||||
pmPackageList.Images := ilDefault;
|
||||
acActionList.Images := ilDefault;
|
||||
LoadWindowGeometry(Self);
|
||||
AssignIcons;
|
||||
InitBtnGlyphs(Self);
|
||||
LoadColors;
|
||||
LoadExtraParams;
|
||||
InitRepo;
|
||||
CreateBaseNodes;
|
||||
for I := 0 to clbStates.Count - 1 do
|
||||
clbStates.Checked[I] := True;
|
||||
lvPackageList.GridLines := bShowGrig;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.FormShow(Sender: TObject);
|
||||
begin
|
||||
acEditReloadExecute(nil);
|
||||
//lvPackageListColumnClick(lvPackageList,
|
||||
// lvPackageList.Column[FLastSortedColumn]);
|
||||
tvPackageTree.ScrollBy(0, 0);
|
||||
tvPackageTree.Selected := FRootNode;
|
||||
lvPackageList.SortColumn := FLastSortedColumn;
|
||||
lvPackageList.SortType := stData;
|
||||
end;
|
||||
|
||||
|
||||
function TfMain.CompareSize(const S1, S2: string): Integer;
|
||||
var
|
||||
N1, N2: LongInt;
|
||||
begin //that solution looks weird but is quite faster that looking into database
|
||||
N1 := SizeStrToInt(S1);
|
||||
N2 := SizeStrToInt(S2);
|
||||
Result := 0;
|
||||
if N1 > N2 then
|
||||
Result := 1
|
||||
else
|
||||
if N1 < N2 then
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.lvPackageListColumnClick(Sender: TObject; Column: TListColumn);
|
||||
begin
|
||||
TListView(Sender).SortType := stNone;
|
||||
if Column.Index = FLastSortedColumn then
|
||||
FAscending := not FAscending
|
||||
else
|
||||
begin
|
||||
FLastSortedColumn := Column.Index;
|
||||
FAscending := True;
|
||||
end;
|
||||
lvPackageList.SortColumn := Column.Index;
|
||||
TListView(Sender).SortType := stData;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.lvPackageListCompare(Sender: TObject; Item1, Item2: TListItem;
|
||||
Data: Integer; var Compare: Integer);
|
||||
begin
|
||||
case FLastSortedColumn of
|
||||
0: Compare := AnsiCompareText(Item1.Caption, Item2.Caption); //pkgname
|
||||
1: Compare := CompareVersion(Item1.SubItems[0], Item2.SubItems[0]); //installed version
|
||||
2: Compare := CompareVersion(Item1.SubItems[1], Item2.SubItems[1]); //last version
|
||||
3: Compare := CompareSize(Item1.SubItems[2], Item2.SubItems[2]); //pkgsize
|
||||
4: Compare := CompareSize(Item1.SubItems[3], Item2.SubItems[3]); //installed size
|
||||
5: Compare := AnsiCompareText(Item1.SubItems[4], Item2.SubItems[4]); //description
|
||||
end;
|
||||
if not FAscending then
|
||||
Compare := -Compare;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.lvPackageListCustomDrawItem(Sender: TCustomListView;
|
||||
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
|
||||
var
|
||||
FontCol, BGCol: TColor;
|
||||
begin
|
||||
if bNoColors then
|
||||
begin
|
||||
inherited;
|
||||
Exit;
|
||||
end;
|
||||
GetColorFromState(TSPackPackage(Item.Data).State, FontCol, BGCol);
|
||||
Sender.Brush.Color := BGCol;
|
||||
Sender.Canvas.Font.Color := FontCol;
|
||||
Sender.Canvas.Refresh;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.mnuLogDatabaseClick(Sender: TObject);
|
||||
var
|
||||
SL: TStringList;
|
||||
I, J, N, P, L: Integer;
|
||||
S: string;
|
||||
begin
|
||||
SL := TStringList.Create;
|
||||
SL.Add(rsInfoStartLoggingDb);
|
||||
for I := 0 to PackageList.Count - 1 do
|
||||
begin
|
||||
SL.Add(Format(rsLogNewPackage, [PackageList.Packages[I].Cat,
|
||||
PackageList.Packages[I].Name]));
|
||||
SL.Add(Format(rsLogDescription, [PackageList.Packages[I].Desc]));
|
||||
N := PackageList.Packages[I].GetInstalled;
|
||||
P := PackageList.Packages[I].GetDefaultVer;
|
||||
L := PackageList.Packages[I].GetLatest;
|
||||
for J := 1 to MaxPackAlt do
|
||||
if PackageList.Packages[I].Alternatives[J].Version <> '' then
|
||||
begin
|
||||
S := Format(rsLogPackageAlt, [J,
|
||||
PackageList.Packages[I].Alternatives[J].Version,
|
||||
PackageList.Packages[I].Alternatives[J].Build,
|
||||
DispSize(PackageList.Packages[I].Alternatives[J].Size),
|
||||
PackageList.Packages[I].Alternatives[J].SourceAddress]);
|
||||
if N = J then
|
||||
S := S + rsLogInstalled;
|
||||
if P = J then
|
||||
S := S + rsLogDefault;
|
||||
if L = J then
|
||||
S := S + rsLogLatest;
|
||||
SL.Add(S);
|
||||
end;
|
||||
SL.Add(rsLogSep);
|
||||
end;
|
||||
PrintLnDbg(SL, vlFull);
|
||||
PrintLnDbg(rsInfoEndLoggingDb, vlFull);
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.tvPackageTreeClick(Sender: TObject);
|
||||
var
|
||||
Node: TTreeNode;
|
||||
begin
|
||||
lvPackageList.SortType := stNone;
|
||||
if tvPackageTree.Selected = FRootNode then
|
||||
FSelectedCat := '/'
|
||||
else
|
||||
if tvPackageTree.Selected = FUncategorised then
|
||||
FSelectedCat := ''
|
||||
else
|
||||
begin
|
||||
FSelectedCat := '';
|
||||
Node := tvPackageTree.Selected;
|
||||
while Node <> FRootNode do
|
||||
begin
|
||||
FSelectedCat := Node.Text + '/' + FSelectedCat;
|
||||
Node := Node.Parent;
|
||||
end;
|
||||
FSelectedCat := Copy(FSelectedCat, 1, Length(FSelectedCat) - 1);
|
||||
end;
|
||||
PrintLnDbg(Format(rsDebugDisplayingCategory, [FSelectedCat]));
|
||||
LoadPackages(True);
|
||||
lvPackageList.SortColumn := FLastSortedColumn;
|
||||
lvPackageList.SortType := stData;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.acHelpAboutExecute(Sender: TObject);
|
||||
begin
|
||||
with TfAbout.Create(Application) do
|
||||
try
|
||||
ShowModal;
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.acPackagePropertiesExecute(Sender: TObject);
|
||||
begin
|
||||
if lvPackageList.Selected = nil then
|
||||
Exit;
|
||||
with TfPackageProperty.Create(Application) do
|
||||
try
|
||||
Self.Cursor := crHourGlass;
|
||||
Application.ProcessMessages;
|
||||
LoadPackageInfo(lvPackageList.Selected.Caption);
|
||||
Self.Cursor := crArrow;
|
||||
ShowModal;
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.clbStatesClickCheck(Sender: TObject);
|
||||
begin
|
||||
lvPackageList.SortType := stData;
|
||||
LoadPackages(True);
|
||||
lvPackageList.SortColumn := FLastSortedColumn;
|
||||
lvPackageList.SortType := stData;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
begin
|
||||
try
|
||||
SaveWindowGeometry(Self);
|
||||
SaveExtraParams;
|
||||
except
|
||||
PrintLnDbg(rsErrorCannotSaveConf, vlLow);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.acFileExitExecute(Sender: TObject);
|
||||
begin
|
||||
Application.Terminate;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.acFileShowLogExecute(Sender: TObject);
|
||||
begin
|
||||
if sLogFileName = '' then
|
||||
Exit;
|
||||
if (fLogView = nil) or (not Assigned(fLogView)) then
|
||||
begin
|
||||
PrintLnDbg(rsInfoShowingLogWin, vlHigh);
|
||||
fLogView := TfLogView.Create(Application);
|
||||
fLogView.Show;
|
||||
end else
|
||||
if not fLogView.Visible then
|
||||
fLogView.Show;
|
||||
fLogView.SetFocus;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.acEditReloadExecute(Sender: TObject);
|
||||
var
|
||||
Steps, I: Integer;
|
||||
begin
|
||||
try
|
||||
if (PackageList = nil) or (not Assigned(PackageList)) then
|
||||
PackageList := TPackageList.Create
|
||||
else
|
||||
PackageList.Clear;
|
||||
Cursor := crHourGlass;
|
||||
Steps := 2 + PackageList.LocalRepoList.Count + PackageList.DistantRepoList.Count;
|
||||
if PackageList.InstPackageDir = '' then
|
||||
PackageList.InstPackageDir := sDefaultSpackPkgDir;
|
||||
fProgress := CreateProgress(rsProgressLoading, rsProgressInitDB,
|
||||
rsProgressReadingInstalled, 0, Steps, 0, PackageList.GetInstalledCount);
|
||||
PackageList.OnProgress := @DoProgress;
|
||||
fProgress.CanCancel := False;
|
||||
fProgress.ShowOnTop;
|
||||
Application.ProcessMessages;
|
||||
try
|
||||
PackageList.GetInstalledPackages;
|
||||
finally
|
||||
fProgress.ProgressBar.Position := fProgress.ProgressBar.Position + 1;
|
||||
fProgress.lbProgressionMessage2.Caption := rsProgressReadingLocal;
|
||||
fProgress.ProgressBar2.Position := 0;
|
||||
end;
|
||||
Application.ProcessMessages;
|
||||
try
|
||||
PackageList.LoadLocalRepo;
|
||||
finally
|
||||
fProgress.ProgressBar.Position := fProgress.ProgressBar.Position + 1;
|
||||
fProgress.lbProgressionMessage2.Caption := rsProgressDownloadingIndex;
|
||||
fProgress.ProgressBar2.Position := 0;
|
||||
end;
|
||||
Application.ProcessMessages;
|
||||
try
|
||||
PackageList.DownloadDistantRepo;
|
||||
finally
|
||||
fProgress.ProgressBar.Position := fProgress.ProgressBar.Position + 1;
|
||||
fProgress.lbProgressionMessage2.Caption := rsProgressReadingDistant;
|
||||
fProgress.ProgressBar2.Position := 0;
|
||||
end;
|
||||
Application.ProcessMessages;
|
||||
for I := 0 to slRepoList.Count - 1 do
|
||||
if (Pos(sHttpPrefix, slRepoList[I]) - Pos('=', slRepoList[I]) = 1) or
|
||||
(Pos(sFtpPrefix, slRepoList[I]) - Pos('=', slRepoList[I]) = 1) then
|
||||
try
|
||||
PackageList.LoadDistantRepo(Copy(slRepoList[I], 1,
|
||||
Pos('=', slRepoList[I]) - 1));
|
||||
finally
|
||||
fProgress.ProgressBar.Position := fProgress.ProgressBar.Position + 1;
|
||||
end;
|
||||
fProgress.lbProgressionMessage2.Caption := rsProgressTidyPackageList;
|
||||
fProgress.ProgressBar2.Position := 0;
|
||||
Application.ProcessMessages;
|
||||
Cursor := crArrow;
|
||||
finally
|
||||
PackageList.SetDeprecated(slDeprecated);
|
||||
LoadPackages(False);
|
||||
fProgress.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.acEditSearchExecute(Sender: TObject);
|
||||
begin
|
||||
with TfSearch.Create(Application) do
|
||||
try
|
||||
ShowModal;
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.acConfigRepositoriesExecute(Sender: TObject);
|
||||
begin
|
||||
with TfRepoSettings.Create(Application) do
|
||||
try
|
||||
if (ShowModal = mrOK) and RepoChanged then
|
||||
if MessageDlg(rsReloadPackagesAfterRepoChange, mtConfirmation,
|
||||
mbYesNo, 0) = mrYes then
|
||||
acEditReloadExecute(nil);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.acDebugCreateExceptionExecute(Sender: TObject);
|
||||
begin
|
||||
raise
|
||||
Exception.Create(rsExceptTest);
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.acDebugLogHeapStatusExecute(Sender: TObject);
|
||||
begin
|
||||
PrintLnDbg(GetHeapStatus(SysGetHeapStatus));
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.acConfigEnvironmentExecute(Sender: TObject);
|
||||
begin
|
||||
with TfEnvironmentSettings.Create(Application) do
|
||||
try
|
||||
if (ShowModal = mrOK) and PathChanged then
|
||||
if MessageDlg(rsReloadPackagesAfterEnvChange, mtConfirmation,
|
||||
mbYesNo, 0) = mrYes then
|
||||
acEditReloadExecute(nil);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfMain.acConfigDisplayExecute(Sender: TObject);
|
||||
begin
|
||||
with TfDisplaySettings.Create(Application) do
|
||||
try
|
||||
if ShowModal = mrOK then
|
||||
LoadPackages(True);
|
||||
finally
|
||||
Free;
|
||||
lvPackageList.GridLines := bShowGrig;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user