paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-05 22:58:12 +02:00
Code Issues Packages Projects Releases Wiki Activity
GtkPartialMerge
lazarus/packager/installpkgsetdlg.pas

1370 lines
43 KiB
ObjectPascal
Raw Permalink Blame History

{
/***************************************************************************
installpkgsetdlg.pas
--------------------
***************************************************************************/
***************************************************************************
* *
* 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., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
* *
***************************************************************************
Author: Mattias Gaertner
Abstract:
Dialog to edit the package set installed in the IDE.
}
unit InstallPkgSetDlg;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Contnrs, AVL_Tree,
// LCL
LCLType, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons,
ExtCtrls, ComCtrls, ImgList,
// LazControls
TreeFilterEdit,
// Codetools
BasicCodeTools,
// LazUtils
LazFileUtils, Laz2_XMLCfg, LazUTF8, LazLoggerBase,
// BuildIntf
PackageIntf, PackageLinkIntf, PackageDependencyIntf,
// IdeIntf
IDEImagesIntf, IdeIntfStrConsts, IDEHelpIntf, IDEDialogs, IDEWindowIntf, InputHistory,
// IdeConfig
LazConf,
// IDE
LazarusIDEStrConsts, PackageDefs, PackageSystem, LPKCache, PackageLinks;
type
{ TInstallPkgSetDialog }
TInstallPkgSetDialog = class(TForm)
AddToInstallButton: TBitBtn;
AvailableTreeView: TTreeView;
AvailablePkgGroupBox: TGroupBox;
MiddleBevel: TBevel;
HelpButton: TBitBtn;
CancelButton: TBitBtn;
ExportButton: TButton;
BtnPanel: TPanel;
InstallTreeView: TTreeView;
AvailableFilterEdit: TTreeFilterEdit;
LPKParsingTimer: TTimer;
NoteLabel: TLabel;
Panel1: TPanel;
Panel2: TPanel;
PkgInfoMemo: TMemo;
PkgInfoGroupBox: TGroupBox;
ImportButton: TButton;
PkgInfoMemoLicense: TMemo;
SaveAndExitButton: TBitBtn;
InstallPkgGroupBox: TGroupBox;
SaveAndRebuildButton: TBitBtn;
InstalledFilterEdit: TTreeFilterEdit;
Splitter1: TSplitter;
Splitter2: TSplitter;
UninstallButton: TBitBtn;
procedure AvailableTreeViewKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
function FilterEditGetImageIndex({%H-}Str: String; {%H-}Data: TObject;
var {%H-}AIsEnabled: Boolean): Integer;
procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
procedure FormDropFiles(Sender: TObject; const FileNames: array of string);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure InstallTreeViewKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure LPKParsingTimerTimer(Sender: TObject);
procedure OnAllLPKParsed(Sender: TObject);
procedure OnIdle(Sender: TObject; var {%H-}Done: Boolean);
procedure TreeViewAdvancedCustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; {%H-}State: TCustomDrawState; Stage: TCustomDrawStage;
var PaintImages, {%H-}DefaultDraw: Boolean);
procedure AvailableTreeViewSelectionChanged(Sender: TObject);
procedure ExportButtonClick(Sender: TObject);
procedure HelpButtonClick(Sender: TObject);
procedure ImportButtonClick(Sender: TObject);
procedure SaveAndRebuildButtonClick(Sender: TObject);
procedure InstallPkgSetDialogCreate(Sender: TObject);
procedure InstallPkgSetDialogDestroy(Sender: TObject);
procedure InstallPkgSetDialogShow(Sender: TObject);
procedure InstallPkgSetDialogResize(Sender: TObject);
procedure InstallTreeViewSelectionChanged(Sender: TObject);
procedure SaveAndExitButtonClick(Sender: TObject);
procedure AddToInstall(Sender: TObject);
procedure AddToUninstall(Sender: TObject);
private
FIdleConnected: boolean;
FNewInstalledPackages: TObjectList; // list of TLazPackageID (not TLazPackage)
FOldInstalledPackages: TPkgDependency;
FRebuildIDE: boolean;
FSelectedPkgState: TLPKInfoState;
FSelectedPkgID: string;
fAvailablePkgsNeedUpdate: boolean;
ImgIndexPackage: integer;
ImgIndexInstallPackage: integer;
ImgIndexInstalledPackage: integer;
ImgIndexUninstallPackage: integer;
ImgIndexCirclePackage: integer;
ImgIndexMissingPackage: integer;
ImgIndexAvailableOnline: integer;
ImgIndexOverlayUnknown: integer;
ImgIndexOverlayBasePackage: integer;
ImgIndexOverlayFPCPackage: integer;
ImgIndexOverlayLazarusPackage: integer;
ImgIndexOverlayDesigntimePackage: integer;
ImgIndexOverlayRuntimePackage: integer;
procedure SetIdleConnected(AValue: boolean);
procedure SetOldInstalledPackages(const AValue: TPkgDependency);
procedure AssignOldInstalledPackagesToList;
function PackageInInstallList(PkgName: string): boolean;
function GetPkgImgIndex(Installed: TPackageInstallType; InInstallList,
IsOnline: boolean): integer;
procedure UpdateAvailablePackages(Immediately: boolean = false);
procedure UpdateNewInstalledPackages;
function DependencyToStr(Dependency: TPkgDependency): string;
procedure ClearNewInstalledPackages;
function CheckSelection: boolean;
procedure UpdateButtonStates;
procedure UpdatePackageInfo(Tree: TTreeView);
function NewInstalledPackagesContains(APackageID: TLazPackageID): boolean;
function IndexOfNewInstalledPackageID(APackageID: TLazPackageID): integer;
function IndexOfNewInstalledPkgByName(const APackageName: string): integer;
procedure SavePackageListToFile(const AFilename: string);
procedure LoadPackageListFromFile(const AFilename: string);
function ExtractNameFromPkgID(ID: string): string;
procedure PkgInfosChanged;
procedure ChangePkgVersion(PkgInfo: TLPKInfo; NewVersion: TPkgVersion);
function FindOnlinePackageLink(const AName: String): TPackageLink;
function IsBasePkg(aPkgID: TLazPackageID): boolean;
function IsBasePkg(aPkgName: string): boolean;
public
function GetNewInstalledPackages: TObjectList;
property OldInstalledPackages: TPkgDependency read FOldInstalledPackages
write SetOldInstalledPackages;
property NewInstalledPackages: TObjectList read FNewInstalledPackages; // list of TLazPackageID
property RebuildIDE: boolean read FRebuildIDE write FRebuildIDE;
property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
end;
function ShowEditInstallPkgsDialog(
OldInstalledPackages: TPkgDependency;
out NewInstalledPackages: TObjectList; // list of TLazPackageID (must be freed, may be null)
out RebuildIDE: boolean
): boolean;
implementation
{$R *.lfm}
procedure SetControlsWidthOnMax(AControls: array of TControl);
var
i, MaxWidth: Integer;
begin
MaxWidth:=0;
for i:=Low(AControls) to High(AControls) do
if AControls[i].Width>MaxWidth then
MaxWidth:=AControls[i].Width;
for i:=Low(AControls) to High(AControls) do
AControls[i].Constraints.MinWidth:=MaxWidth; // AutoSize=True
end;
function ShowEditInstallPkgsDialog(
OldInstalledPackages: TPkgDependency;
out NewInstalledPackages: TObjectList; // list of TLazPackageID (must be freed, may be null)
out RebuildIDE: boolean
): boolean;
var
InstallPkgSetDialog: TInstallPkgSetDialog;
begin
result := false;
NewInstalledPackages := nil;
RebuildIDE := false;
InstallPkgSetDialog := TInstallPkgSetDialog.Create(nil);
try
InstallPkgSetDialog.OldInstalledPackages := OldInstalledPackages;
result := InstallPkgSetDialog.ShowModal = mrOK;
if result then
begin
NewInstalledPackages := InstallPkgSetDialog.GetNewInstalledPackages;
RebuildIDE := InstallPkgSetDialog.RebuildIDE;
end;
finally
InstallPkgSetDialog.Free;
end;
end;
{ TInstallPkgSetDialog }
procedure TInstallPkgSetDialog.InstallPkgSetDialogCreate(Sender: TObject);
begin
IDEDialogLayoutList.ApplyLayout(Self);
{ Captions }
Self .Caption := lisInstallUninstallPackages;
NoteLabel .Caption := lisIDECompileAndRestart;
AvailablePkgGroupBox.Caption := lisAvailableForInstallation;
ExportButton .Caption := lisExport;
ImportButton .Caption := lisImport;
UninstallButton .Caption := lisUninstallSelection;
InstallPkgGroupBox .Caption := lisPckEditInstall;
AddToInstallButton .Caption := lisInstallSelection;
PkgInfoGroupBox .Caption := lisPackageInfo;
SaveAndRebuildButton.Caption := lisSaveAndRebuildIDE;
SaveAndExitButton .Caption := lisSaveAndExitDialog;
CancelButton .Caption := lisCancel;
HelpButton .Caption := lisMenuHelp;
{ Images }
InstallTreeView .Images := IDEImages.Images_16;
AvailableTreeView.Images := IDEImages.Images_16;
IDEImages.AssignImage(AddToInstallButton, 'arrow__darkgreen_left');
IDEImages.AssignImage(UninstallButton , 'arrow__darkred_right');
ImgIndexPackage := IDEImages.LoadImage('item_package');
ImgIndexInstalledPackage := IDEImages.LoadImage('pkg_installed');
ImgIndexInstallPackage := IDEImages.LoadImage('pkg_package_autoinstall');
ImgIndexUninstallPackage := IDEImages.LoadImage('pkg_package_uninstall');
ImgIndexCirclePackage := IDEImages.LoadImage('pkg_package_circle');
ImgIndexMissingPackage := IDEImages.LoadImage('pkg_conflict');
ImgIndexAvailableOnline := IDEImages.LoadImage('pkg_install');
ImgIndexOverlayUnknown := IDEImages.LoadImage('state_unknown');
ImgIndexOverlayBasePackage := IDEImages.LoadImage('pkg_core_overlay');
ImgIndexOverlayFPCPackage := IDEImages.LoadImage('pkg_fpc_overlay');
ImgIndexOverlayLazarusPackage := IDEImages.LoadImage('pkg_lazarus_overlay');
ImgIndexOverlayDesignTimePackage := IDEImages.LoadImage('pkg_design_overlay');
ImgIndexOverlayRunTimePackage := IDEImages.LoadImage('pkg_runtime_overlay');
{}
FNewInstalledPackages := TObjectList.Create(true);
LPKInfoCache.AddOnQueueEmpty(@OnAllLPKParsed);
LPKInfoCache.StartLPKReaderWithAllAvailable;
UpdateButtonStates;
end;
procedure TInstallPkgSetDialog.InstallPkgSetDialogDestroy(Sender: TObject);
begin
LPKInfoCache.EndLPKReader;
LPKInfoCache.RemoveOnQueueEmpty(@OnAllLPKParsed);
ClearNewInstalledPackages;
FreeAndNil(FNewInstalledPackages);
IdleConnected:=false;
end;
procedure TInstallPkgSetDialog.InstallPkgSetDialogShow(Sender: TObject);
begin
InstalledFilterEdit.ResetFilter; // (filter) - TextHint is shown after this.
AvailableFilterEdit.ResetFilter;
SetControlsWidthOnMax([UninstallButton, AddToInstallButton]);
SetControlsWidthOnMax([ImportButton, ExportButton]);
end;
procedure TInstallPkgSetDialog.SaveAndRebuildButtonClick(Sender: TObject);
begin
if SaveAndRebuildButton.Enabled and CheckSelection then
begin
RebuildIDE := true;
ModalResult := mrOk;
end;
end;
procedure TInstallPkgSetDialog.AvailableTreeViewSelectionChanged(Sender: TObject);
begin
UpdateButtonStates;
UpdatePackageInfo(AvailableTreeView);
end;
procedure TInstallPkgSetDialog.ExportButtonClick(Sender: TObject);
var
SaveDialog: TSaveDialog;
AFilename: string;
begin
SaveDialog:=TSaveDialog.Create(nil);
try
InputHistories.ApplyFileDialogSettings(SaveDialog);
SaveDialog.InitialDir:=GetPrimaryConfigPath;
SaveDialog.Title:=lisExportPackageListXml;
SaveDialog.Filter:=dlgFilterPackageListFiles+'|*.xml;*.txt|'+dlgFilterAll+'|*.*';
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;
procedure TInstallPkgSetDialog.HelpButtonClick(Sender: TObject);
begin
LazarusHelp.ShowHelpForIDEControl(Self);
end;
procedure TInstallPkgSetDialog.ImportButtonClick(Sender: TObject);
var
OpenDialog: TOpenDialog;
AFilename: string;
begin
OpenDialog:=TOpenDialog.Create(nil);
try
InputHistories.ApplyFileDialogSettings(OpenDialog);
OpenDialog.InitialDir:=GetPrimaryConfigPath;
OpenDialog.Title:=lisImportPackageListXml;
OpenDialog.Filter:=dlgFilterPackageListFiles+'|*.xml;*.txt|'+dlgFilterAll+'|*.*';
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;
procedure TInstallPkgSetDialog.AvailableTreeViewKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
if (Key = VK_RETURN) and (Shift = []) then
begin
AddToInstall(Sender);
Key := 0;
end;
end;
function TInstallPkgSetDialog.FilterEditGetImageIndex(Str: String;
Data: TObject; var AIsEnabled: Boolean): Integer;
begin
Result:=0;
end;
procedure TInstallPkgSetDialog.FormClose(Sender: TObject;
var CloseAction: TCloseAction);
begin
// don't close until parsing is complete
if LPKParsingTimer.Enabled then
begin
CloseAction := caNone;
exit;
end;
IDEDialogLayoutList.SaveLayout(Self);
end;
procedure TInstallPkgSetDialog.FormDropFiles(Sender: TObject;
const FileNames: array of string);
var
lFilename: String;
begin
if length(FileNames) = 1 then // only one file
begin
lFilename := CleanAndExpandFilename(FileNames[0]);
LoadPackageListFromFile(lFilename);
end;
end;
procedure TInstallPkgSetDialog.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_ESCAPE) and (Shift = []) then
begin
Close;
Key := 0;
end
else if (Key = VK_RETURN) and (Shift = [ssCtrl]) then
begin
SaveAndRebuildButtonClick(Sender);
Key := 0;
end
else if (Key = VK_S) and (Shift = [ssCtrl]) then
begin
SaveAndExitButtonClick(Sender);
Key := 0;
end
// import and export
else if (Key = VK_E) and (Shift = [ssCtrl]) then
begin
ExportButtonClick(Sender);
Key := 0;
end
else if (Key = VK_I) and (Shift = [ssCtrl]) then
begin
ImportButtonClick(Sender);
Key := 0;
end
// scroll description
else if (Key = VK_DOWN) and (Shift = [ssCtrl]) then
begin
PkgInfoMemo.VertScrollBar.Position := PkgInfoMemo.VertScrollBar.Position + 1;
Key := 0;
end
else if (Key = VK_UP) and (Shift = [ssCtrl]) then
begin
PkgInfoMemo.VertScrollBar.Position := PkgInfoMemo.VertScrollBar.Position - 1;
Key := 0;
end
// switch focus
else if (Key = VK_TAB) and (Shift = [ssCtrl]) then
begin
if AvailableFilterEdit.Focused then
InstalledFilterEdit.SetFocus
else
AvailableFilterEdit.SetFocus;
Key := 0;
end
end;
procedure TInstallPkgSetDialog.InstallTreeViewKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
if (Key = VK_RETURN) and (Shift = []) then
begin
AddToUninstall(Sender);
Key := 0;
end;
end;
procedure TInstallPkgSetDialog.LPKParsingTimerTimer(Sender: TObject);
begin
UpdateNewInstalledPackages;
UpdateAvailablePackages;
end;
procedure TInstallPkgSetDialog.OnAllLPKParsed(Sender: TObject);
begin
LPKParsingTimer.Enabled := false;
LPKParsingTimerTimer(Sender);
end;
procedure TInstallPkgSetDialog.OnIdle(Sender: TObject; var Done: Boolean);
begin
if fAvailablePkgsNeedUpdate then
UpdateAvailablePackages(true);
IdleConnected:=false;
end;
procedure TInstallPkgSetDialog.TreeViewAdvancedCustomDrawItem(
Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState;
Stage: TCustomDrawStage; var PaintImages, DefaultDraw: Boolean);
var
Info: TLPKInfo;
NodeRect: TRect;
x: Integer;
Images: TCustomImageList;
CurCanvas: TCanvas;
y: Integer;
Tree: TTreeView;
InLazSrc: Boolean;
IsBase: Boolean;
PkgType: TLazPackageType;
Installed: TPackageInstallType;
PkgName: String;
ImgIndex: Integer;
Unknown: Boolean;
PackageLink: TPackageLink;
ImagesRes: TScaledImageListResolution;
begin
Tree:=Sender as TTreeView;
if Stage=cdPostPaint then begin
LPKInfoCache.EnterCritSection;
try
Info:=LPKInfoCache.FindPkgInfoWithIDAsString(Node.Text);
if Info=nil then exit;
PkgName:=Info.ID.Name;
Unknown:=not (Info.LPKParsed in [lpkiParsed,lpkiParsedError]);
InLazSrc:=Info.InLazSrc;
IsBase:=Info.Base;
PkgType:=Info.PkgType;
Installed:=Info.Installed;
finally
LPKInfoCache.LeaveCritSection;
end;
if Sender = InstallTreeView then
PackageLink := nil
else
PackageLink := FindOnlinePackageLink(Info.ID.Name);
Images:=Tree.Images;
if Images = nil then exit;
ImagesRes := Images.ResolutionForPPI[Tree.ImagesWidth, Font.PixelsPerInch, GetCanvasScaleFactor];
CurCanvas:=Tree.Canvas;
NodeRect:=Node.DisplayRect(False);
x:=Node.DisplayIconLeft+1;
y:=(NodeRect.Top+NodeRect.Bottom-ImagesRes.Height) div 2;
// draw image
ImgIndex:=GetPkgImgIndex(Installed,PackageInInstallList(PkgName), PackageLink <> nil);
ImagesRes.Draw(CurCanvas,x,y,ImgIndex);
// draw overlays
if InLazSrc then
ImagesRes.Draw(CurCanvas,x,y,ImgIndexOverlayLazarusPackage);
if IsBase then
ImagesRes.Draw(CurCanvas,x,y,ImgIndexOverlayBasePackage);
if PkgType=lptRunTimeOnly then
ImagesRes.Draw(CurCanvas,x,y,ImgIndexOverlayRuntimePackage);
if PkgType=lptDesignTime then
ImagesRes.Draw(CurCanvas,x,y,ImgIndexOverlayDesigntimePackage);
if Unknown then
ImagesRes.Draw(CurCanvas,x,y,ImgIndexOverlayUnknown);
end;
PaintImages:=false;
end;
procedure TInstallPkgSetDialog.InstallPkgSetDialogResize(Sender: TObject);
var
w: Integer;
begin
w:=ClientWidth div 2-InstallPkgGroupBox.BorderSpacing.Left*3;
if w<1 then w:=1;
InstallPkgGroupBox.Width:=w;
end;
procedure TInstallPkgSetDialog.InstallTreeViewSelectionChanged(Sender: TObject);
begin
UpdateButtonStates;
UpdatePackageInfo(InstallTreeView);
end;
procedure TInstallPkgSetDialog.SaveAndExitButtonClick(Sender: TObject);
begin
if SaveAndExitButton.Enabled and CheckSelection then
begin
RebuildIDE := false;
ModalResult := mrOk;
end;
end;
procedure TInstallPkgSetDialog.SetOldInstalledPackages(const AValue: TPkgDependency);
begin
if FOldInstalledPackages=AValue then exit;
FOldInstalledPackages:=AValue;
AssignOldInstalledPackagesToList;
end;
procedure TInstallPkgSetDialog.SetIdleConnected(AValue: boolean);
begin
if FIdleConnected=AValue then Exit;
FIdleConnected:=AValue;
if IdleConnected then
Application.AddOnIdleHandler(@OnIdle)
else
Application.RemoveOnIdleHandler(@OnIdle);
end;
procedure TInstallPkgSetDialog.AssignOldInstalledPackagesToList;
var
Dependency: TPkgDependency;
Cnt: Integer;
NewPackageID: TLazPackageID;
begin
ClearNewInstalledPackages;
Cnt:=0;
Dependency:=OldInstalledPackages;
while Dependency<>nil do begin
NewPackageID:=TLazPackageID.Create;
if (Dependency.LoadPackageResult=lprSuccess)
and (Dependency.RequiredPackage<>nil) then begin
// packages can be freed while the dialog runs => use packageid instead
NewPackageID.AssignID(Dependency.RequiredPackage);
end else begin
NewPackageID.Name:=Dependency.PackageName;
end;
FNewInstalledPackages.Add(NewPackageID);
Dependency:=Dependency.NextRequiresDependency;
inc(Cnt);
end;
UpdateNewInstalledPackages;
UpdateAvailablePackages;
end;
function TInstallPkgSetDialog.PackageInInstallList(PkgName: string): boolean;
var
i: Integer;
begin
for i:=0 to NewInstalledPackages.Count-1 do
if CompareText(TLazPackageID(NewInstalledPackages[i]).Name,PkgName)=0 then
exit(true);
Result:=false;
end;
function TInstallPkgSetDialog.GetPkgImgIndex(Installed: TPackageInstallType;
InInstallList, IsOnline: boolean): integer;
begin
if Installed<>pitNope then begin
// is not currently installed
if InInstallList then begin
// is installed and will be installed
Result:=ImgIndexPackage;
end
else begin
// is installed and will be uninstalled
Result:=ImgIndexUninstallPackage;
end;
end else begin
// is currently installed
if InInstallList then begin
// is not installed and will be installed
Result:=ImgIndexInstallPackage;
end
else begin
// is not installed and will be not be installed
if IsOnline then
Result := ImgIndexAvailableOnline
else
Result:=ImgIndexPackage;
end;
end;
end;
function TInstallPkgSetDialog.FindOnlinePackageLink(const AName: String): TPackageLink;
var
PackageLink: TPackageLink;
PkgName: String;
P: Integer;
begin
Result := nil;
Exit;
if OPMInterface = nil then
Exit;
PkgName := Trim(AName);
P := Pos(' ', PkgName);
if P > 0 then
PkgName := Copy(PkgName, 1, P - 1);
PackageLink := OPMInterface.FindOnlineLink(PkgName);
if PackageLink <> nil then
Result := PackageLink;
end;
// returns false on error or if the package is not base
function TInstallPkgSetDialog.IsBasePkg(aPkgID: TLazPackageID): boolean;
var
lPkg: TLazPackage;
begin
lPkg := PackageGraph.FindPackageWithID(aPkgID); // no need to free
result := (lPkg <> nil) and PackageGraph.IsCompiledInBasePackage(lPkg.Name);
end;
// returns false on error or if the package is not base
function TInstallPkgSetDialog.IsBasePkg(aPkgName: string): boolean;
var
lPkgID: TLazPackageID;
begin
result := false;
lPkgID := TLazPackageID.Create;
try
result := lPkgID.StringToID(aPkgName) and IsBasePkg(lPkgID);
finally
lPkgID.Free;
end;
end;
procedure TInstallPkgSetDialog.UpdateAvailablePackages(Immediately: boolean);
var
ANode: TAvlTreeNode;
FilteredBranch: TTreeFilterBranch;
Info: TLPKInfo;
List: TStringList;
i: Integer;
PackageLink: TPackageLink;
begin
if not Immediately then begin
fAvailablePkgsNeedUpdate:=true;
IdleConnected:=true;
exit;
end;
fAvailablePkgsNeedUpdate:=false;
List:=TStringList.Create;
try
// collect available packages, not yet installed
LPKInfoCache.EnterCritSection;
try
ANode:=LPKInfoCache.LPKByID.FindLowest;
while ANode<>nil do begin
Info:=TLPKInfo(ANode.Data);
ANode:=LPKInfoCache.LPKByID.FindSuccessor(ANode);
PackageLink := FindOnlinePackageLink(Info.ID.Name);
if (PackageLink <> nil) and (PackageLink.PackageType in [lptDesignTime,lptRunAndDesignTime]) then begin
if (not PackageInInstallList(Info.ID.Name)) then begin
Info.PkgType := PackageLink.PackageType;
Info.ID.Version.Assign(PackageLink.Version);
List.Add(Info.ID.IDAsString);
Continue;
end;
end;
if Info.LPKParsed=lpkiParsedError then continue;
if (Info.LPKParsed in [lpkiNotParsed,lpkiParsing])
or (Info.PkgType in [lptDesignTime,lptRunAndDesignTime])
then begin
if (not PackageInInstallList(Info.ID.Name)) then
List.Add(Info.ID.IDAsString);
end;
end;
finally
LPKInfoCache.LeaveCritSection;
end;
// fill tree view through FilterEdit
FilteredBranch := AvailableFilterEdit.GetCleanBranch(Nil); // All items are top level.
for i:=0 to List.Count-1 do
FilteredBranch.AddNodeData(List[i],nil);
finally
List.Free;
end;
AvailableFilterEdit.InvalidateFilter;
end;
procedure TInstallPkgSetDialog.UpdateNewInstalledPackages;
var
NewPackageID: TLazPackageID;
APackage: TLazPackage;
FilteredBranch: TTreeFilterBranch;
List: TStringListUTF8Fast;
i: Integer;
begin
List:=TStringListUTF8Fast.Create;
try
for i:=0 to FNewInstalledPackages.Count-1 do begin
NewPackageID:=TLazPackageID(FNewInstalledPackages[i]);
APackage:=PackageGraph.FindPackageWithName(NewPackageID.Name,nil);
if APackage<>nil then
NewPackageID:=APackage;
List.Add(NewPackageID.IDAsString);
end;
List.Sort;
// fill tree view through FilterEdit
FilteredBranch := InstalledFilterEdit.GetCleanBranch(Nil); // All items are top level.
for i:=0 to List.Count-1 do
FilteredBranch.AddNodeData(List[i],nil);
finally
List.Free;
end;
InstalledFilterEdit.InvalidateFilter;
end;
procedure TInstallPkgSetDialog.PkgInfosChanged;
// called in mainthread after package parser helper thread finished
begin
UpdateAvailablePackages;
end;
procedure TInstallPkgSetDialog.ChangePkgVersion(PkgInfo: TLPKInfo;
NewVersion: TPkgVersion);
// called by LPKInfoCache when a lpk has a different version than the IDE list
var
OldID, NewID: String;
procedure ChangeTV(TV: TTreeView);
var
i: Integer;
Node: TTreeNode;
begin
for i:=0 to TV.Items.TopLvlCount-1 do begin
Node:=TV.Items.TopLvlItems[i];
if Node.Text=OldID then
Node.Text:=NewID;
end;
end;
begin
OldID:=PkgInfo.ID.IDAsString;
NewID:=PkgInfo.ID.Name+' '+NewVersion.AsString;
ChangeTV(AvailableTreeView);
ChangeTV(InstallTreeView);
end;
function TInstallPkgSetDialog.DependencyToStr(Dependency: TPkgDependency): string;
begin
Result:='';
if Dependency=nil then exit;
if (Dependency.LoadPackageResult=lprSuccess)
and (Dependency.RequiredPackage<>nil) then
Result:=Dependency.RequiredPackage.IDAsString
else
Result:=Dependency.PackageName;
end;
procedure TInstallPkgSetDialog.ClearNewInstalledPackages;
begin
FNewInstalledPackages.Clear;
end;
function TInstallPkgSetDialog.CheckSelection: boolean;
var
UninstallPkgs: TObjectList; // list of TLazPackageID
Dependency: TPkgDependency;
OldPackageID: TLazPackageID;
begin
UninstallPkgs:=TObjectList.Create(true);
try
Dependency:=OldInstalledPackages;
while Dependency<>nil do begin
OldPackageID:=TLazPackageID.Create;
if (Dependency.LoadPackageResult=lprSuccess)
and (Dependency.RequiredPackage<>nil) then begin
OldPackageID.AssignID(Dependency.RequiredPackage);
end else begin
OldPackageID.Name:=Dependency.PackageName;
end;
if NewInstalledPackagesContains(OldPackageID) then
OldPackageID.Free
else
UninstallPkgs.Add(OldPackageID);
Dependency:=Dependency.NextRequiresDependency;
end;
Result:=PackageEditingInterface.CheckInstallPackageList(
FNewInstalledPackages,UninstallPkgs,[piiifRemoveConflicts]);
if not Result then begin
AssignOldInstalledPackagesToList; // Restore the old list.
UpdateNewInstalledPackages;
UpdateAvailablePackages(True);
UpdateButtonStates;
end;
finally
UninstallPkgs.Free;
end;
end;
procedure TInstallPkgSetDialog.UpdateButtonStates;
//
function ChangesFound: boolean;
var
Cnt: Integer;
Dependency: TPkgDependency;
FilteredBranch: TTreeFilterBranch;
begin
Cnt := 0;
Dependency := OldInstalledPackages;
while Dependency <> nil do
begin
if not PackageInInstallList(Dependency.PackageName) then
exit(true);
Dependency := Dependency.NextRequiresDependency;
inc(Cnt);
end;
FilteredBranch := InstalledFilterEdit.GetExistingBranch(nil);
result := assigned(FilteredBranch) and (FilteredBranch.Items.Count <> Cnt);
end;
//
begin
SaveAndRebuildButton.Enabled := ChangesFound;
SaveAndExitButton .Enabled := SaveAndRebuildButton.Enabled;
UninstallButton .Enabled := (InstallTreeView.Selected <> nil) and
not IsBasePkg(InstallTreeView.Selected.Text);
AddToInstallButton .Enabled := AvailableTreeView.Selected <> nil;
end;
procedure TInstallPkgSetDialog.UpdatePackageInfo(Tree: TTreeView);
var
InfoStr: string;
procedure AddState(const NewState: string);
begin
if (InfoStr<>'') and (InfoStr[length(InfoStr)]<>' ') then
InfoStr:=InfoStr+', ';
InfoStr:=InfoStr+NewState;
end;
var
PkgID: String;
Info: TLPKInfo;
PackageLink: TPackageLink;
Author, Description, License: String;
begin
if Tree = nil then Exit;
PkgID := '';
if Tree.Selected <> nil then
PkgID := Tree.Selected.Text;
if PkgID = '' then Exit;
if Tree = InstallTreeView then
PackageLink := nil
else
PackageLink := FindOnlinePackageLink(PkgID);
LPKInfoCache.EnterCritSection;
try
Info:=LPKInfoCache.FindPkgInfoWithIDAsString(PkgID);
if ((Info=nil) and (FSelectedPkgID=''))
or ((Info<>nil) and (Info.ID.IDAsString=FSelectedPkgID)
and (Info.LPKParsed=FSelectedPkgState))
then
exit; // no change
PkgInfoMemo.Clear;
PkgInfoMemoLicense.Clear;
if (Info=nil) then begin
FSelectedPkgID:='';
exit;
end;
FSelectedPkgID:=PkgID;
if Info.LPKParsed=lpkiNotParsed then begin
LPKInfoCache.ParseLPKInfoInMainThread(Info);
if FSelectedPkgID='' then begin
// version has changed
// => has already triggered an update
exit;
end;
end;
if PackageLink = nil then
begin
Author := Info.Author;
Description := Trim(Info.Description);
License := Info.License;
end
else
begin
Author := PackageLink.Author;
Description := Trim(PackageLink.Description);
License := PackageLink.License;
end;
if Description<>'' then // Description is the most interesting piece.
PkgInfoMemo.Lines.Add(Description); // Put it first.
PkgInfoMemo.Lines.Add('');
if Author<>'' then
PkgInfoMemo.Lines.Add(lisPckOptsAuthor + ': ' + Author); // Author
PkgInfoMemo.Lines.Add(Format(lisOIPFilename, [Info.LPKFilename])); // Pkg name
if License<>'' then // License has its own memo.
PkgInfoMemoLicense.Lines.Add(lisPckOptsLicense + ': ' + License);
InfoStr:=lisCurrentState;
if Info.Installed<>pitNope then
begin
if PackageInInstallList(Info.ID.Name)=false then
AddState(lisSelectedForUninstallation);
AddState(lisInstalled);
end
else
begin
if PackageInInstallList(Info.ID.Name)=true then
AddState(lisSelectedForInstallation);
AddState(lisNotInstalled);
if PackageLink <> nil then
AddState(lisOnlinePackage);
end;
if Info.Base then
AddState(lisPckExplBase);
AddState(LazPackageTypeIdents[Info.PkgType]);
PkgInfoMemo.Lines.Add(InfoStr);
PkgInfoMemo.SelStart := 1;
PkgInfoMemoLicense.SelStart := 1;
finally
LPKInfoCache.LeaveCritSection;
end;
end;
function TInstallPkgSetDialog.NewInstalledPackagesContains(
APackageID: TLazPackageID): boolean;
begin
Result:=IndexOfNewInstalledPackageID(APackageID)>=0;
end;
function TInstallPkgSetDialog.IndexOfNewInstalledPackageID(
APackageID: TLazPackageID): integer;
begin
Result:=FNewInstalledPackages.Count-1;
while (Result>=0)
and (TLazPackageID(FNewInstalledPackages[Result]).Compare(APackageID)<>0) do
dec(Result);
end;
function TInstallPkgSetDialog.IndexOfNewInstalledPkgByName(
const APackageName: string): integer;
begin
Result:=FNewInstalledPackages.Count-1;
while (Result>=0)
and (CompareText(TLazPackageID(FNewInstalledPackages[Result]).Name,
APackageName)<>0)
do
dec(Result);
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;
InvalidateFileStateCache;
XMLConfig.Flush;
finally
XMLConfig.Free;
end;
except
on E: Exception do begin
MessageDlg(lisCodeToolsDefsWriteError,
Format(lisErrorWritingPackageListToFile,[LineEnding,AFilename,LineEnding,E.Message]),
mtError, [mbCancel], 0);
end;
end;
end;
procedure TInstallPkgSetDialog.LoadPackageListFromFile(const AFilename: string);
function PkgNameExists(List: TObjectList; ID: TLazPackageID): boolean;
var
i: Integer;
LazPackageID: TLazPackageID;
begin
if List<>nil then
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: TObjectList;
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:=TObjectList.Create(true);
NewList.Add(LazPackageID);
LazPackageID:=TLazPackageID.Create;
end;
// clean up old list
ClearNewInstalledPackages;
FNewInstalledPackages.Free;
// assign new list
FNewInstalledPackages:=NewList;
NewList:=nil;
UpdateNewInstalledPackages;
UpdateAvailablePackages;
UpdateButtonStates;
finally
XMLConfig.Free;
LazPackageID.Free;
NewList.Free;
end;
except
on E: Exception do begin
MessageDlg(lisCodeToolsDefsReadError,
Format(lisErrorReadingPackageListFromFile,[LineEnding,AFilename,LineEnding,E.Message]),
mtError, [mbCancel], 0);
end;
end;
end;
function TInstallPkgSetDialog.ExtractNameFromPkgID(ID: string): string;
begin
if ID='' then
Result:=''
else
Result:=GetIdentifier(PChar(ID));
end;
procedure TInstallPkgSetDialog.AddToInstall(Sender: TObject);
function SelectionOk(aPackageID: TLazPackageID): Boolean;
var
APackage: TLazPackage;
ConflictDep: TPkgDependency;
i: Integer;
begin
// check if already in list
if NewInstalledPackagesContains(aPackageID) then begin
MessageDlg(lisDuplicate,
Format(lisThePackageIsAlreadyInTheList, [aPackageID.Name]),
mtError, [mbCancel],0);
exit(false);
end;
// check if a package with same name is already in the list
i:=IndexOfNewInstalledPkgByName(aPackageID.Name);
if i>=0 then begin
MessageDlg(lisConflict,
Format(lisThereIsAlreadyAPackageInTheList, [aPackageID.Name]),
mtError,[mbCancel],0);
exit(false);
end;
// check if package is loaded and has some attributes that prevents
// installation in the IDE
APackage:=PackageGraph.FindPackageWithID(aPackageID);
if APackage<>nil then begin
if APackage.PackageType in [lptRunTime,lptRunTimeOnly] then begin
IDEMessageDialog(lisNotADesigntimePackage,
Format(lisThePackageIsNotADesignTimePackageItCanNotBeInstall,
[APackage.IDAsString]),
mtError, [mbCancel]);
exit(false);
end;
ConflictDep:=PackageGraph.FindRuntimePkgOnlyRecursively(
APackage.FirstRequiredDependency);
if ConflictDep<>nil then begin
IDEMessageDialog(lisNotADesigntimePackage,
Format(lisThePackageCanNotBeInstalledBecauseItRequiresWhichI,
[APackage.Name, ConflictDep.AsString]),
mtError, [mbCancel]);
exit(false);
end;
end;
Result:=true;
end;
var
i, j: Integer;
NewSelectedIndex, LastNonSelectedIndex: Integer;
NewPackageID: TLazPackageID;
Additions: TObjectList;
AddedPkgNames: TStringList;
TVNode: TTreeNode;
PkgName: String;
FilteredBranch: TTreeFilterBranch;
PkgLinks: TList;
PkgLinksStr: String;
PkgLink: TPackageLink;
begin
NewSelectedIndex:=-1;
LastNonSelectedIndex:=-1;
FilteredBranch := AvailableFilterEdit.GetExistingBranch(Nil); // All items are top level
Additions:=TObjectList.Create(false);
AddedPkgNames:=TStringList.Create;
PkgLinks := TList.Create;
NewPackageID:=TLazPackageID.Create;
try
for i:=0 to AvailableTreeView.Items.TopLvlCount-1 do
begin
TVNode:=AvailableTreeView.Items.TopLvlItems[i];
if not TVNode.MultiSelected then begin
LastNonSelectedIndex:=i;
continue;
end;
NewSelectedIndex:=i+1; // Will have the next index after the selected one.
PkgName:=TVNode.Text;
// Convert package name to ID and check it
if not NewPackageID.StringToID(PkgName) then begin
TVNode.Selected:=false;
DebugLn('TInstallPkgSetDialog.AddToInstall invalid ID: ', PkgName);
continue;
end;
if not SelectionOk(NewPackageID) then begin
TVNode.Selected:=false;
exit;
end;
// ok => add to list
PkgLink := FindOnlinePackageLink(NewPackageID.Name);
if PkgLink <> nil then begin
if not FileExists(PkgLink.OPMFileName) then
PkgLinks.Add(PkgLink)
else
begin
PkgLink := LazPackageLinks.AddUserLink(PkgLink.OPMFileName, PkgLink.Name);
if PkgLink <> nil then
LazPackageLinks.SaveUserLinks;
Additions.Add(NewPackageID);
NewPackageID:=TLazPackageID.Create;
AddedPkgNames.Add(PkgName);
end;
end else begin
Additions.Add(NewPackageID);
NewPackageID:=TLazPackageID.Create;
AddedPkgNames.Add(PkgName);
end;
end;
//download online packages
if (OPMInterface <> nil) and (PkgLinks.Count > 0) then
begin
PkgLinksStr := '';
for I := 0 to PkgLinks.Count - 1 do begin
if PkgLinksStr = '' then
PkgLinksStr := '"' + TPackageLink(PkgLinks.Items[I]).Name + '"'
else
PkgLinksStr := PkgLinksStr + ', ' + '"' + TPackageLink(PkgLinks.Items[I]).Name + '"';
end;
if IDEMessageDialog(lisDownload, Format(lisDonwloadOnlinePackages, [PkgLinksStr]), mtConfirmation, [mbYes, mbNo]) = mrYes then begin
if OPMInterface.DownloadPackages(PkgLinks) = mrOK then begin
for I := PkgLinks.Count - 1 downto 0 do begin
if OPMInterface.IsPackageAvailable(TPackageLink(PkgLinks.Items[I]), 1) then begin
Additions.Add(NewPackageID);
NewPackageID:=TLazPackageID.Create;
AddedPkgNames.Add(PkgName);
PkgLink := LazPackageLinks.AddUserLink(TPackageLink(PkgLinks.Items[I]).OPMFileName, TPackageLink(PkgLinks.Items[I]).Name);
if PkgLink <> nil then
LazPackageLinks.SaveUserLinks;
end;
end;
end
else
Dec(NewSelectedIndex);
end
else
Dec(NewSelectedIndex);
end;
// all ok => add to installed packages
for i:=0 to Additions.Count-1 do
FNewInstalledPackages.Add(Additions[i]);
for i:=0 to AddedPkgNames.Count-1 do begin
j:=FilteredBranch.Items.IndexOf(AddedPkgNames[i]);
Assert(j<>-1, 'TInstallPkgSetDialog.AddToInstall: '+AddedPkgNames[i]+' not found in Filter items.');
FilteredBranch.Items.Delete(j);
end;
// Don't call UpdateAvailablePackages here, only the selected nodes were removed.
UpdateNewInstalledPackages;
UpdateButtonStates;
if ((NewSelectedIndex=-1) or (NewSelectedIndex=AvailableTreeView.Items.TopLvlCount)) then
NewSelectedIndex:=LastNonSelectedIndex;
if NewSelectedIndex<>-1 then
AvailableTreeView.Items.TopLvlItems[NewSelectedIndex].Selected:=True;
AvailableFilterEdit.InvalidateFilter;
finally
NewPackageID.Free;
AddedPkgNames.Free;
Additions.Free;
PkgLinks.Free;
end;
end;
procedure TInstallPkgSetDialog.AddToUninstall(Sender: TObject);
var
i, j: Integer;
NewSelectedIndex, LastNonSelectedIndex: Integer;
DelPackageID, PackID: TLazPackageID;
Deletions: TObjectList; // list of TLazPackageID
DeletedPkgNames: TStringList;
TVNode: TTreeNode;
PkgName: String;
FilteredBranch: TTreeFilterBranch;
begin
NewSelectedIndex:=-1;
LastNonSelectedIndex:=-1;
FilteredBranch := InstalledFilterEdit.GetExistingBranch(Nil); // All items are top level
Deletions:=TObjectList.Create(true);
DeletedPkgNames:=TStringList.Create;
DelPackageID:=TLazPackageID.Create;
try
for i:=0 to InstallTreeView.Items.TopLvlCount-1 do begin
TVNode:=InstallTreeView.Items.TopLvlItems[i];
if not TVNode.MultiSelected then begin
LastNonSelectedIndex:=i;
continue;
end;
NewSelectedIndex:=i+1; // Will have the next index after the selected one.
PkgName:=TVNode.Text;
if not DelPackageID.StringToID(PkgName) then begin
debugln('TInstallPkgSetDialog.AddToUninstall invalid ID: ', PkgName);
continue;
end;
if IsBasePkg(DelPackageID) then begin
MessageDlg(
lisUninstallImpossible,
Format(lisThePackageCanNotBeUninstalledBecauseItIsNeededByTh, [PkgName]),
mtError,
[mbCancel],
0
);
exit;
end;
// ok => add to deletions
Deletions.Add(DelPackageID);
DelPackageID:=TLazPackageID.Create;
DeletedPkgNames.Add(PkgName);
end;
// ok => remove from installed packages
InstallTreeView.Selected:=nil;
for i:=0 to Deletions.Count-1 do begin
PackID:=TLazPackageID(Deletions[i]);
j:=IndexOfNewInstalledPackageID(PackID);
FNewInstalledPackages.Delete(j);
end;
for i:=0 to DeletedPkgNames.Count-1 do begin
j:=FilteredBranch.Items.IndexOf(DeletedPkgNames[i]);
Assert(j<>-1, 'TInstallPkgSetDialog.AddToUninstall: '+DeletedPkgNames[i]+' not found in Filter items.');
FilteredBranch.Items.Delete(j);
end;
// Don't call UpdateNewInstalledPackages here, only the selected nodes were removed.
UpdateAvailablePackages;
UpdateButtonStates;
if ((NewSelectedIndex<0) or (NewSelectedIndex=InstallTreeView.Items.TopLvlCount)) then
NewSelectedIndex:=LastNonSelectedIndex;
if NewSelectedIndex>=0 then
InstallTreeView.Items.TopLvlItems[NewSelectedIndex].Selected:=True;
InstalledFilterEdit.InvalidateFilter;
finally
DelPackageID.Free;
DeletedPkgNames.Free;
Deletions.Free;
end;
end;
function TInstallPkgSetDialog.GetNewInstalledPackages: TObjectList;
var
i: Integer;
NewPackageID: TLazPackageID;
begin
Result:=TObjectList.Create(true);
for i:=0 to FNewInstalledPackages.Count-1 do begin
NewPackageID:=TLazPackageID.Create;
NewPackageID.AssignID(TLazPackageID(FNewInstalledPackages[i]));
Result.Add(NewPackageID);
end;
end;
end.
Reference in New Issue View Git Blame Copy Permalink