implemented im/export of install package list

git-svn-id: trunk@6400 -
This commit is contained in:
mattias 2004-12-21 11:14:29 +00:00
parent 2b78d0b28c
commit 339c87d92c
4 changed files with 170 additions and 19 deletions

View File

@ -1501,10 +1501,14 @@ resourcestring
// codetools defines // codetools defines
lisCodeToolsDefsCodeToolsDefinesPreview = 'CodeTools Defines Preview'; lisCodeToolsDefsCodeToolsDefinesPreview = 'CodeTools Defines Preview';
lisCodeToolsDefsWriteError = 'Write error'; lisCodeToolsDefsWriteError = 'Write error';
lisErrorWritingPackageListToFile = 'Error writing package list to file%s%s%'
+'s%s';
lisCodeToolsDefsErrorWhileWriting = 'Error while writing %s%s%s%s%s'; lisCodeToolsDefsErrorWhileWriting = 'Error while writing %s%s%s%s%s';
lisCodeToolsDefsErrorWhileWritingProjectInfoFile = 'Error while writing ' lisCodeToolsDefsErrorWhileWritingProjectInfoFile = 'Error while writing '
+'project info file %s%s%s%s%s'; +'project info file %s%s%s%s%s';
lisCodeToolsDefsReadError = 'Read error'; lisCodeToolsDefsReadError = 'Read error';
lisErrorReadingPackageListFromFile = 'Error reading package list from file%'
+'s%s%s%s';
lisTheCurrentUnitPathForTheFileIsThePathToTheLCLUnits = 'The current unit ' lisTheCurrentUnitPathForTheFileIsThePathToTheLCLUnits = 'The current unit '
+'path for the file%s%s%s%s is%s%s%s%s.%s%sThe path to the LCL units %s%s%' +'path for the file%s%s%s%s is%s%s%s%s.%s%sThe path to the LCL units %s%s%'
+'s is missing.%s%sHint for newbies:%sCreate a lazarus application and ' +'s is missing.%s%sHint for newbies:%sCreate a lazarus application and '
@ -2610,6 +2614,15 @@ resourcestring
lisSelectAHelpItem = 'Select a help item:'; lisSelectAHelpItem = 'Select a help item:';
lisErrorMovingComponent = 'Error moving component'; lisErrorMovingComponent = 'Error moving component';
lisErrorMovingComponent2 = 'Error moving component %s:%s'; lisErrorMovingComponent2 = 'Error moving component %s:%s';
lisInstalledPackages = 'Installed Packages';
lisAvailablePackages = 'Available packages';
lisExportList = 'Export list';
lisImportList = 'Import list';
lisUninstallSelection = 'Uninstall selection';
lisPackagesToInstallInTheIDE = 'Packages to install in the IDE';
lisInstallSelection = 'Install selection';
lisSaveAndRebuildIDE = 'Save and rebuild IDE';
lisSaveAndExitDialog = 'Save and exit dialog';
implementation implementation
end. end.

View File

@ -204,7 +204,7 @@ type
TSaveDialog = class(TOpenDialog) TSaveDialog = class(TOpenDialog)
public public
constructor Create(AOwner : TComponent); override; constructor Create(AOwner: TComponent); override;
end; end;
@ -214,7 +214,7 @@ type
protected protected
function CheckFile(var AFilename: string): boolean; override; function CheckFile(var AFilename: string): boolean; override;
public public
constructor Create(AOwner : TComponent); override; constructor Create(AOwner: TComponent); override;
end; end;
@ -420,6 +420,9 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.56 2004/12/21 11:14:29 mattias
implemented im/export of install package list
Revision 1.55 2004/12/13 21:30:21 mattias Revision 1.55 2004/12/13 21:30:21 mattias
implemented TMultiPropertyLink implemented TMultiPropertyLink

View File

@ -39,8 +39,9 @@ interface
uses uses
Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Buttons, OldAvLTree, StdCtrls, Buttons, OldAvLTree, FileUtil, Laz_XMLCfg,
LazarusIDEStrConsts, PackageDefs, PackageSystem; LazarusIDEStrConsts, EnvironmentOpts, InputHistory, LazConf,
PackageDefs, PackageSystem;
type type
TInstallPkgSetDialog = class(TForm) TInstallPkgSetDialog = class(TForm)
@ -69,7 +70,7 @@ type
private private
FNewInstalledPackages: TList; FNewInstalledPackages: TList;
FOldInstalledPackages: TPkgDependency; FOldInstalledPackages: TPkgDependency;
fPackages: TAVLTree;// tree of TLazPackage or TPackageLink (all available) fPackages: TAVLTree;// tree of TLazPackageID (all available packages and links)
FRebuildIDE: boolean; FRebuildIDE: boolean;
procedure SetOldInstalledPackages(const AValue: TPkgDependency); procedure SetOldInstalledPackages(const AValue: TPkgDependency);
procedure AssignOldInstalledPackagesToList; procedure AssignOldInstalledPackagesToList;
@ -83,6 +84,8 @@ type
function NewInstalledPackagesContains(APackageID: TLazPackageID): boolean; function NewInstalledPackagesContains(APackageID: TLazPackageID): boolean;
function IndexOfNewInstalledPackageID(APackageID: TLazPackageID): integer; function IndexOfNewInstalledPackageID(APackageID: TLazPackageID): integer;
function IndexOfNewInstalledPkgByName(const APackageName: string): integer; function IndexOfNewInstalledPkgByName(const APackageName: string): integer;
procedure SavePackageListToFile(const AFilename: string);
procedure LoadPackageListFromFile(const AFilename: string);
public public
function GetNewInstalledPackages: TList; function GetNewInstalledPackages: TList;
property OldInstalledPackages: TPkgDependency read FOldInstalledPackages property OldInstalledPackages: TPkgDependency read FOldInstalledPackages
@ -119,18 +122,18 @@ end;
procedure TInstallPkgSetDialog.InstallPkgSetDialogCreate(Sender: TObject); procedure TInstallPkgSetDialog.InstallPkgSetDialogCreate(Sender: TObject);
begin begin
Caption:='Installed Packages'; Caption:=lisInstalledPackages;
AvailablePkgGroupBox.Caption:='Available packages'; AvailablePkgGroupBox.Caption:=lisAvailablePackages;
ExportButton.Caption:='Export list'; ExportButton.Caption:=lisExportList;
ImportButton.Caption:='Import list'; ImportButton.Caption:=lisImportList;
UninstallButton.Caption:='Uninstall selection'; UninstallButton.Caption:=lisUninstallSelection;
InstallPkgGroupBox.Caption:='Packages to install in the IDE'; InstallPkgGroupBox.Caption:=lisPackagesToInstallInTheIDE;
AddToInstallButton.Caption:='Install selection'; AddToInstallButton.Caption:=lisInstallSelection;
SaveAndRebuildButton.Caption:='Save and rebuild IDE'; SaveAndRebuildButton.Caption:=lisSaveAndRebuildIDE;
SaveAndExitButton.Caption:='Save and exit dialog'; SaveAndExitButton.Caption:=lisSaveAndExitDialog;
CancelButton.Caption:='Cancel'; CancelButton.Caption:=dlgCancel;
fPackages:=TAVLTree.Create(@CompareLazPackageID); fPackages:=TAVLTree.Create(@CompareLazPackageIDNames);
FNewInstalledPackages:=TList.Create; FNewInstalledPackages:=TList.Create;
end; end;
@ -148,13 +151,47 @@ begin
end; end;
procedure TInstallPkgSetDialog.ExportButtonClick(Sender: TObject); procedure TInstallPkgSetDialog.ExportButtonClick(Sender: TObject);
var
SaveDialog: TSaveDialog;
AFilename: string;
begin begin
// TODO SaveDialog:=TSaveDialog.Create(nil);
try
InputHistories.ApplyFileDialogSettings(SaveDialog);
SaveDialog.InitialDir:=GetPrimaryConfigPath;
SaveDialog.Title:='Export package list (*.xml)';
SaveDialog.Options:=SaveDialog.Options+[ofPathMustExist];
if SaveDialog.Execute then begin
AFilename:=CleanAndExpandFilename(SaveDialog.Filename);
if ExtractFileExt(AFilename)='' then
AFilename:=AFilename+'.xml';
SavePackageListToFile(AFilename);
end;
InputHistories.StoreFileDialogSettings(SaveDialog);
finally
SaveDialog.Free;
end;
end; end;
procedure TInstallPkgSetDialog.ImportButtonClick(Sender: TObject); procedure TInstallPkgSetDialog.ImportButtonClick(Sender: TObject);
var
OpenDialog: TOpenDialog;
AFilename: string;
begin begin
// TODO OpenDialog:=TSaveDialog.Create(nil);
try
InputHistories.ApplyFileDialogSettings(OpenDialog);
OpenDialog.InitialDir:=GetPrimaryConfigPath;
OpenDialog.Title:='Import package list (*.xml)';
OpenDialog.Options:=OpenDialog.Options+[ofPathMustExist,ofFileMustExist];
if OpenDialog.Execute then begin
AFilename:=CleanAndExpandFilename(OpenDialog.Filename);
LoadPackageListFromFile(AFilename);
end;
InputHistories.StoreFileDialogSettings(OpenDialog);
finally
OpenDialog.Free;
end;
end; end;
procedure TInstallPkgSetDialog.AddToInstallButtonClick(Sender: TObject); procedure TInstallPkgSetDialog.AddToInstallButtonClick(Sender: TObject);
@ -460,6 +497,104 @@ begin
dec(Result); dec(Result);
end; end;
procedure TInstallPkgSetDialog.SavePackageListToFile(const AFilename: string);
var
XMLConfig: TXMLConfig;
i: Integer;
LazPackageID: TLazPackageID;
begin
try
XMLConfig:=TXMLConfig.CreateClean(AFilename);
try
XMLConfig.SetDeleteValue('Packages/Count',FNewInstalledPackages.Count,0);
for i:=0 to FNewInstalledPackages.Count-1 do begin
LazPackageID:=TLazPackageID(FNewInstalledPackages[i]);
XMLConfig.SetDeleteValue('Packages/Item'+IntToStr(i)+'/ID',
LazPackageID.IDAsString,'');
end;
XMLConfig.Flush;
finally
XMLConfig.Free;
end;
except
on E: Exception do begin
MessageDlg(lisCodeToolsDefsWriteError,
Format(lisErrorWritingPackageListToFile, [#13, AFilename, #13, E.Message
]), mtError, [mbCancel], 0);
end;
end;
end;
procedure TInstallPkgSetDialog.LoadPackageListFromFile(const AFilename: string
);
function PkgNameExists(List: TList; ID: TLazPackageID): boolean;
var
i: Integer;
LazPackageID: TLazPackageID;
begin
for i:=0 to List.Count-1 do begin
LazPackageID:=TLazPackageID(List[i]);
if CompareText(LazPackageID.Name,ID.Name)=0 then begin
Result:=true;
exit;
end;
end;
Result:=false;
end;
var
XMLConfig: TXMLConfig;
i: Integer;
LazPackageID: TLazPackageID;
NewCount: LongInt;
NewList: TList;
ID: String;
begin
NewList:=nil;
LazPackageID:=nil;
try
XMLConfig:=TXMLConfig.Create(AFilename);
try
NewCount:=XMLConfig.GetValue('Packages/Count',0);
LazPackageID:=TLazPackageID.Create;
for i:=0 to NewCount-1 do begin
// get ID
ID:=XMLConfig.GetValue('Packages/Item'+IntToStr(i)+'/ID','');
if ID='' then continue;
// parse ID
if not LazPackageID.StringToID(ID) then continue;
// ignore doubles
if PkgNameExists(NewList,LazPackageID) then continue;
// add
if NewList=nil then NewList:=TList.Create;
NewList.Add(LazPackageID);
LazPackageID:=TLazPackageID.Create;
end;
// clean up old list
for i:=0 to FNewInstalledPackages.Count-1 do
TObject(FNewInstalledPackages[i]).Free;
FNewInstalledPackages.Clear;
// assign new list
FNewInstalledPackages:=NewList;
NewList:=nil;
finally
XMLConfig.Free;
LazPackageID.Free;
if NewList<>nil then begin
for i:=0 to NewList.Count-1 do TObject(NewList[i]).Free;
NewList.Free;
end;
end;
except
on E: Exception do begin
MessageDlg(lisCodeToolsDefsReadError,
Format(lisErrorReadingPackageListFromFile, [#13, AFilename, #13,
E.Message]), mtError, [mbCancel], 0);
end;
end;
end;
function TInstallPkgSetDialog.GetNewInstalledPackages: TList; function TInstallPkgSetDialog.GetNewInstalledPackages: TList;
begin begin
Result:=FNewInstalledPackages; Result:=FNewInstalledPackages;

View File

@ -57,7 +57,7 @@ type
fpfSearchInPckgsWithEditor, fpfSearchInPckgsWithEditor,
fpfSearchInLoadedPkgs, fpfSearchInLoadedPkgs,
fpfSearchInPkgLinks, fpfSearchInPkgLinks,
fpfPkgLinkMustExist, // check if .pkg file exists fpfPkgLinkMustExist, // check if .lpk file exists
fpfIgnoreVersion fpfIgnoreVersion
); );
TFindPackageFlags = set of TFindPackageFlag; TFindPackageFlags = set of TFindPackageFlag;