Opkman: Implemented support for multiple repositories.

git-svn-id: trunk@53961 -
This commit is contained in:
balazs 2017-01-17 11:12:56 +00:00
parent 91877feb80
commit 7b78ebab89
7 changed files with 94 additions and 52 deletions

View File

@ -41,7 +41,7 @@ const
cLocalRepositoryUpdate = 'update';
cLocalRepositoryConfig = 'config';
cLocalRepositoryConfigFile = 'options.xml';
cLocalRepositoryUpdatesFile = 'updates.xml';
cLocalRepositoryUpdatesFile = 'updates_%s.xml';
cExcludedFilesDef = '*.,*.a,*.o,*.ppu,*.compiled,*.bak,*.or,*.rsj,*.~,*.exe,*.dbg,*.zip,*.json';
cExcludedFoldersDef = 'lib,backup,updates,compiled,.git,.svn';
cHelpPage = 'http://wiki.freepascal.org/Online_Package_Manager';
@ -174,6 +174,7 @@ resourcestring
rsMainFrm_rsMessageNoPackage = 'No packages to show.';
rsMainFrm_rsMessageParsingJSON = 'Parsing JSON. Please wait...';
rsMainFrm_rsMessageDownload = 'Downloading package list. Please wait...';
rsMainFrm_rsMessageChangingRepository = 'Changing repository. Please wait...';
rsMainFrm_rsMessageNoRepository0 = 'Remote package repository not configured.' + sLineBreak + 'Do you wish to configure it now?';
rsMainFrm_rsMessageError0 = 'Cannot download package list. Error message:';
rsMainFrm_rsMessageError1 = 'Invalid JSON file.';
@ -368,7 +369,7 @@ resourcestring
rsRepositories_Confirmation0 = 'Delete selected repository "%s" ?';
rsRepositories_InputBox_Caption0 = 'Add repository';
rsRepositories_InputBox_Caption1 = 'Edit repository';
rsRepositories_InputBox_Text = 'Type the repository name:';
rsRepositories_InputBox_Text = 'Type the repository address:';
implementation

View File

@ -32,7 +32,7 @@ uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, contnrs,
StdCtrls, ExtCtrls, Buttons, Menus, ComCtrls, IDECommands, LazFileUtils,
LCLIntf, fpjson, opkman_VirtualTrees, opkman_downloader, opkman_installer,
PackageIntf, Clipbrd;
PackageIntf, Clipbrd, md5;
type
@ -111,7 +111,7 @@ type
procedure EnableDisableControls(const AEnable: Boolean);
procedure SetupMessage(const AMessage: String = '');
procedure SetupControls;
procedure GetPackageList;
procedure GetPackageList(const ARepositoryHasChanged: Boolean = False);
procedure DoOnChecking(Sender: TObject; const AIsAllChecked: Boolean);
procedure DoOnChecked(Sender: TObject);
procedure DoOnJSONProgress(Sender: TObject);
@ -123,7 +123,8 @@ type
function Extract(const ASrcDir, ADstDir: String; var ADoOpen: Boolean; const AIsUpdate: Boolean = False): TModalResult;
function Install(var AInstallStatus: TInstallStatus; var ANeedToRebuild: Boolean): TModalResult;
function UpdateP(const ADstDir: String; var ADoExtract: Boolean): TModalResult;
procedure TerminateUpdates;
procedure StartUpdates;
procedure StopUpdates;
public
procedure ShowOptions(const AActivePageIndex: Integer = 0);
end;
@ -154,10 +155,7 @@ begin
PackageDownloader := TPackageDownloader.Create(Options.RemoteRepository[Options.ActiveRepositoryIndex]);
PackageDownloader.OnJSONProgress := @DoOnJSONProgress;
PackageDownloader.OnJSONDownloadCompleted := @DoOnJSONDownloadCompleted;
Updates := TUpdates.Create(LocalRepositoryUpdatesFile);
Updates.OnUpdate := @DoOnUpdate;
Updates.StartUpdate;
Updates.PauseUpdate;
StartUpdates;
InstallPackageList := TObjectList.Create(True);
FHintTimeOut := Application.HintHidePause;
Application.HintHidePause := 1000000;
@ -166,7 +164,18 @@ begin
{$ENDIF}
end;
procedure TMainFrm.TerminateUpdates;
procedure TMainFrm.StartUpdates;
var
FileName: String;
begin
FileName := Format(LocalRepositoryUpdatesFile, [MD5Print(MD5String(Options.RemoteRepository[Options.ActiveRepositoryIndex]))]);
Updates := TUpdates.Create(FileName);
Updates.OnUpdate := @DoOnUpdate;
Updates.StartUpdate;
Updates.PauseUpdate;
end;
procedure TMainFrm.StopUpdates;
begin
if Assigned(Updates) then
begin
@ -178,7 +187,7 @@ end;
procedure TMainFrm.FormDestroy(Sender: TObject);
begin
TerminateUpdates;
StopUpdates;
PackageDownloader.Free;
SerializablePackages.Free;
VisualTree.Free;
@ -199,13 +208,22 @@ begin
GetPackageList;
end;
procedure TMainFrm.GetPackageList;
procedure TMainFrm.GetPackageList(const ARepositoryHasChanged: Boolean = False);
begin
Updates.PauseUpdate;
Caption := rsLazarusPackageManager;
EnableDisableControls(False);
VisualTree.VST.Clear;
VisualTree.VST.Invalidate;
EnableDisableControls(False);
if ARepositoryHasChanged then
begin
SetupMessage(rsMainFrm_rsMessageChangingRepository);
Sleep(1500);
StopUpdates;
SerializablePackages.Clear;
StartUpdates;
end
else
Updates.PauseUpdate;
SetupMessage(rsMainFrm_rsMessageDownload);
PackageDownloader.DownloadJSON(10000);
end;
@ -304,7 +322,6 @@ begin
end;
end;
procedure TMainFrm.DoOnJSONDownloadCompleted(Sender: TObject; AJSON: TJSONStringType; AErrTyp: TErrorType; const AErrMsg: String = '');
begin
case AErrTyp of
@ -357,14 +374,17 @@ begin
end;
procedure TMainFrm.ShowOptions(const AActivePageIndex: Integer = 0);
var
OldIndex: Integer;
begin
OptionsFrm := TOptionsFrm.Create(MainFrm);
try
OptionsFrm.SetupControls(AActivePageIndex);
OldIndex := Options.ActiveRepositoryIndex;
if OptionsFrm.ShowModal = mrOk then
begin
tbRefresh.Enabled := Trim(Options.RemoteRepository[Options.ActiveRepositoryIndex]) <> '';
GetPackageList;
GetPackageList(OldIndex <> Options.ActiveRepositoryIndex);
end;
finally
OptionsFrm.Free;

View File

@ -157,6 +157,8 @@ begin
FRemoteRepository.Text := FXML.GetValue('RemoteRepository/Value', '')
else
FRemoteRepository.Text := FXML.GetValue('General/RemoteRepository/Value', '');
if Trim(FRemoteRepository.Text) = '' then
FRemoteRepository.Add(cRemoteRepository);
FActiveRepositoryIndex := FXML.GetValue('General/ActiveRepositoryIndex/Value', 0);
FForceDownloadAndExtract := FXML.GetValue('General/ForceDownloadAndExtract/Value', True);
FDeleteZipAfterInstall := FXML.GetValue('General/DeleteZipAfterInstall/Value', True);
@ -215,6 +217,8 @@ end;
procedure TOptions.LoadDefault;
begin
FRemoteRepository.Clear;
FRemoteRepositoryTmp.Clear;
FRemoteRepository.Add(cRemoteRepository);
FActiveRepositoryIndex := 0;
FForceDownloadAndExtract := True;

View File

@ -22,7 +22,7 @@ object OptionsFrm: TOptionsFrm
BevelOuter = bvNone
ClientHeight = 39
ClientWidth = 525
TabOrder = 0
TabOrder = 1
object bOk: TButton
Left = 332
Height = 25
@ -61,19 +61,20 @@ object OptionsFrm: TOptionsFrm
ActivePage = tsGeneral
Align = alClient
TabIndex = 0
TabOrder = 1
TabOrder = 0
object tsGeneral: TTabSheet
Caption = 'General'
ClientHeight = 297
ClientWidth = 517
object pnGeneral: TPanel
Left = 0
Height = 297
Height = 296
Top = 0
Width = 517
Align = alClient
BorderSpacing.Bottom = 1
BevelOuter = bvNone
ClientHeight = 297
ClientHeight = 296
ClientWidth = 517
Color = clBtnFace
ParentColor = False
@ -89,7 +90,7 @@ object OptionsFrm: TOptionsFrm
object cbForceDownloadExtract: TCheckBox
Left = 15
Height = 19
Top = 70
Top = 75
Width = 235
Caption = ' Force download and extract of packages'
ParentShowHint = False
@ -115,9 +116,9 @@ object OptionsFrm: TOptionsFrm
ParentColor = False
end
object cbCheckForUpdates: TComboBox
Left = 16
Left = 15
Height = 23
Top = 168
Top = 170
Width = 209
ItemHeight = 15
ItemIndex = 0
@ -136,37 +137,51 @@ object OptionsFrm: TOptionsFrm
object lbLastUpdate: TLabel
Left = 240
Height = 15
Top = 171
Top = 173
Width = 64
Caption = 'Last update:'
ParentColor = False
end
object bOpen: TButton
Left = 476
Height = 25
object pnRepositories: TPanel
Left = 15
Height = 26
Top = 31
Width = 27
Anchors = [akTop, akRight]
Caption = '...'
OnClick = bOpenClick
TabOrder = 3
end
object cbRemoteRepository: TComboBox
Left = 16
Height = 23
Top = 32
Width = 457
Width = 489
Anchors = [akTop, akLeft, akRight]
ItemHeight = 15
Style = csDropDownList
TabOrder = 4
AutoSize = True
BevelOuter = bvNone
ClientHeight = 26
ClientWidth = 489
TabOrder = 3
object cbRemoteRepository: TComboBox
Left = 1
Height = 23
Top = 1
Width = 456
Align = alClient
BorderSpacing.Around = 1
ItemHeight = 15
Style = csDropDownList
TabOrder = 0
end
object bOpen: TButton
Left = 458
Height = 25
Top = 0
Width = 31
Align = alRight
BorderSpacing.Bottom = 1
Caption = '...'
OnClick = bOpenClick
TabOrder = 1
end
end
end
end
object tsProxy: TTabSheet
Caption = 'Proxy'
ClientHeight = 297
ClientWidth = 517
ClientHeight = 286
ClientWidth = 519
object pnProxy: TPanel
Left = 0
Height = 297
@ -273,8 +288,8 @@ object OptionsFrm: TOptionsFrm
end
object tsFolders: TTabSheet
Caption = 'Folders'
ClientHeight = 297
ClientWidth = 517
ClientHeight = 286
ClientWidth = 519
object pnFolders: TPanel
Left = 0
Height = 297
@ -364,8 +379,8 @@ object OptionsFrm: TOptionsFrm
end
object tsProfiles: TTabSheet
Caption = 'Profiles'
ClientHeight = 297
ClientWidth = 517
ClientHeight = 286
ClientWidth = 519
object pnProfiles: TPanel
Left = 0
Height = 297
@ -505,7 +520,7 @@ object OptionsFrm: TOptionsFrm
Color = clBtnFace
ItemHeight = 0
ParentShowHint = False
ScrollWidth = 161
ScrollWidth = 179
ShowHint = True
Sorted = True
TabOrder = 2
@ -593,7 +608,7 @@ object OptionsFrm: TOptionsFrm
Color = clBtnFace
ItemHeight = 0
ParentShowHint = False
ScrollWidth = 154
ScrollWidth = 159
ShowHint = True
Sorted = True
TabOrder = 2

View File

@ -45,15 +45,15 @@ type
bFoldersDelete: TButton;
bFoldersEdit: TButton;
bOk: TButton;
bOpen: TButton;
bRestore: TButton;
bFilesAdd: TButton;
bOpen: TButton;
cbProxy: TCheckBox;
cbForceDownloadExtract: TCheckBox;
cbDeleteZipAfterInstall: TCheckBox;
cbCheckForUpdates: TComboBox;
cbSelectProfile: TComboBox;
cbRemoteRepository: TComboBox;
cbSelectProfile: TComboBox;
edLocalRepositoryUpdate: TDirectoryEdit;
edLocalRepositoryPackages: TDirectoryEdit;
edLocalRepositoryArchive: TDirectoryEdit;
@ -76,6 +76,7 @@ type
lbPassword: TLabel;
lbExcludeFiles: TListBox;
lbExcludeFolders: TListBox;
pnRepositories: TPanel;
pnProfilesCaptionLeft: TPanel;
pnProfilesCaptionLeft1: TPanel;
pnProfilesLeftButtons: TPanel;

View File

@ -7,6 +7,7 @@ object RepositoriesFrm: TRepositoriesFrm
Caption = 'RepositoriesFrm'
ClientHeight = 367
ClientWidth = 561
Color = clBtnFace
OnCreate = FormCreate
OnDestroy = FormDestroy
PopupMode = pmExplicit

View File

@ -51,7 +51,7 @@ var
RepositoriesFrm: TRepositoriesFrm;
implementation
uses opkman_const, opkman_common, opkman_options, opkman_optionsfrm;
uses opkman_const, opkman_common, opkman_options;
{$R *.lfm}
type